Carp/core/Map.carp

809 lines
25 KiB
Plaintext
Raw Permalink Normal View History

2018-06-11 21:50:54 +03:00
(definterface hash (Fn [(Ref a)] Int))
(defmodule String
2019-01-16 19:48:34 +03:00
(defn hash [k]
2018-06-11 21:50:54 +03:00
(let-do [a 31415
b 27183
vh 0]
(for [x 0 (length k)]
(do
2019-01-16 19:48:34 +03:00
(set! vh (+ (* a vh) (Char.to-int (char-at k x))))
2018-06-11 21:50:54 +03:00
(set! a (* a b))
(set! x (Int.inc x))))
(Int.abs vh)))
(implements hash String.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Int
(defn hash [k] (the Int @k))
(implements hash Int.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Long
(defn hash [k] (to-int (the Long @k)))
(implements hash Long.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Bool
(defn hash [k] (if (the Bool @k) 1 0))
(implements hash Bool.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Char
(defn hash [k] (to-int (the Char @k)))
(implements hash Char.hash)
2018-06-11 21:50:54 +03:00
)
2019-10-25 16:12:36 +03:00
(defmodule Byte
(defn hash [k] (to-int (the Byte @k)))
(implements hash Byte.hash)
2019-10-25 16:12:36 +03:00
)
2018-06-11 21:50:54 +03:00
(defmodule Float
2020-02-17 12:42:07 +03:00
(defn hash [k] (Float.to-bytes @k))
(implements hash Float.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Double
2020-02-17 12:42:07 +03:00
(defn hash [k] (Long.to-int (Double.to-bytes @k)))
(implements hash Double.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Int8
(defn hash [k] (Long.to-int (Int8.to-long @k)))
(implements hash Int8.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Int16
(defn hash [k] (Long.to-int (Int16.to-long @k)))
(implements hash Int16.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Int32
(defn hash [k] (Long.to-int (Int32.to-long @k)))
(implements hash Int32.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Int64
(defn hash [k] (Long.to-int (Int64.to-long @k)))
(implements hash Int64.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Uint8
(defn hash [k] (Long.to-int (Uint8.to-long @k)))
(implements hash Uint8.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Uint16
(defn hash [k] (Long.to-int (Uint16.to-long @k)))
(implements hash Uint16.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Uint32
(defn hash [k] (Long.to-int (Uint32.to-long @k)))
(implements hash Uint32.hash)
2020-02-17 12:42:07 +03:00
)
(defmodule Uint64
(defn hash [k] (Long.to-int (Uint64.to-long @k)))
(implements hash Uint64.hash)
2018-06-11 21:50:54 +03:00
)
(defmodule Pair
(defn hash [pair]
(let-do [code 17]
(set! code (+ (* 31 code) (hash (Pair.a pair))))
(set! code (+ (* 31 code) (hash (Pair.b pair))))
code))
(implements hash Pair.hash)
)
(deftype (Bucket a b) [entries (Array (Pair a b))])
2018-06-11 21:50:54 +03:00
(defmodule Bucket
(defn empty []
(Bucket.init []))
2018-12-07 18:08:55 +03:00
(defn find [b k]
(let-do [ret -1
2018-06-11 22:23:34 +03:00
l (Array.length (Bucket.entries b))
2018-06-11 21:50:54 +03:00
es (entries b)]
(for [i 0 l]
2019-10-31 12:23:23 +03:00
(when (= (Pair.a (Array.unsafe-nth es i)) k)
2018-06-11 21:50:54 +03:00
(do
2018-12-07 18:08:55 +03:00
(set! ret i)
2018-06-11 21:50:54 +03:00
(break))))
2018-12-07 18:08:55 +03:00
ret))
(defn get-idx [b i]
2019-10-31 12:23:23 +03:00
@(Pair.b (Array.unsafe-nth (entries b) i)))
(defn set-idx [b i val]
(do (Array.aupdate! (entries &b) i &(fn [p] (Pair.set-b p @val)))
b))
2020-01-27 18:58:10 +03:00
(defn set-idx! [b i val]
(Array.aupdate! (entries b) i &(fn [p] (Pair.set-b p @val))))
2020-01-27 18:58:10 +03:00
(defn push-back [b k v]
(do (Array.push-back! (entries &b) (Pair.init-from-refs k v))
b))
2020-01-27 18:58:10 +03:00
(defn push-back! [b k v]
(Array.push-back! (entries b) (Pair.init-from-refs k v)))
(defn get [b k default-value]
(let [i (find b k)]
(if (<= 0 i)
(get-idx b i)
@default-value)))
2018-12-03 21:45:23 +03:00
(defn get-maybe [b k]
(let [i (find b k)]
(if (<= 0 i)
2019-03-26 16:30:00 +03:00
;; The call to copy ('@') here is annoying - had to add it since sumtypes can't contain refs for now:
2019-10-31 12:23:23 +03:00
(Maybe.Just @(Pair.b (Array.unsafe-nth (entries b) i)))
(Maybe.Nothing))))
2018-12-03 21:45:23 +03:00
(defn put [b k v]
(let [i (find &b k)]
(if (<= 0 i)
(set-idx b i v)
(push-back b k v))))
2018-06-11 21:50:54 +03:00
2020-01-27 18:58:10 +03:00
(defn put! [b k v]
(let [i (find b k)]
(if (<= 0 i)
(set-idx! b i v)
(push-back! b k v))))
2018-06-11 21:50:54 +03:00
(defn contains? [b k]
2018-12-07 18:08:55 +03:00
(<= 0 (find b k)))
2018-06-11 21:50:54 +03:00
(defn remove [entries k]
(let-do [nentries (the (Array (Pair a b)) [])]
2018-06-11 22:23:34 +03:00
(for [i 0 (Array.length entries)]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries i)]
(unless (= (Pair.a e) k)
2018-06-11 22:23:34 +03:00
(set! nentries (Array.push-back nentries @e)))))
2018-06-11 21:50:54 +03:00
nentries))
(defn shrink [b k]
(if (contains? &b k)
(let [nentries (remove (entries &b) k)]
(set-entries b nentries))
b))
2018-06-11 21:50:54 +03:00
)
(deftype (Map a b) [len Int n-buckets Int buckets (Array (Bucket a b))])
(doc Map
"is a hashmap datatype, i.e. a key-value structure. It allows you to put in "
"pairs of keys and values and look them up by key."
""
"Implementation notes: it is a dense double-array-backed structure that"
"grows and shrinks based on load.")
2018-06-11 21:50:54 +03:00
(defmodule Map
2018-06-13 18:14:39 +03:00
(hidden dflt-len)
2018-06-11 21:50:54 +03:00
(def dflt-len 256)
(doc min-load "The load a map needs to reach in order to shrink.")
(def min-load 20)
(doc max-load "The load a map needs to reach in order to grow.")
(def max-load 80)
2018-08-25 20:51:27 +03:00
(doc create "Create an empty map.")
2018-06-11 21:50:54 +03:00
(defn create []
(init 0 dflt-len (Array.repeat dflt-len &Bucket.empty)))
(private put-!)
(hidden put-!)
(defn put-! [m k v]
(let-do [idx (Int.positive-mod (hash k) @(n-buckets m))
b (buckets m)
n (Array.unsafe-nth b idx)]
(set-len! m (Int.inc @(len m)))
(Bucket.put! n k v)))
2018-06-11 21:50:54 +03:00
(doc resize "Resize a map `m` to size `s`.")
(defn resize [m s]
(let-do [n (init 0 s (Array.repeat s &Bucket.empty))]
(for [i 0 @(n-buckets &m)]
(let [bucket (Array.unsafe-nth (buckets &m) i)
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
(let [e (Array.unsafe-nth entries j)]
(put-! &n (Pair.a e) (Pair.b e))))))
n))
(doc grow "Grow a map `m`. Should usually be handled automatically.")
(defn grow [m] (resize m (* @(n-buckets &m) 2)))
(doc shrink "Shrink a map `m`. Should usually be handled automatically.")
(defn shrink [m]
(let [new-size (/ @(n-buckets &m) 2)]
(if (< new-size dflt-len)
m
(resize m new-size))))
(doc contains? "Check whether the map m contains the key k.")
(defn contains? [m k]
(let [idx (Int.positive-mod (hash k) @(n-buckets m))]
(Bucket.contains? (Array.unsafe-nth (buckets m) idx) k)))
(doc put "Put a value v into map m, using the key k.")
2018-06-11 21:50:54 +03:00
(defn put [m k v]
(if (> (/ (* @(len &m) 100) @(n-buckets &m)) min-load)
(put (grow m) k v)
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))
in? (contains? &m k)]
(update-len
(update-buckets m &(fn [b]
(let [n (Array.unsafe-nth &b idx)]
(Array.aset b idx (Bucket.put @n k v)))))
&(if in? id Int.inc)))))
(doc put! "Put a value v into map m, using the key k, in place.")
2019-05-22 21:13:38 +03:00
(defn put! [m k v]
(put-! m k v))
2019-05-22 21:13:38 +03:00
(doc get-with-default "Get the value for the key k from map m. If it isnt found, the default is returned.")
(defn get-with-default [m k default-value]
(let [idx (Int.positive-mod (hash k) @(n-buckets m))]
2019-10-31 12:23:23 +03:00
(Bucket.get (Array.unsafe-nth (buckets m) idx) k default-value)))
2018-08-25 20:51:27 +03:00
(doc get "Get the value for the key k from map m. If it isnt found, a zero element for the value type is returned.")
2018-06-11 21:50:54 +03:00
(defn get [m k]
(get-with-default m k &(zero)))
2018-06-11 21:50:54 +03:00
(doc get-maybe "Get the value for the key k from map m. It returns a Maybe type, meaning that if nothing is found, Nothing is returned.")
(defn get-maybe [m k]
(let [idx (Int.positive-mod (hash k) @(n-buckets m))]
2019-10-31 12:23:23 +03:00
(Bucket.get-maybe (Array.unsafe-nth (buckets m) idx) k)))
(doc update "Update value at key k in map with function f, if it exists.")
(defn update [m k f]
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
(update-buckets m &(fn [b]
2019-10-31 12:23:23 +03:00
(let [n (Array.unsafe-nth &b idx)
i (Bucket.find n k)]
(if (<= 0 i)
;; currently can't write a Bucket.update that takes f due to bug #347
(Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
b))))))
(doc update-with-default "Update value at key k in map with function f. If k doesn't exist in map, set k to (f v).")
(defn update-with-default [m k f v]
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
(update-buckets m &(fn [b]
2019-10-31 12:23:23 +03:00
(let [n (Array.unsafe-nth &b idx)
i (Bucket.find n k)]
(if (<= 0 i)
(Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
(Array.aset b idx (Bucket.push-back @n k &(~f @&v)))))))))
2018-06-13 18:14:39 +03:00
(doc length "Get the length of the map m.")
2018-06-11 21:50:54 +03:00
(defn length [m]
@(len m))
2018-06-11 21:50:54 +03:00
2019-05-24 19:30:00 +03:00
(doc empty? "Check whether the map m is empty.")
2018-06-11 21:50:54 +03:00
(defn empty? [m]
2021-01-20 11:54:08 +03:00
(= (Map.length m) 0))
(implements empty? Map.empty?)
2018-06-11 21:50:54 +03:00
2018-06-13 18:14:39 +03:00
(doc remove "Remove the value under the key k from the map m.")
2018-06-11 21:50:54 +03:00
(defn remove [m k]
(if (> (/ (* @(len &m) 100) @(n-buckets &m)) min-load)
(remove (shrink m) k)
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
(update-len
(update-buckets m &(fn [b]
(let [n (Array.unsafe-nth &b idx)]
(Array.aset b idx (Bucket.shrink @n k)))))
&Int.dec))))
2018-06-11 21:50:54 +03:00
2018-12-18 17:17:08 +03:00
(doc all? "Do all key-value pairs pass the given predicate (of two arguments)?")
(defn all? [pred m]
(let-do [ret true]
(for [i 0 @(n-buckets m)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets m) i)
2018-12-18 17:17:08 +03:00
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
2018-12-18 17:17:08 +03:00
(unless (~pred (Pair.a e) (Pair.b e))
(set! ret false))))))
ret))
(defn = [m1 m2]
(and (= (length m1) (length m2))
;; we could use contains? and get-with-default here to avoid requiring a (zero) for the value type
(all? &(fn [k v] (= v &(get m2 k))) m1)))
(implements = Map.=)
2018-12-18 17:17:08 +03:00
2018-08-25 20:51:27 +03:00
(doc for-each "Execute the binary function f for all keys and values in the map m.")
2018-06-11 21:50:54 +03:00
(defn for-each [m f]
(for [i 0 @(n-buckets m)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets m) i)
2018-06-11 22:23:34 +03:00
len (Array.length (Bucket.entries bucket))
2018-06-11 21:50:54 +03:00
entries (Bucket.entries bucket)]
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
(~f (Pair.a e) (Pair.b e)))))))
2018-06-11 21:50:54 +03:00
2018-12-07 14:22:09 +03:00
(doc endo-map "Transform values of the given map in place. f gets two arguments, key and value, and should return new value")
(defn endo-map [f m]
(do
(for [i 0 @(n-buckets &m)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets &m) i)
2018-12-07 14:22:09 +03:00
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
2018-12-07 14:22:09 +03:00
(Array.aset! entries j (Pair.init @(Pair.a e)
(~f (Pair.a e) (Pair.b e))))))))
2018-12-07 14:22:09 +03:00
m))
2018-12-07 14:11:05 +03:00
(doc kv-reduce "Reduce a map with a function of three arguments: state, key and value. Reduction order is not guaranteed.")
(defn kv-reduce [f init m]
(do
(for [i 0 @(n-buckets m)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets m) i)
len (Array.length (Bucket.entries bucket))
entries (Bucket.entries bucket)]
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
(set! init (~f init (Pair.a e) (Pair.b e)))))))
init))
(doc merge "Merge two maps `m1` and `m2`. On collision the value from `m2` is preferred.")
(defn merge [m1 m2]
(kv-reduce &(fn [m k v] (put m k v)) m1 m2))
2018-12-07 14:11:05 +03:00
(doc vals "Return an array of the values of the map. Order corresponds to order of (keys m)")
(defn vals [m]
(kv-reduce &(fn [arr _ v] (Array.push-back arr @v))
[]
m))
2018-12-07 14:11:05 +03:00
(doc keys "Return an array of the keys of the map. Order corresponds to order of (vals m)")
(defn keys [m]
(kv-reduce &(fn [arr k _] (Array.push-back arr @k))
[]
m))
2018-06-13 18:14:39 +03:00
(doc from-array "Create a map from the array a containing key-value pairs.")
2018-06-11 21:50:54 +03:00
(defn from-array [a]
(let-do [m (create)]
(for [i 0 (Array.length &a)]
(let [e (Array.unsafe-nth &a i)
2018-06-11 21:50:54 +03:00
k (Pair.a e)
v (Pair.b e)]
(put! &m k v)))
2018-06-11 21:50:54 +03:00
m))
2018-08-06 21:47:09 +03:00
(doc to-array "Convert Map to Array of Pairs")
(defn to-array [m]
(kv-reduce &(fn [arr k v] (Array.push-back arr (Pair.init-from-refs k v)))
[]
m))
2018-08-06 21:47:09 +03:00
(defn str [m]
(let [res (kv-reduce &(fn [s k v]
(String.join "" &[s @" " (prn @k) @" " (prn @v)]))
@"{"
m)]
2018-08-06 21:47:09 +03:00
(String.append &res " }")))
2019-05-05 12:49:30 +03:00
2019-05-05 12:55:37 +03:00
(doc reverse "reverses they keys and values in a given map `m`.")
2019-05-05 12:49:30 +03:00
(defn reverse [m]
(from-array (Array.copy-map &Pair.reverse &(to-array m))))
2018-06-11 21:50:54 +03:00
)
(deftype (SetBucket a) [entries (Array a)])
(defmodule SetBucket
(defn empty []
(SetBucket.init []))
(defn grow [b e]
(set-entries @b (Array.push-back @(entries b) e)))
(defn contains? [b k]
(let-do [e false
es (entries b)
l (Array.length es)]
(for [i 0 l]
2019-10-31 12:23:23 +03:00
(when (= (Array.unsafe-nth es i) k)
(do
(set! e true)
(break))))
e))
(defn remove [entries k]
(let-do [nentries []]
(for [i 0 (Array.length entries)]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries i)]
(unless (= e k)
(set! nentries (Array.push-back nentries @e)))))
nentries))
2020-01-27 18:58:10 +03:00
(defn push-back! [b k]
(Array.push-back! (entries b) k))
(defn shrink [b k]
(if (contains? b k)
(set-entries @b (remove (entries b) k))
@b))
)
(deftype (Set a) [len Int n-buckets Int buckets (Array (SetBucket a))])
2018-06-11 21:50:54 +03:00
(doc Set
"is a hashset datatype, i.e. a unique list structure. It allows you to put "
"in values and guarantees uniqueness."
""
"Implementation notes: it is a dense double-array-backed structure that"
"grows and shrinks based on load, similar to `Map`.")
2018-06-11 21:50:54 +03:00
(defmodule Set
2018-08-25 20:51:27 +03:00
(hidden dflt-len)
2018-06-11 21:50:54 +03:00
(def dflt-len 256)
(doc min-load "The load a set needs to reach in order to shrink.")
(def min-load 20)
(doc max-load "The load a set needs to reach in order to grow.")
(def max-load 80)
2018-08-25 20:51:27 +03:00
(doc create "Create an empty set.")
2018-06-11 21:50:54 +03:00
(defn create []
(init 0 dflt-len (Array.repeat dflt-len &SetBucket.empty)))
(private put-!)
(hidden put-!)
(defn put-! [s v]
(let-do [idx (Int.positive-mod (hash v) @(n-buckets s))
b (buckets s)
n (Array.unsafe-nth b idx)]
(set-len! s (Int.inc @(len s)))
(SetBucket.push-back! n @v)))
(doc resize "Resize a set `s` to size `size`.")
(defn resize [s size]
(let-do [n (init 0 size (Array.repeat size &SetBucket.empty))]
(for [i 0 @(n-buckets &s)]
(let [bucket (Array.unsafe-nth (buckets &s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
(for [j 0 len]
(let [e (Array.unsafe-nth entries j)]
(put-! &n e)))))
n))
(doc grow "Grow a set `s`. Should usually be handled automatically.")
(defn grow [s] (resize s (* @(n-buckets &s) 2)))
(doc shrink "Shrink a set `s`. Should usually be handled automatically.")
(defn shrink [s]
(let [new-size (/ @(n-buckets &s) 2)]
(if (< new-size dflt-len)
s
(resize s new-size))))
(doc contains? "Check whether the set `s` contains the value `v`.")
(defn contains? [s v]
(let [idx (Int.positive-mod (hash v) @(n-buckets s))]
(SetBucket.contains? (Array.unsafe-nth (buckets s) idx) v)))
(doc put "Put a value `v` into the set `s`.")
(defn put [s v]
(cond
(contains? &s v)
s
(> (/ (* @(len &s) 100) @(n-buckets &s)) min-load)
(put (grow s) v)
(let [idx (Int.positive-mod (hash v) @(n-buckets &s))
;; The lifetime system really doesn't like this function, had to put in a bunch of copying to make it compile:
]
(update-len
(update-buckets s &(fn [b]
(let [n (Array.unsafe-nth &b idx)]
(let [new-k @v] ;; HACK!
(Array.aset b idx (SetBucket.grow n new-k))))))
&Int.inc))))
(doc put! "Put a value `v` into the set `s`, in place.")
(defn put! [s v]
(unless (contains? s v)
(put-! s v)))
2019-05-22 21:13:38 +03:00
2018-08-25 20:51:27 +03:00
(doc length "Get the length of set s.")
(defn length [s]
@(len s))
2018-06-11 21:50:54 +03:00
2018-08-25 20:51:27 +03:00
(doc empty? "Check whether the set s is empty.")
(defn empty? [s]
2021-01-20 11:54:08 +03:00
(= (Set.length s) 0))
(implements empty? Set.empty?)
2018-06-11 21:50:54 +03:00
(doc remove "Remove the value `v` from the set `s`.")
(defn remove [s v]
(cond
(not (contains? &s v))
s
(> (/ (* @(len &s) 100) @(n-buckets &s)) min-load)
(remove (shrink s) v)
(let [idx (Int.positive-mod (hash v) @(n-buckets &s))]
(update-len
(update-buckets s &(fn [b]
(let [n (Array.unsafe-nth &b idx)]
(Array.aset b idx (SetBucket.shrink n v)))))
&Int.dec))))
2018-06-11 21:50:54 +03:00
2018-12-18 16:58:58 +03:00
(doc all? "Does the predicate hold for all values in this set?")
(defn all? [pred set]
(let-do [ret true]
2018-12-18 16:58:58 +03:00
(foreach [bucket (buckets set)]
(foreach [e (SetBucket.entries bucket)]
2018-12-18 16:58:58 +03:00
(unless (~pred e)
(do
(set! ret false)
(break)))))
ret))
2018-12-18 16:58:58 +03:00
(doc subset? "Is set-a a subset of set-b?")
(defn subset? [set-a set-b]
(all? &(fn [e] (Set.contains? set-b e)) set-a))
(defn = [set-a set-b]
(and (= (Set.length set-a) (Set.length set-b))
(subset? set-a set-b)))
(implements = Set.=)
2018-08-25 20:51:27 +03:00
(doc for-each "Execute the unary function f for each element in the set s.")
(defn for-each [s f]
(for [i 0 @(n-buckets s)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
2018-06-11 21:50:54 +03:00
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
(~f e))))))
2018-06-11 21:50:54 +03:00
2018-06-13 18:14:39 +03:00
(doc from-array "Create a set from the values in array a.")
2018-06-11 21:50:54 +03:00
(defn from-array [a]
2018-08-25 20:51:27 +03:00
(let-do [s (create)]
2018-06-11 22:23:34 +03:00
(for [i 0 (Array.length a)]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth a i)]
(put! &s e)))
2018-08-25 20:51:27 +03:00
s))
2018-08-06 21:55:41 +03:00
2018-12-07 14:15:23 +03:00
(doc reduce "Reduce values of the set with function f. Order of reduction is not guaranteed")
(defn reduce [f init s]
(do
2018-08-25 20:51:27 +03:00
(for [i 0 @(n-buckets s)]
2019-10-31 12:23:23 +03:00
(let [bucket (Array.unsafe-nth (buckets s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
2018-08-06 21:55:41 +03:00
(for [j 0 len]
2019-10-31 12:23:23 +03:00
(let [e (Array.unsafe-nth entries j)]
(set! init (~f init e))))))
2018-12-07 14:15:23 +03:00
init))
(doc intersection "Set of elements that are in both set-a and set-b")
(defn intersection [set-a set-b]
(reduce &(fn [s a] (if (Set.contains? set-b a) (Set.put s a) s))
(Set.create)
set-a))
(doc union "Set of elements that are in either set-a or set-b (or both)")
(defn union [set-a set-b]
(reduce &Set.put
@set-a
set-b))
(doc difference "Set of elements that are in set-a but not set-b")
(defn difference [set-a set-b]
(reduce &Set.remove
@set-a
set-b))
(doc to-array "Convert Set to Array of elements")
(defn to-array [s]
(reduce &(fn [arr elt] (Array.push-back arr @elt)) [] s))
2018-12-07 14:15:23 +03:00
(defn str [set]
(let [res (reduce &(fn [s e] (String.join "" &[s @" " (prn e)]))
2018-12-07 14:15:23 +03:00
@"{"
set)]
2018-08-06 21:55:41 +03:00
(String.append &res " }")))
(implements str Set.str)
2018-06-11 21:50:54 +03:00
)
; Dynamic maps:
(defmodule Dynamic
(doc n-times "make a list by executing `f` `n` times.")
(defndynamic n-times [n f]
(if (= n 0)
'()
(cons (f) (n-times (dec n) f))))
(defmodule Pair
(doc init "creates a dynamic pair, i.e. a list with two elements.")
(defndynamic init [k v] (list k v)))
(defmodule Map
(hidden dflt-len)
(defdynamic dflt-len 16)
(hidden min-load)
(defdynamic min-load 20)
(hidden max-load)
(defdynamic max-load 80)
(doc create "makes a dynamic map.")
(defndynamic create []
(n-times Map.dflt-len list))
(hidden resize-bucket)
(defndynamic resize-bucket [n m]
(if (empty? m)
n
(Map.resize-bucket (Map.put n (caar m) (cadar m)) (cdr m))))
(hidden resize-)
(defndynamic resize- [n m]
(if (empty? m)
n
(do
(Map.resize- (Map.resize-bucket n (car m)) (cdr m)))))
(doc resize "resizes a dynamic map to size `s`.")
(defndynamic resize [m s]
(let-do [n (n-times s list)]
(Map.resize- n m )))
(doc grow "grows a dynamic map.")
(defndynamic grow [m] (Map.resize m (* (length m) 2)))
(doc shrink "shrinks dynamic map.")
(defndynamic shrink [m]
(let [new-size (/ (length m) 2)]
(if (< new-size dflt-len)
m
(Map.resize m new-size))))
(doc contains? "checks whether the dynamic map `m` contains the key `k`.")
(defndynamic contains? [m k]
(let [idx (Dynamic.imod (hash k) (length m))]
(List.in? k (map car (List.nth m idx)))))
(doc put "adds a value `v` under the key `k` into the map. If `k` already
exists in the map, it is updated.")
(defndynamic put [m k v]
(if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
(Map.put (Map.grow m) k v)
(if (Map.contains? m k)
(Map.update m k (fn [_] v))
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx (fn [l] (cons (list k v) l)))))))
(doc get-with-default "gets the value under the key `k`. If `k` doesnt
exist in the map, the default value is returned.")
(defndynamic get-with-default [m k default-value]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))
l (List.nth m idx)]
(cadr (List.find l (fn [pair] (= (car pair) k)))))
default-value))
(doc get "gets the value under the key `k`. If `k` doesnt exist in the
map, `nil` is returned.")
(defndynamic get [m k]
(Map.get-with-default m k nil))
(doc update "updates the value under the key `k` using the function `f`. If
`k` doesnt exist in the map, it is returned unchanged.")
(defndynamic update [m k f]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx
(curry
map
(fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
m))
(doc update-with-default "updates the value under the key `k` using the
function `f`. If `k` doesnt exist in the map, it is set to `(f v)`.")
(defndynamic update-with-default [m k f v]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx
(curry
map
(fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
(Map.put m k (f v))))
(doc len "returns the length of the map `m`.")
(defndynamic len [m]
(reduce (fn [acc l] (+ acc (length l))) 0 m))
(doc empty? "checks whether the map `m` is empty.")
(defndynamic empty? [m]
(= (Map.len m) 0))
(doc keys "returns the key in the map `m`.")
(defndynamic keys [m]
(reduce (fn [acc l] (append acc (map car l))) '() m))
(doc vals "returns the values in the map `m`.")
(defndynamic vals [m]
(reduce (fn [acc l] (append acc (map cadr l))) '() m))
(doc reverse "reverses the key-value pairs in the map `m`.")
(defndynamic reverse [m]
(reduce
(fn [acc l] (reduce (fn [n p] (Map.put n (cadr p) (car p))) acc l))
(Map.create) m))
(defndynamic str [m]
(String.concat [
"{ "
(reduce
(fn [acc l]
(String.concat [
acc
(reduce
(fn [a pair] (String.concat [a (str (car pair)) " " (str (cadr pair)) " "]))
""
l)
]))
""
m)
"}"]))
(doc remove "removes the pair under the key `k` from the map `m`. If it
doesnt exist, the map is returned unchanged.")
(defndynamic remove [m k]
(if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
(Map.remove (Map.shrink m) k)
(let [idx (imod (hash k) (length m))]
(reduce (fn [acc l] (cons (filter (fn [pair] (/= (car pair) k)) l) acc)) '() m))))
(doc all? "checks whether all key value pairs in `m` satisfy the predicate
`pred`. `pred` takes the pair `(k v)` as its sole argument.")
(defndynamic all? [pred m]
; TODO: using (curry all? pred) doesnt work here, i suppose its an env
; problem
(all? (fn [l] (all? pred l)) m))
(doc = "checks whether two maps `m1` and `m2` are equal.")
(defndynamic = [m1 m2]
(and (= (Map.len m1) (Map.len m2))
(Map.all? (fn [pair] (= (cadr pair) (Map.get m2 (car pair)))) m1)))
(doc map "maps the function `f` over all pairs in the map `m`. `f` takes
the pair `(k v)` as its sole argument and is expected to return a new value
under `v`.")
(defndynamic map [f m]
(map (fn [l] (map (fn [pair] (list (car pair) (f pair))) l)) m))
(doc kv-reduce "reduces the map `m` using the function `f` and the initial
value `init`. `f` takes the accumulator and the pair `(k v)` as its arguments
and is expected to return a new accumulator.")
(defndynamic kv-reduce [f init m]
(reduce (fn [acc l] (reduce f acc l)) init m))
(doc merge "merges to maps `m1` and `m2`. Values in `m1` are preferred on
collision.")
(defndynamic merge [m1 m2]
(Map.kv-reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) m1 m2))
(doc from-array "creates a map from an array of key-value pairs `a`.")
(defndynamic from-array [a]
(reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) (Map.create) a))
(doc to-array "creates an array of key-value pairs from the map `m`.")
(defndynamic to-array [m] (collect-into (reduce append '() m) array))
)
)