collection.egi

;;;;;
;;;;; Collection Test
;;;;;

;;;
;;; List Pattern-Matching
;;;
(assert "list's value pattern"
  (match {1 2 3} (list integer)
    {[,{@{@{1}} @{2 @{3}}} #t]
     [_ #f]}))

(assert "list's nil - case 1"
  (match {} (list integer)
    {[<nil> #t]
     [_ #f]}))

(assert "list's nil - case 2"
  (match {1} (list integer)
    {[<nil> #f]
     [_ #t]}))

(assert-equal "list's cons"
  (match {1 2 3} (list integer)
    {[<cons $n $ns> [n ns]]})
  [1 {2 3}])

(assert-equal "list's cons with value pattern"
  (match {1 2 3} (list integer)
    {[<cons ,1 $ns> ns]})
  {2 3})

(assert-equal "list's snoc"
  (match {1 2 3} (list integer)
    {[<snoc $n $ns> [n ns]]})
  [3 {1 2}])

(assert-equal "list's snoc with value pattern"
  (match {1 2 3} (list integer)
    {[<snoc ,3 $ns> ns]})
  {1 2})

(assert-equal "list's join"
  (match-all {1 2 3} (list integer)
    [<join $xs $ys> [xs ys]])
  {[{} {1 2 3}]
   [{1} {2 3}]
   [{1 2} {3}]
   [{1 2 3} {}]})

(assert-equal "list's join with value pattern"
  (match {1 2 3} (list integer)
    {[<join ,{1} $ns> ns]})
  {2 3})

(assert-equal "list's nioj"
  (match-all {1 2 3} (list integer)
    [<nioj $xs $ys> [xs ys]])
  {[{} {1 2 3}]
   [{3} {1 2}]
   [{2 3} {1}]
   [{1 2 3} {}]})

(assert-equal "list's nioj with value pattern"
  (match {1 2 3} (list integer)
    {[<nioj ,{3} $ns> ns]})
  {1 2})

;;;
;;; Multiset Pattern-Matching
;;;
(assert "multiset's nil - case 1"
  (match {} (multiset integer)
    {[<nil> #t]
     [_ #f]}))

(assert "multiset's nil - case 2"
  (match {1} (multiset integer)
    {[<nil> #f]
     [_ #t]}))

(assert "multiset's value pattern"
  (match {1 1 1 2 3} (multiset integer)
    {[,{@{@{1}} @{2 @{1 3}} 1} #t]
     [_ #f]}))

(assert-equal "multiset's cons"
  (match-all {1 2 3} (multiset integer)
    [<cons $n $ns> [n ns]])
  {[1 {2 3}] [2 {1 3}] [3 {1 2}]})

(assert-equal "multiset's cons with value pattern"
  (match {1 2 3} (multiset integer)
    {[<cons ,2 $ns> ns]})
  {1 3})

(assert-equal "multiset's join"
  (match-all {1 2 3} (multiset integer)
    [<join $xs $ys> [xs ys]])
  {[{} {1 2 3}] [{1} {2 3}] [{2} {1 3}] [{3} {1 2}] [{1 2} {3}] [{1 3} {2}] [{2 3} {1}] [{1 2 3} {}]})

(assert-equal "multiset's join with value pattern - case 1"
  (match {1 2 3} (multiset integer)
    {[<join ,{1} $ns> ns]})
  {2 3})

(assert-equal "multiset's join with value pattern - case 2"
  (match-all {1 2 3} (multiset integer)
    [<join ,{1 3} $ys> ys])
  {{2}})

(assert-equal "multiset's join with value pattern - case 3"
  (match-all {1 2 3} (multiset integer)
    [<join ,{1 5 3} $ys> ys])
  {})

;;;
;;; Set Pattern-Matching
;;;;
(assert "set's nil - case 1"
  (match {} (set integer)
    {[<nil> #t]
     [_ #f]}))

(assert "set's nil - case 2"
  (match {1} (set integer)
    {[<nil> #f]
     [_ #t]}))

(assert-equal "set's cons"
  (match-all {1 2 3} (set integer)
    [<cons $n $ns> [n ns]])
  {[1 {1 2 3}] [2 {1 2 3}] [3 {1 2 3}]})

(assert-equal "set's cons with value pattern"
  (match {1 2 3} (set integer)
    {[<cons ,2 $ns> ns]})
  {1 2 3})

(assert-equal "set's join"
  (match-all {1 2 3} (set integer)
    [<join $xs $ys> [xs ys]])
  {[{} {1 2 3}] [{1} {1 2 3}] [{2} {1 2 3}] [{3} {1 2 3}] [{1 2} {1 2 3}] [{1 3} {1 2 3}] [{2 3} {1 2 3}] [{1 2 3} {1 2 3}]})

(assert-equal "set's join with value pattern 1"
  (match-all {1 2 3} (set integer)
    [<join ,{1 3} $ys> ys])
  {{1 2 3}})

(assert-equal "set's join with value pattern 2"
  (match-all {1 2 3} (set integer)
    [<join ,{1 5 3} $ys> ys])
  {})

;;
;; Simple accessors
;;
(assert-equal "nth"
  (nth 1 {1 2 3})
  1)

(assert-equal "take"
  (take 2 {1 2 3})
  {1 2})

(assert-equal "drop"
  (drop 2 {1 2 3})
  {3})

(assert-equal "take-and-drop"
  (take-and-drop 2 {1 2 3})
  [{1 2} {3}])

(assert-equal "take-while"
  (take-while (lt? $ 10) primes)
  {2 3 5 7})

;;
;; cons, car, cdr
;;

(assert-equal "cons"
  (cons 1 {2 3})
  {1 2 3})

(assert-equal "car"
  (car {1 2 3})
  1)

(assert-equal "cdr"
  (cdr {1 2 3})
  {2 3})

(assert-equal "rac"
  (rac {1 2 3})
  3)

(assert-equal "rdc"
  (rdc {1 2 3})
  {1 2})

;;
;; List Functions
;;
(assert-equal "length"
  (length {1 2 3})
  3)

(assert-equal "map"
  (map (* $ 2) {1 2 3})
  {2 4 6})

(assert-equal "map2"
  (map2 (* $ $) {1 2 3} {10 20 30})
  {10 40 90}
  )

(assert-equal "filter"
  (let {[$odd? (lambda [$n] (eq? (modulo n 2) 1))]}
    (filter odd? {1 2 3}))
  {1 3})

(assert-equal "zip"
  (zip {1 2 3} {10 20 30})
  {[1 10] [2 20] [3 30]})

(assert-equal "lookup"
  (lookup 2 {[1 10] [2 20] [3 30]})
  20)

(assert-equal "foldr"
  (foldr (lambda [$n $ns] {n @ns}) {} {1 2 3})
  {1 2 3})

(assert-equal "foldl"
  (foldl (lambda [$ns $n] {n @ns}) {} {1 2 3})
  {3 2 1})

(assert-equal "scanl"
  (scanl (lambda [$r $n] (* r n)) 2 {2 2 2})
  {2 4 8 16})

(assert-equal "append"
  (append {1 2} {3 4 5})
  {1 2 3 4 5})

(assert-equal "concat"
  (concat {{1 2} {3 4 5}})
  {1 2 3 4 5})

(assert-equal "reverse"
  (reverse {1 2 3})
  {3 2 1})

(assert-equal "intersperse"
  (intersperse {0} {{1 2} {3 3} {4} {}})
  {{1 2} {0} {3 3} {0} {4} {0} {}})

(assert-equal "intercalate"
  (intercalate {0} {{1 2} {3 3} {4} {}})
  {1 2 0 3 3 0 4 0})

(assert-equal "split"
  (split {0} {1 2 0 3 3 0 4 0})
  {{1 2} {3 3} {4} {}})

(assert-equal "split/m"
  (split/m integer {0} {1 2 0 3 3 0 4 0})
  {{1 2} {3 3} {4} {}})

(assert-equal "find-cycle"
  (find-cycle {1 3 4 5 2 7 5 2 7 5 2 7})
  [{1 3 4} {5 2 7}])

(assert-equal "repeat"
  (take 5 (repeat {1 2 3}))
  {1 2 3 1 2})

(assert-equal "repeat1"
  (take 5 (repeat1 2))
  {2 2 2 2 2})

;;
;; Others
;;
(assert-equal "all - case 1"
  (all (eq? $ 1) {1 1 1})
  #t)

(assert-equal "all - case 2"
  (all (eq? $ 1) {1 1 2})
  #f)

(assert-equal "any - case 1"
  (any (eq? $ 1) {0 1 0})
  #t)

(assert-equal "any - case 2"
  (any (eq? $ 1) {0 0 0})
  #f)

(assert-equal "from"
  (take 3 (from 2))
  {2 3 4})

(assert-equal "between"
  (between 2 5)
  {2 3 4 5})

;;
;; Multiset Functions
;;
(assert-equal "add - case 1"
  (add 1 {2 3})
  {2 3 1})

(assert-equal "add - case 2"
  (add 1 {1 2 3})
  {1 2 3})

(assert-equal "add/m - case 1"
  (add/m integer 1 {2 3})
  {2 3 1})

(assert-equal "add/m - case 2"
  (add/m integer 1 {1 2 3})
  {1 2 3})

(assert-equal "delete-first"
  (delete-first 2 {1 2 3 2})
  {1 3 2})

(assert-equal "delete-first/m"
  (delete-first/m integer 2 {1 2 3 2})
  {1 3 2})

(assert-equal "delete"
  (delete 2 {1 2 3 1 2 3})
  {1 3 1 3})

(assert-equal "delete/m"
  (delete/m integer 2 {1 2 3 1 2 3})
  {1 3 1 3})

(assert-equal "difference"
  (difference {1 2 3} {1 3})
  {2})

(assert-equal "difference/m"
  (difference/m integer {1 2 3} {1 3})
  {2})

(assert-equal "union"
  (union {1 2 3} {1 3 4})
  {1 2 3 4})

(assert-equal "union/m"
  (union/m integer {1 2 3} {1 3 4})
  {1 2 3 4})

(assert-equal "intersect"
  (intersect {1 2 3} {1 3 4})
  {1 3})

(assert-equal "intersect/m"
  (intersect/m integer {1 2 3} {1 3 4})
  {1 3})

;;
;; Simple predicate
;;

(assert-equal "member? - case 1"
  (member? 1 {1 3 1 4})
  #t)

(assert-equal "member? - case 2"
  (member? 2 {1 3 1 4})
  #f)

(assert-equal "member?/m - case 1"
  (member?/m integer 1 {1 3 1 4})
  #t)

(assert-equal "member?/m - case 2"
  (member?/m integer 2 {1 3 1 4})
  #f)

;;
;; Counting
;;
(assert-equal "count"
  (count 1 {1 3 1 4})
  2)

(assert-equal "count/m"
  (count/m integer 1 {1 3 1 4})
  2)

(assert-equal "frequency"
  (frequency {1 3 1 4})
  {[1 2] [3 1] [4 1]})

(assert-equal "frequency/m"
  (frequency/m integer {1 3 1 4})
  {[1 2] [3 1] [4 1]})

;;
;; Set Functions
;;
(assert-equal "unique"
  (unique {1 2 3 2 1 4})
  {1 2 3 4})

(assert-equal "unique/m"
  (unique/m integer {1 2 3 2 1 4})
  {1 2 3 4})