Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Some functions dealing with arrays

(defn array/+= (a i v)
      "Add V to the value in A at position I and store the result in A returning A"
      (set! a i (+ v (ref a i))))

(defn array/++ (a i)
      "Increment position I in A and return A"
      (array/+= a i 1))

(defn array/fill! (a v)
      "Fills array a with value v"
      (def len (:length a))
      (dotimes (i len a)
               (set! a i v)))

(defn array/append (a b)
      "Append array A to array B"
      (when-not (and (array? a) (array? b))
                (exception :type-error "array/append expects two arrays as its arguments"))
      (def ret (:alloc Array (+ (:length a) (:length b))))
      (dotimes (i (:length a))
               (set! ret i (ref a i)))
      (let ((i (:length a))
            (rl (:length ret)))
           (while (< i rl)
                  (set! ret i (ref b (- i (:length a))))
                  (set! i (add/int i 1))))
      (return ret))

(defn array/dup (a)
      "Duplicate Array A"
      (def ret (:alloc Array (:length a)))
      (dotimes (i (:length a) ret)
               (set! ret i (ref a i))))

(defn array/reduce (arr fun α)
      "Reduce an array, (reduce) should be preferred"
      (def len (:length arr))
      (dotimes (i len α)
               (set! α (fun α (ref arr i)))))

(defn array/map (arr fun)
      "Map an array, (map) should be preferred"
      (def len (:length arr))
      (dotimes (i len arr)
               (set! arr i (fun (ref arr i)))))

(defn array/filter (arr pred)
      "Filter an array, (filter) should be preferred"
      (def ri 0)
      (def len (:length arr))
      (def ret (:alloc Array len))
      (dotimes (ai len (:length! ret ri))
               (when (pred (ref arr ai))
                     (set! ret ri (ref arr ai))
                     (inc! ri))))

(defn array/equal? (a b)
      (if (or (not (array? a))
              (not (array? b))
              (not= (:length a)
                    (:length b)))
          (return #f)
          (dotimes (i (:length a) #t)
                   (when-not (equal? (ref a i)
                                     (ref b i))
                             (return #f)))))

(defn array/push (arr val)
      "Append VAL to ARR"
      (-> arr
          (:length! (+ 1 (:length arr)))
          (set! (- (:length arr) 1) val)))

(defn array/swap (arr i j)
      "Swap values at I and J in ARR"
      (def tmp (ref arr i))
      (-> arr
          (set! i (ref arr j))
          (set! j tmp)))

(def array/heap-sort (let*
                       (defn array/heapify (arr n at)
                             ; bubble up the element from index AT to until the max-heap property is satisfied
                             (def top at)
                             (def looping #t)
                             (while looping
                               (def l (+ (bit-shift-left at 1) 1))
                               (def r (+ (bit-shift-left at 1) 2))
                               (when (and (< l n) (> (ref arr l) (ref arr top)))
                                 (set! top l))
                               (when (and (< r n) (> (ref arr r) (ref arr top)))
                                 (set! top r))
                               (if (= top at)
                                   (set! looping #f)
                                   (do (array/swap arr at top)
                                       (set! at top))))
                             (return arr))

                       (defn array/make-heap (arr)
                             (def l (:length arr))
                             (def l2 (div/int l 2))
                             (while (>= l2 0)
                               (array/heapify arr l l2)
                               (dec! l2))
                             (return arr))

                       (defn array/heap-sort (arr)
                             (array/make-heap arr)
                             (def l (:length arr))
                             (while (> l 0)
                               (dec! l)
                               (array/swap arr 0 l)
                               (array/heapify arr l 0))
                             (return arr))))

(def array/sort array/heap-sort)

(defn array/cut (arr start end)
      "Return a newly allocated array with the values of ARR from START to END"
      (set! start (max 0 start))
      (set! end (min (:length arr) end))
      (def ret (:alloc Array (max 0 (- end start))))
      (def i start)
      (while (< i end)
             (set! ret (- i start) (ref arr i))
             (set! i (add/int i 1)))
      (return ret))