egison-2.4.1: sample/collection-test.egi

(load "lib/poker-hands.egi")

;; match List
(test (match-all {1 2 3 4 5} (List Integer) [<snoc $x $xs> [x xs]]))
(test {[5 {1 2 3 4}]})

(test (match-all {1 2 3 4 5} (List Integer) [<join ,{1 2} $xs> xs]))
(test {{3 4 5}})

(test (match-all {1 2 3 4 5} (List Integer) [<join _ <join $xs _>> xs]))
(test {{} {1} {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {} {2} {2 3} {2 3 4} {2 3 4 5} {} {3} {3 4} {3 4 5} {} {4} {4 5} {} {5} {}})

(test (match-all {[1 2] [1 2]} (List [Integer Integer])
        [<cons [$a $b] _> [a b]]))
(test {[1 2]})

;; match Multiset
(test (match-all {1 2 3 4 5} (Multiset Integer)
        [<cons $m <cons $n _>> [m n]]))
(test {[1 2] [1 3] [1 4] [1 5] [2 1] [2 3] [2 4] [2 5] [3 1] [3 2] [3 4] [3 5] [4 1] [4 2] [4 3] [4 5] [5 1] [5 2] [5 3] [5 4]})

;; match a collection of collections
(test (match-all {{1 2 3} {11} {21 22}} (List (Multiset Integer))
        [<cons <cons $x _>
          <cons <cons $y _>
           <cons <cons $z _>
            <nil>>>>
         [x y z]]))
(test {[1 11 21] [1 11 22] [2 11 21] [2 11 22] [3 11 21] [3 11 22]})

;; match a collection of collections with value patterns
(test (match-all {{1 2 3 4 5} {4 5 1} {6 1 7 4}} (List (Multiset Integer))
        [<cons <cons $n _>
          <cons <cons ,n _>
           <cons <cons ,n _>
            <nil>>>>
         n]))
(test {1 4})

;; pattern as first class object
(test (let {[$pat <cons ,1 <nil>>]}
        (match {1} (Multiset Integer)
          {[pat <ok>]
           [_ <not-ok>]})))
(test <ok>)
      
;; Or-pattern test1
(test (match {} (Multiset Integer)
        {[(| <nil> <cons ,1 <nil>>) <ok>]
         [_ <not-ok>]}))
(test <ok>)

;; Or-pattern test2
(test (match {1} (Multiset Integer)
        {[(| <nil> <cons ,1 <nil>>) <ok>]
         [_ <not-ok>]}))
(test <ok>)

(test (match-all {1 2 3 4 5 6 7 1 3 5 7} (Multiset Integer)
        [<cons $x ^<cons ,x _>> x]))
(test {2 4 6})

(test (match-all {{1 2 3} {2 3 4} {1}} (Multiset (Multiset Integer))
        [<cons <cons $x ^<cons ,x _>>
          <cons ^<cons ,x _>
           <cons ^<cons ,x _>
            <nil>>>>
         x]))
(test {4 4}) ; is really ok?

(test (match-all {{1 2 3} {2 3 4}} (Multiset (Multiset Integer))
        [<cons <cons $x ^<cons ,x _>>
           <cons ^<cons ,x _>
            <nil>>>
         x]))
(test {1 4})

(test (match-all {1 2 3} (List Integer)
        [<join $hs $ts> [hs ts]]))
(test "here")
(test {[{} {1 2 3}] [{1} {2 3}] [{1 2} {3}] [{1 2 3} {}]})

(test (match-all {1 2 3} (List Integer)
        [<nioj $hs $ts> [hs ts]]))
(test {[{1 2 3} {}] [{2 3} {1}] [{3} {1 2}] [{} {1 2 3}]})

(test (match-all {1 2 3} (Multiset Integer)
        [<join $hs $ts> [hs ts]]))
(test {[{} {3 2 1}] [{1} {3 2}] [{2} {3 1}] [{1 2} {3}] [{3} {2 1}] [{1 3} {2}] [{2 3} {1}] [{1 2 3} {}]})

(test (match-all {1 2 3} (Set Integer)
        [<join $hs $ts> [hs ts]]))
(test {[{} {3 2 1}] [{1} {3 2}] [{1} {3 2 1}] [{2} {3 1}] [{2} {3 1 2}] [{1 2} {3}] [{1 2} {3 1}] [{1 2} {3 2}] [{1 2} {3 1 2}] [{3} {2 1}] [{3} {2 1 3}] [{1 3} {2}] [{1 3} {2 1}] [{1 3} {2 3}] [{1 3} {2 1 3}] [{2 3} {1}] [{2 3} {1 2}] [{2 3} {1 3}] [{2 3} {1 2 3}] [{1 2 3} {}] [{1 2 3} {1}] [{1 2 3} {2}] [{1 2 3} {1 2}] [{1 2 3} {3}] [{1 2 3} {1 3}] [{1 2 3} {2 3}] [{1 2 3} {1 2 3}]})

(test (match-all {1 2 3} (List Integer)
        [<join $hs <cons $x $ts>> [hs x ts]]))
(test {[{} 1 {2 3}] [{1} 2 {3}] [{1 2} 3 {}]})

;; noij
(test (match-all {<x> <y> <z>} (List Something) [<nioj $xs $ys> [xs ys]]))

(test ((remove-collection Suit) {<club> <heart> <diamond>} {<club> <diamond>}))

(test (subcollections {<x> <y> <z>}))

;; Cut-pattern
(test (match {2 7 7 2 7} (Multiset Integer)
        {[<cons $m
           <cons ,m
            <cons ,m
             <cons $n
              !<cons ,n
                !<nil>>>>>>
          <ok>]
         [_ <ko>]}))

;; Value-pattern
(test (match {5 2 1 3 4} (Multiset Integer)
        {[<cons $n
           <cons ,(- n 1)
            <cons ,(- n 2)
             <cons ,(- n 3)
              <cons ,(- n 4)
               <nil>>>>>>
          <ok>]
         [_ <ko>]}))

(test (match-all {1 2 3 4} (List Integer)
        [<join _ <join $ns _>> ns]))

;; pattern macro
(define $single
  (macro [$s $pat]
    <cons $`s pat>))

(test (match-all {1 2 3 1 2} (Multiset Integer)
        [(single %k _) k]))
(test {1 2 3})

(define $pair
  (macro [$s $pat]
    <cons $`s <cons ,`s pat>>))

(test (match-all {1 2 3 1 2} (Multiset Integer)
        [(pair %k _) k]))
(test {1 2})

(define $loop-pat
  (lambda [$k $i]
    (match i Integer
      {[,k <join _ <cons $n_k _>>]
       [_ <join _ <cons $n_i (loop-pat k (+ i 1))>>]})))

(define $loop-pat
  (lambda [$k]
    (| <nil> <cons ,k (loop-pat (- k 1))>)))

(define $isStraight?
  (lambda [$Ns]
    (match Ns (Multiset Integer)
      {[<cons $n
         (loop-pat (- n 1))>
        <ok>]
       [_ <ko>]})))

(define $isStraight?
  (lambda [$Ns]
    (match Ns (Multiset Integer)
      {[<cons (& ,(max Ns) $n)
         (loop-pat (- n 1))>
        <ok>]
       [_ <ko>]})))

(test (isStraight? {1 2}))

;; comparison of large list
(test (match (between 1 10000) (List Integer) {[,(between 1 10000) <ok>] [_ <ko>]}))