Skip to content

Commit e4adef0

Browse files
hellervehellerve
authored
feat: add bag data structure (#1429)
* feat: add bag data structure * refactor: incorporate feedback by scolsen
1 parent 4c24c9e commit e4adef0

File tree

2 files changed

+226
-7
lines changed

2 files changed

+226
-7
lines changed

‎core/Map.carp

+113-7
Original file line numberDiff line numberDiff line change
@@ -274,13 +274,28 @@
274274

275275
(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).")
276276
(defn update-with-default [m k f v]
277-
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
278-
(update-buckets m &(fn [b]
279-
(let [n (Array.unsafe-nth &b idx)
280-
i (Bucket.find n k)]
281-
(if (<= 0 i)
282-
(Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
283-
(Array.aset b idx (Bucket.push-back @n k &(~f @&v)))))))))
277+
(let [idx (Int.positive-mod (hash k) @(n-buckets &m))
278+
in? (Map.contains? &m k)]
279+
(update-len
280+
(update-buckets m &(fn [b]
281+
(let [n (Array.unsafe-nth &b idx)
282+
i (Bucket.find n k)]
283+
(if (<= 0 i)
284+
(Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
285+
(Array.aset b idx (Bucket.push-back @n k &(~f @&v)))))))
286+
&(if in? id Int.inc))))
287+
288+
(doc update-with-default! "Update value at key k in map with function f, in-place. If k doesn't exist in map, set k to (f v).")
289+
(defn update-with-default! [m k f v]
290+
(let-do [idx (Int.positive-mod (hash k) @(n-buckets m))
291+
b (buckets m)
292+
n (Array.unsafe-nth b idx)
293+
i (Bucket.find n k)]
294+
(if (<= 0 i)
295+
(Array.aset! b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
296+
(do
297+
(set-len! m (Int.inc @(len m)))
298+
(Array.aset! b idx (Bucket.push-back @n k &(~f @&v)))))))
284299

285300
(doc length "Get the length of the map m.")
286301
(defn length [m]
@@ -806,3 +821,94 @@ collision.")
806821
(defndynamic to-array [m] (collect-into (reduce append '() m) array))
807822
)
808823
)
824+
825+
(deftype (Bag a) [
826+
internal (Map a Int)
827+
])
828+
829+
(doc Bag
830+
"is an unordered datatype that only stores all its equal elements once while preserving size by storing the count of each element."
831+
""
832+
"Implementation notes: it is a map from elements to number of occurrences"
833+
"under the hood.")
834+
(defmodule Bag
835+
(private internal)
836+
(hidden internal)
837+
(private set-internal)
838+
(hidden set-internal)
839+
(private update-internal)
840+
(hidden internal)
841+
842+
(doc create "Create an empty bag.")
843+
(defn create []
844+
(init (Map.create)))
845+
846+
(doc contains? "Check whether the bag `b` contains the value `v`.")
847+
(defn contains? [b v]
848+
(Map.contains? (internal b) v))
849+
850+
(doc put "Put a value `v` into the bag `b`.")
851+
(defn put [b v]
852+
(update-internal b &(fn [m] (Map.update-with-default m v &Int.inc 0))))
853+
854+
(doc put! "Put a value `v` into the bag `b` in-place.")
855+
(defn put! [b v]
856+
(Map.update-with-default! (internal b) v &Int.inc 0))
857+
858+
(doc length "Get the length of bag `b`.")
859+
(defn length [b]
860+
(Map.kv-reduce &(fn [acc _ v] (+ acc @v)) 0 (internal b)))
861+
862+
(doc empty? "Check whether the bag `b` is empty.")
863+
(defn empty? [b]
864+
(Map.empty? (internal b)))
865+
(implements empty? Bag.empty?)
866+
867+
(doc remove "Remove the value `v` from the bag `b`.")
868+
(defn remove [b v]
869+
(if (not (contains? &b v))
870+
b
871+
(update-internal b &(fn [m]
872+
(let [cnt (Map.get &m v)]
873+
(if (= cnt 1)
874+
(Map.remove m v)
875+
(Map.update m v &Int.dec)))))))
876+
877+
(doc all? "Does the predicate hold for all values in this bag?")
878+
(defn all? [pred bag]
879+
(Array.all? pred &(Map.keys (internal bag))))
880+
881+
(defn = [a b]
882+
(= (internal a) (internal b)))
883+
(implements = Bag.=)
884+
885+
(doc for-each "Execute the unary function f for each element in the bag b.")
886+
(defn for-each [b f]
887+
(doall f (Map.keys (internal b))))
888+
889+
(doc from-array "Create a bag from the values in array a.")
890+
(defn from-array [a]
891+
(let-do [b (create)]
892+
(for [i 0 (Array.length a)]
893+
(let [e (Array.unsafe-nth a i)]
894+
(put! &b e)))
895+
b))
896+
897+
(doc reduce "Reduce values of the bag b with function f. Order of reduction is not guaranteed")
898+
(defn reduce [f init b]
899+
(Map.kv-reduce
900+
&(fn [r k cnt] (Array.reduce f r &(Array.replicate @cnt k)))
901+
init
902+
(internal b)))
903+
904+
(doc to-array "Convert bag to Array of elements")
905+
(defn to-array [b]
906+
(reduce &(fn [arr elt] (Array.push-back arr @elt)) [] b))
907+
908+
(defn str [set]
909+
(let [res (reduce &(fn [s e] (String.join "" &[s @" " (prn e)]))
910+
@"(Bag"
911+
set)]
912+
(String.append &res ")")))
913+
(implements str Bag.str)
914+
)

‎test/map.carp

+113
Original file line numberDiff line numberDiff line change
@@ -356,4 +356,117 @@
356356
2
357357
(Array.length &(Set.to-array &(Set.from-array &[1 2])))
358358
"Set.to-array works 2"
359+
)
360+
(assert-true test
361+
(let-do [s (Bag.create)]
362+
(Bag.put! &s "1")
363+
(Bag.contains? &s "1"))
364+
"put! works"
365+
)
366+
(assert-equal test
367+
1
368+
(Bag.length &(Bag.put (Bag.create) "1"))
369+
"length works"
370+
)
371+
(assert-equal test
372+
2
373+
(Bag.length &(Bag.put (Bag.put (Bag.create) "1") "2"))
374+
"length works"
375+
)
376+
(assert-equal test
377+
2
378+
(Bag.length &(Bag.put (Bag.put (Bag.create) "1") "1"))
379+
"putting the same element twice increases size"
380+
)
381+
(assert-equal test
382+
0
383+
(Bag.length &(the (Bag Int) (Bag.create)))
384+
"length works on empty bag"
385+
)
386+
(assert-equal test
387+
false
388+
(Bag.contains? &(the (Bag String) (Bag.create)) "1")
389+
"contains? works on empty map"
390+
)
391+
(assert-equal test
392+
true
393+
(Bag.contains? &(Bag.put (Bag.create) "1") "1")
394+
"contains? works"
395+
)
396+
(assert-equal test
397+
true
398+
(Bag.contains? &(Bag.put (Bag.create) &-7) &-7)
399+
"contains? works with negative keys"
400+
)
401+
(assert-equal test
402+
true
403+
(Bag.empty? &(the (Bag Int) (Bag.create)))
404+
"empty? works on empty bag"
405+
)
406+
(assert-equal test
407+
false
408+
(Bag.empty? &(Bag.put (Bag.create) "1"))
409+
"empty? works"
410+
)
411+
(assert-equal test
412+
true
413+
(Bag.empty? &(Bag.remove (Bag.put (Bag.create) "1") "1"))
414+
"remove works"
415+
)
416+
(assert-equal test
417+
true
418+
(Bag.all? &(fn [i] (Int.even? @i)) &(Bag.from-array &[2 4 6 6]))
419+
"Bag.all? works I"
420+
)
421+
(assert-equal test
422+
false
423+
(Bag.all? &(fn [i] (Int.even? @i)) &(Bag.from-array &[2 4 7]))
424+
"Bag.all? works II"
425+
)
426+
(assert-equal test
427+
true
428+
(Bag.all? &(fn [i] false) &(the (Bag Int) (Bag.create)))
429+
"Bag.all? works on empty set"
430+
)
431+
(assert-equal test
432+
true
433+
(Bag.= &(Bag.from-array &[1 3 5]) &(Bag.from-array &[1 3 5]))
434+
"Bag.= works"
435+
)
436+
(assert-equal test
437+
false
438+
(Bag.= &(Bag.from-array &[1 3]) &(Bag.from-array &[1 3 5]))
439+
"Bag.= works II"
440+
)
441+
(assert-equal test
442+
false
443+
(Bag.= &(Bag.from-array &[1 3 5]) &(Bag.from-array &[1 3]))
444+
"Bag.= works III"
445+
)
446+
(assert-equal test
447+
false
448+
(Bag.= &(Bag.from-array &[1 3 5]) &(Bag.from-array &[1 4 5]))
449+
"Bag.= works IV"
450+
)
451+
(assert-equal test
452+
71
453+
(Bag.reduce &(fn [state i] (+ state (* 10 @i)))
454+
1
455+
&(Bag.from-array &[1 2 3 1]))
456+
"reduce works"
457+
)
458+
(assert-equal test
459+
"(Bag @\"hi\" @\"hi\" @\"bye\")"
460+
&(str &(Bag.from-array &[@"hi" @"bye" @"hi"]))
461+
"stringification works"
462+
)
463+
(assert-equal test
464+
&[1]
465+
&(Bag.to-array &(Bag.put (Bag.create) &1))
466+
"Bag.to-array works 1"
467+
)
468+
(assert-equal test
469+
3
470+
(Array.length &(Bag.to-array &(Bag.from-array &[1 2 1])))
471+
"Bag.to-array works 2"
359472
))

0 commit comments

Comments
 (0)