;;;;; ;;;;; Collection.egi ;;;;; ;;; ;;; List ;;; (define $list (lambda [$a] (matcher-bfs {[,$val [] {[$tgt (match [val tgt] [(list a) (list a)] {[[ ] {[]}] [[ ] {[]}] [[_ _] {}]})]}] [ [] {[{} {[]}] [_ {}]}] [ [a (list a)] {[{$x @$xs} {[x xs]}] [_ {}]}] [ [a (list a)] {[{@$xs $x} {[x xs]}] [_ {}]}] [ [(list a)] {[$tgt (match-all [pxs tgt] [(list a) (list a)] [[(loop $i [1 $n] ) (loop $i [1 n] $rs)] rs])]}] [ [(list a) (list a)] {[$tgt (match-all tgt (list a) [(loop $i [1 $n] $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}] [ [(list a)] {[$tgt (match-all [pxs tgt] [(list a) (list a)] [[(loop $i [1 $n] ) (loop $i [1 n] $rs)] rs])]}] [ [(list a) (list a)] {[$tgt (match-all tgt (list a) [(loop $i [1 $n] $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}] [$ [something] {[$tgt {tgt}]}] }))) (define $string (list char)) ;; ;; Helper function for List matcher, be careful for recursive calls ;; (define $map (lambda [$fn $xs] (match xs (list something) {[ {}] [ {(fn x) @(map fn rs)}]}))) (define $between (lambda [$s $e] (if (gt? (+ s 10) e) (if (gt? s e) {} {s @(between (+ s 1) e)}) {s (+ s 1) (+ s 2) (+ s 3) (+ s 4) (+ s 5) (+ s 6) (+ s 7) (+ s 8) (+ s 9) (+ s 10) @(between (+ s 11) e)}) )) (define $from (lambda [$s] {s (+ s 1) (+ s 2) (+ s 3) (+ s 4) (+ s 5) (+ s 6) (+ s 7) (+ s 8) (+ s 9) (+ s 10) @(from (+ s 11))})) ;; ;; list functions ;; (define $repeat1 (lambda [$x] {x @(repeat1 x)})) (define $repeat (lambda [$xs] {@xs @(repeat xs)})) (define $filter (lambda [$pred $xs] (match xs (list something) {[ {}] [ (if (pred x) {x @(filter pred rs)} (filter pred rs))]}))) (define $separate (lambda [$pred $ls] (letrec {[$helper (lambda [$ls $xs $ys] (match ls (list something) {[ [xs ys]] [ (helper rs {l @xs} ys)] [ (helper rs xs {l @ys})]}))]} (helper ls {} {})))) (define $concat (lambda [$xss] (match xss (list something) {[ {}] [ {@xs @(concat rss)}]}))) (define $foldr (lambda [$fn $init $ls] (match ls (list something) {[ init] [ (fn x (foldr fn init xs))]}))) (define $foldl (lambda [$fn $init $ls] (match ls (list something) {[ init] [ (foldl fn (fn init x) xs)]}))) (define $foldl' (lambda [$fn $init $ls] (match ls (list something) {[ init] [ (let {[$z (fn init x)]} (seq z (foldl' fn z xs)))]}))) (define $scanl (lambda [$fn $init $ls] {init @(match ls (list something) {[ {}] [ (scanl fn (fn init x) xs)]})})) (define $map2 (lambda [$fn $xs $ys] (match [xs ys] [(list something) (list something)] {[[ ] {}] [[ ] {(fn x y) @(map2 fn xs2 ys2)}]}))) (define $zip (lambda [$xs $ys] (map2 (lambda [$x $y] [x y]) xs ys))) (define $find-cycle (lambda [$fn $init] (letrec {[$looper (lambda [$xs $x] (let {[$y (fn x)]} (if (eq? y init) xs (looper {@xs y} y))))]} (looper {init} init)))) ;; ;; Simple predicate ;; (define $member? (lambda [$x $ys] (match ys (list something) {[> #t] [_ #f]}))) (define $member?/m (lambda [$a $x $ys] (match ys (list a) {[> #t] [_ #f]}))) (define $include? (lambda [$a $xs $ys] (match xs (list something) {[ #t] [ (if (member? x ys) (include? rest ys) #f)]}))) (define $include?/m (lambda [$a $xs $ys] (match xs (list something) {[ #t] [ (if (member?/m a x ys) (include?/m a rest ys) #f)]}))) (define $any (lambda [$pred $xs] (match xs (list something) {[ #f] [ (if (pred x) #t (any pred rs))]}))) (define $all (lambda [$pred $xs] (match xs (list something) {[ #t] [ (if (pred x) (all pred rs) #f)]}))) ;; ;; Counting ;; (define $length (lambda [$xs] (foldl' (lambda [$x $y] (+ x 1)) 0 xs))) (define $count (lambda [$x $xs] (length (match-all xs (list something) [> x])))) (define $count/m (lambda [$a $x $xs] (length (match-all xs (list a) [> x])))) (define $frequency (lambda [$xs] (let {[$us (unique xs)]} (map (lambda [$u] [u (count u xs)]) us)))) (define $frequency/m (lambda [$a $xs] (let {[$us (unique/m a xs)]} (map (lambda [$u] [u (count/m a u xs)]) us)))) ;; ;; Simple accessors ;; (define $cons (lambda [$x $xs] {x @xs})) (define $car (lambda [$xs] (match xs (list something) {[ x]}))) (define $cdr (lambda [$xs] (match xs (list something) {[ ys]}))) (define $rac (lambda [$xs] (match xs (list something) {[ x]}))) (define $rdc (lambda [$xs] (match xs (list something) {[ ys]}))) (define $nth (lambda [$n $xs] (match xs (list something) {[(loop $i [1 (- n 1)] ) x]}))) (define $take-and-drop (lambda [$n $xs] (match xs (list something) {[(loop $i [1 n] $rs) [(map (lambda [$i] a_i) (between 1 n)) rs]]}))) (define $take (lambda [$n $xs] (if (eq? n 0) {} (match xs (list something) {[ {x @(take (- n 1) xs)}] [ {}]})))) (define $drop (lambda [$n $xs] (if (eq? n 0) xs (match xs (list something) {[ (drop (- n 1) xs)] [ {}]})))) (define $while (lambda [$pred $xs] (match xs (list something) {[ {}] [ (if (pred x) {x @(while pred rs)} {})]}))) ;; ;; Others ;; (define $reverse (lambda [$xs] (match xs (list something) {[ {}] [ {x @(reverse rs)}]}))) ;;; ;;; Multiset ;;; (define $multiset (lambda [$a] (matcher {[,$val [] {[$tgt (match [val tgt] [(list a) (multiset a)] {[[ ] {[]}] [[ ] {[]}] [[_ _] {}]})]}] [ [] {[{} {[]}] [_ {}]}] [ [(multiset a)] {[$tgt (match tgt (list a) {[> {{@hs @ts}}] [_ {}]})]}] [ [a (multiset a)] {[$tgt (match-all tgt (list a) [> [x {@hs @ts}]])]}] [ [(multiset a)] {[$tgt (match [pxs tgt] [(list a) (multiset a)] {[[(loop $i [1 $n] ) (loop $i [1 n] $rs)] {rs}] [_ {}]})]}] [ [(multiset a) (multiset a)] {[$tgt (match-all tgt (list a) [(loop $i [1 $n] > $ts) [(map (lambda [$i] x_i) (between 1 n)) (concat {@(map (lambda [$i] rs_i) (between 1 n)) ts})]])]}] [$ [something] {[$tgt {tgt}]}] }))) ;; ;; multiset operation (Don't use multiset matcher) ;; (define $add (lambda [$x $xs] (if (member? x xs) xs {@xs x}))) (define $add/m (lambda [$a $x $xs] (if (member?/m a x xs) xs {@xs x}))) (define $delete-first (lambda [$x $xs] (match xs (list something) {[ {}] [ rs] [ {y @(delete-first x rs)}]}))) (define $delete-first/m (lambda [$a $x $xs] (match xs (list a) {[ {}] [ rs] [ {y @(delete-first/m a x rs)}]}))) (define $delete (lambda [$x $xs] (match xs (list something) {[ {}] [ (delete x rs)] [ {y @(delete x rs)}]}))) (define $delete/m (lambda [$a $x $xs] (match xs (list a) {[ {}] [ (delete/m a x rs)] [ {y @(delete/m a x rs)}]}))) (define $difference (lambda [$xs $ys] (match ys (list something) {[ xs] [ (difference (delete-first y xs) rs)]}))) (define $difference/m (lambda [$a $xs $ys] (match ys (list a) {[ xs] [ (difference/m a (delete-first/m a y xs) rs)]}))) (define $union (lambda [$xs $ys] {xs @(match-all [ys xs] [(multiset something) (multiset something)] [[ ^] y]) })) (define $union/m (lambda [$a $xs $ys] {xs @(match-all [ys xs] [(multiset a) (multiset a)] [[ ^] y]) })) (define $intersect (lambda [$xs $ys] (match-all [xs ys] [(multiset something) (multiset something)] [[ ] x]))) (define $intersect/m (lambda [$a $xs $ys] (match-all [xs ys] [(multiset a) (multiset a)] [[ ] x]))) ;;; ;;; Set ;;; (define $set (lambda [$a] (matcher {[ [] {[{} {[]}] [_ {}]}] [ [(set a)] {[$tgt (match tgt (list a) {[> {tgt}] [_ {}]})]}] [ [a (set a)] {[$tgt (match-all tgt (list a) [> [x tgt]])]}] [ [(set a)] {[$tgt (match [pxs tgt] [(list a) (set a)] {[[(loop $i [1 $n] ) (loop $i [1 n] _)] {tgt}] [_ {}]})]}] [ [(set a) (set a)] {[$tgt (match-all tgt (multiset a) [(loop $i [1 $n] _) [(map (lambda [$i] x_i) (between 1 n)) tgt]])]}] [$ [something] {[$tgt {tgt}]}] }))) ;; ;; set operation ;; (define $unique (lambda [$xs] (letrec {[$loop-fn (lambda [$xs $ys] (match xs (list something) {[ ys] [ (if (member? x ys) (loop-fn rs ys) (loop-fn rs {@ys x}))]}))]} (loop-fn xs {})))) (define $unique/m (lambda [$a $xs] (letrec {[$loop-fn (lambda [$xs $ys] (match xs (list something) {[ ys] [ (if (member?/m a x ys) (loop-fn rs ys) (loop-fn rs {@ys x}))]}))]} (loop-fn xs {}))))