Carp/core/Array.carp

(defmodule Array

  (doc reduce "Reduce an array, using the function f.")
  (defn reduce [f x xs]
    (let [total x]
      (do
        (for [i 0 (length xs)]
          (set! total (~f total (nth xs i))))
        total)))

  (doc empty? "Checks whether the array is empty.")
  (defn empty? [a]
    (= (Array.length a) 0))

  (doc any? "Checks whether any of the elements in `a` match the function `f`.")
  (defn any? [f a]
    (let-do [res false]
      (for [i 0 (length a)]
        (when (~f (nth a i))
          (do
            (set! res true)
            (break))))
      res))

  (doc all? "Checks whether all of the elements in `a` match the function `f`.")
  (defn all? [f a]
    (let-do [res true]
      (for [i 0 (length a)]
        (when (not (~f (nth a i)))
          (do
            (set! res false)
            (break))))
      res))

  (doc find "Finds an element in `a` that matches the function `f`.")
  (defn find [f a]
    (let-do [res (zero)]
      (for [i 0 (length a)]
        (when (~f (nth a i))
          (do
            (set! res @(nth a i))
            (break))))
      res))

  (doc first "Take the first element of an array.")
  (defn first [a]
    @(Array.nth a 0))

  (doc last "Take the last element of an array.")
  (defn last [a]
    @(Array.nth a (Int.dec (Array.length a))))

  (doc = "Compare two arrays.")
  (defn = [a b]
    (if (/= (length a) (length b))
      false
      (let-do [eq true]
        (for [i 0 (length a)]
          (when (/= @(nth a i) @(nth b i))
            (do
              (set! eq false)
              (break))))
        eq)))

  (defn /= [a b]
    (not (= (the (Ref (Array a)) a) b)))

  (doc maximum "Get the maximum in an array (elements must support <).")
  (defn maximum [xs]
    (let [result (first xs)
          n (length xs)]
      (do
        (for [i 1 n]
          (let [x @(nth xs i)]
            (if (< result x)
              (set! result x)
              ())))
        result)))

  (doc minimum "Get the maximum in an array (elements must support >).")
  (defn minimum [xs]
    (let [result (first xs)
          n (length xs)]
      (do
        (for [i 1 n]
          (let [x @(nth xs i)]
            (if (> result x)
              (set! result x)
              ())))
        result)))

  (doc minimum "Sum an array (elements must support + and zero).")
  (defn sum [xs]
    (Array.reduce &(fn [x y] (+ x @y)) (zero) xs))

  (doc subarray "Get subarray from start-index to end-index.")
  (defn subarray [xs start-index end-index]
    (let [result []]
      (do
        (for [i start-index end-index]
          (set! result (push-back result @(nth xs i))))
        result)))

  (doc prefix-array "Get prefix-array to end-index.")
  (defn prefix-array [xs end-index]
    (subarray xs 0 end-index))

  (doc suffix-array "Get subarray from start-index.")
  (defn suffix-array [xs start-index]
    (subarray xs start-index (length xs)))

  (doc reverse "Reverse an array.")
  (defn reverse [a]
    (let-do [i 0
             j (Int.dec (length &a))]
      (while (Int.< i j)
        (let-do [tmp @(nth &a i)]
          (aset! &a i @(nth &a j))
          (set! i (Int.inc i))
          (aset! &a j tmp)
          (set! j (Int.dec j))))
      a))

  (doc index-of "Get the index of element e in an array.")
  (defn index-of [a e]
    (let-do [idx -1]
      (for [i 0 (length a)]
        (when (= (nth a i) &e)
          (do
            (set! idx i)
            (break))))
      idx))

  (doc element-count "Count occurrences of element e in an array.")
  (defn element-count [a e]
    (let-do [c 0]
      (for [i 0 (length a)]
        (when (= e (nth a i)) (set! c (Int.inc c))))
      c))

  (doc aupdate "Transmute the element at index i of array a using function f.")
  (defn aupdate [a i f]
    (let [new-value (~f (nth &a i))]
      (aset a i new-value)))

  (doc aupdate! "Transmute the element at index i of array a using function f in place.")
  (defn aupdate! [a i f]
    (aset! a i (~f (nth a i))))

  (doc swap "Swap indices i and j of array a.")
  (defn swap [a i j]
    (let [x @(nth &a i)
          y @(nth &a j)]
      (aset (aset a i y) j x)))

  (doc swap! "Swap indices i and j of array a in place.")
  (defn swap! [a i j]
    (let-do [x @(nth a i)
             y @(nth a j)]
      (aset! a i y)
      (aset! a j x)))

  ; cannot use for, because we want also be able to go downwards
  (doc range "Create an array from start to end with step between them (the elements must support <, <=, and >=).")
  (defn range [start end step]
    (let-do [x (allocate (Int.inc (Int.abs (/ (- end start) step))))
             e start
             i 0
             op (if (< start end) <= >=)]
      (while (op e end)
        (do
          (aset! &x i e)
          (set! i (Int.inc i))
          (set! e (+ e step))))
      x))

  (doc repeat "Repeat function f n times and store the results in an array.")
  (defn repeat [n f]
    (let-do [a (allocate n)]
      (for [i 0 n] (aset-uninitialized! &a i (~f)))
      a))

  (doc repeat-indexed "Repeat function f n times and store the results in an array (will be supplied with the index).")
  (defn repeat-indexed [n f]
    (let-do [a (allocate n)]
      (for [i 0 n] (aset-uninitialized! &a i (f i)))
      a))

  (doc replicate "Repeat element e n times and store the results in an array.")
  (defn replicate [n e]
    (let-do [a (allocate n)]
      (for [i 0 n] (aset-uninitialized! &a i @e))
      a))

  (doc copy-map "Map over array a using function f (copies the array).")
  (defn copy-map [f a]
    (let-do [na (allocate (length a))]
      (for [i 0 (length a)]
        (aset-uninitialized! &na i (~f (nth a i))))
      na))

  (doc zip "Map over two arrays using a function that takes two arguments. Produces a new array with the length of the shorter input.")
  (defn zip [f a b]
    (let-do [l (Int.min (length a) (length b))
             na (allocate l)]
      (for [i 0 l]
        (aset-uninitialized! &na i (~f (nth a i) (nth b i))))
      na))

  (doc sum-length "Returns the sum of lengths from an Array of Arrays.")
  (defn sum-length [xs]
    (let-do [sum 0
             lxs (Array.length xs)]
      (for [i 0 lxs]
        (set! sum (+ sum (Array.length (Array.nth xs i)))))
      sum))

  (doc zero "Returns the empty array.")
  (defn zero [] [])

  (doc concat "Returns a new Array which is the concatenation of the provided `xs`.")
  (defn concat [xs]
    ;; This is using a StringBuilder pattern to only perform one allocation and
    ;; to only copy each of the incoming Array(s) once.
    ;; This currently performs wasted Array.length calls, as we call it for each
    ;; Array once here and once in sum-length.
    (let-do [j 0
             lxs (Array.length xs)
             result (Array.allocate (sum-length xs))]
      (for [i 0 lxs]
        (let-do [arr (Array.nth xs i)
                 len (Array.length arr)]
          (for [k 0 len]
            (aset-uninitialized! &result (+ j k) @(Array.nth arr k)))
          (set! j (+ j len))))
      result))

  (doc enumerated "Create a new array of Pair:s where the first position is the index and the second position is the element from the original array.")
  (defn enumerated [xs]
    (zip &Pair.init-from-refs
         &(range 0 (length xs) 1) ;; Inefficient, creates a temporary array.
         xs))
)