# [ʞ] alg.janet
# ~ lexi hale <lexi@hale.su>
# 🄯 AGPLv3
# ? basic algorithms inexplicably missing from std
(defn vect ``
vectorize primitive operations
`(vect + [1 2 3] [3 2 1]) #→ [4 4 4]`
`(vect * [1 2 ] [2 2 5]) #→ [2 4 5]`
`` [op & vecs]
(def a @[])
(var col 0)
(forever
# theoretically this should be as simple as ;(map idx v)
# but we want to handle missing columns sanely, which is
# more complicated.
(def args
(mapcat (fn [v]
(if (>= col (length v)) []
[(get v col)]))
vecs))
(when (empty? args) (break))
(put a col (apply op args))
(++ col))
(freeze a))
(defn clamp [v &opt m x]
(min (or x 1) (max (or m 0) v)))
(defn xlerp [t a b]
(+ (* a (- 1 t))
(* b t)))
(defn lerp [t a b]
(xlerp (clamp t) a b))
(defn sel "return a record filtered by a key predicate"
[rec p]
(def r @{})
(eachp (k v) rec
(when (p k) (put r k v)))
(if (table? rec) r (freeze r)))
(defn qrec "query a record by key names, returning a matching sub-record"
[rec & ks]
(def r @{})
(each k ks
(put r k (get rec k)))
(if (table? rec) r (freeze r)))
(defn llut "get the lerp halves for a linear lookup table"
[t lut]
(def t (clamp t))
(case t
0 [0 (first lut) (first lut)]
1 [1 (last lut) (last lut)]
(do (def q (- (length lut) 1))
(def n (* q t))
(def idx (math/trunc n))
(def frac (- n idx))
[frac
(lut idx)
(lut (+ 1 idx))])))
(defn ilut "interpolate a linear lookup table"
[t lut]
(lerp ;(llut t lut)))
(defn vlut "interpolate a linear vector lookup table"
[t lut]
(def [fac a b] (llut t lut))
(vect |(lerp fac ;$&) a b))
(defn lut-bake "bake a lut from a function"
[res f]
(def t (array/ensure @[] res 1))
(loop [i :range [0 res] :let [fac (/ i res)]]
(put t i (f fac)))
t)