add scott-list reference implementation and testing

Author: Johan Wiltink

tests/run-tests.js

@@ -10,6 +10,7 @@ const examples = [ "basics-binary-scott"
                  , "is-prime"
                  , "is-prime-scott"
                  , "prime-sieve"
+                 , "scott-lists"
                  , "multiply"
                  ];
 

tests/scott-lists/solution.txt

@@ -0,0 +1,237 @@
+# scott-lists.lc
+
+#import combinators.lc
+B = \ f g x . f (g x)
+BB = \ f g x y . f (g x y)
+CB = \ f g x . g (f x)
+C = \ f x y . f y x
+I = \ x . x
+K = \ x _ . x
+KI = \ _ x . x
+KK = \ x _ _ . x
+M = \ x . x x
+S = \ f g x . f x (g x)
+T = \ x fn . fn x
+V = \ x y fn . fn x y
+W = \ f x . f x x
+#import scott-booleans.ls
+False = K
+True  = KI
+not = \ p . p True False
+and = M
+or  = W C
+#import scott-ordering.lc
+LT = KK
+EQ = K K
+GT = K KI
+#import scott-numbers.lc
+zero = K
+succ = \ n . \ _zero succ . succ n
+pred = \ n . n zero I
+add = \ m n . m n (B succ (add n))
+sub = \ m n . m m (B (n m) sub)
+mul = \ m n . m m (B (add n) (mul n))
+is-zero = \ n . n True (K False)
+one = succ zero
+#import scott-pair.lc
+Pair = V
+fst = T K
+snd = T KI
+first  = \ fn xy  . xy \ x   . Pair (fn x)
+second = \ fn xy  . xy \ x y . Pair x (fn y)
+both   = \ fn xy  . xy \ x y . Pair (fn x) (fn y)
+bimap  = \ f g xy . xy \ x y . Pair (f x) (g y)
+curry fn x y = fn (Pair x y)
+uncurry = T
+#import scott-option.lc
+None = K                           # = zero
+Some = \ x . \ _none some . some x # = succ
+option = V
+is-none = \ x . x True (K False)   # = is-zero
+is-some = \ x . x False (K True)
+from-option = \ z x . x z I
+from-some = \ x . x () I
+list-to-option = \ xs . xs None \ x _xs . Some x
+option-to-list = \ x . x nil singleton
+map-option = \ fn xs . xs nil \ x xs . fn x (map-options fn xs) (C cons (map-options fn xs))
+cat-options = map-options I
+
+# data List a = Nil | Cons a (List a)
+
+# nil :: List a
+nil = K
+
+# cons :: a -> List a -> List a
+cons = \ x xs . \ _nil cons . cons x xs
+
+# singleton :: a -> List a
+singleton = \ x . cons x nil
+
+# foldr :: (a -> z -> z) -> z -> List a -> z
+foldr = \ fn z xs . xs z ( \ x xs . fn x (foldr fn z xs) )
+
+# null :: List a -> Boolean
+null = \ xs . xs True (KK False)
+
+# take :: Number -> List a -> List a
+take = \ n xs . is-zero n (xs nil \ x xs . cons x (take (pred n) xs)) nil
+
+# append :: List a -> List a -> List a
+append = C (foldr cons)
+
+# concat :: List (List a) -> List a
+concat = \ xss . foldr xss append nil
+
+# sum,product :: List Number -> Number
+sum = foldr add zero
+product = foldr mul one
+
+# iterate :: (a -> a) -> a -> List a
+iterate = \ fn x . cons x (iterate fn (fn x))
+
+# repeat :: a -> List a
+repeat = \ x . cons x (repeat x) # repeat = Y (S cons)
+
+# cycle :: List a -> List a
+cycle = \ xs . null xs (concat (repeat xs)) ()
+
+# replicate :: Number -> a -> List a
+replicate = \ n . B (take n) repeat
+
+# head :: List a -> a
+head = \ xs . xs () K
+
+# tail :: List a -> List a
+tail = \ xs . xs () KI
+
+# length :: List a -> Number
+length = foldr (K succ) zero
+
+# snoc :: List a -> a -> List a
+snoc = C (B (foldr cons) singleton)
+
+# map :: (a -> b) -> List a -> List b
+map = \ fn . foldr (B cons fn) nil
+
+# concat-map :: (a -> List b) -> List a -> List b
+concat-map = BB concat map
+
+# filter :: () -> List a -> List a
+filter = \ p . foldr ( \ x z . p x z (cons x z) ) nil
+filter = \ p . foldr ( \ x . S (p x) (cons x) ) nil
+filter = \ p . foldr (S (B S p) cons) nil
+
+# drop :: Number -> List a -> List a
+drop = \ n xs . is-zero n ( \ _x xs . drop (pred n) xs ) xs
+drop = \ n . is-zero n (K (drop (pred n)))
+
+# split-at :: Number -> List a -> Pair (List a) (List a)
+split-at = \ i xs . is-zero i (xs (Pair nil nil) \ x xs . first (cons x) (split-at (pred i) xs)) (Pair nil xs)
+
+# get :: Number -> List a -> a
+get = \ i xs . is-zero i ( \ x xs . xs () (get (pred i) xs) ) (head xs)
+
+# set :: Number -> a -> List a -> List a
+set = \ i x xs . uncurry append (second (B (cons x) tail) (split-at i xs))
+set = \ i x xs . is-zero i (xs nil \ y ys . cons y (set (pred i) x ys)) (xs nil (K (cons x)))
+
+# any :: (a -> Boolean) -> List a -> Boolean
+any = \ p . foldr (B or p) False
+
+# all :: (a -> Boolean) -> List a -> Boolean
+all = \ p . foldr (B and p) True
+
+# find :: (a -> Boolean) -> List a -> Option a
+find = \ p . foldr ( \ x z . p x z (Some x) ) None
+
+# find-index :: (a -> Boolean) -> List a -> Option Number
+find-index p = B list-to-option (find-indices p)
+
+# find-indices :: (a -> Boolean) -> List a -> List Number
+find-indices p = foldr ( \ x k i . p x I (cons i) (k (succ i)) ) (K nil) zero
+
+# partition :: (a -> Boolean) -> List a -> Pair (List a) (List a)
+partition = \ p . foldr ( \ x . p x second first (cons x) ) (Pair nil nil)
+
+# span :: (a -> Boolean) -> List a -> Pair (List a) (List a)
+span = \ p xs . xs (Pair nil nil) \ y ys . p y (Pair nil xs) (first (cons y) (span p ys))
+
+# minimum-by :: (a -> a -> Boolean) -> List a -> a # cmp ~ le
+minimum-by = \ cmp xs . xs () (foldr \ x z . cmp x z z x)
+
+# maximum-by :: (a -> a -> Boolean) -> List a -> a # cmp ~ le
+maximum-by = \ cmp xs . xs () (foldr \ x z . cmp x z x z)
+
+# insert-by :: (a-> a -> Boolean) -> a -> List a -> List a # cmp ~ le
+insert-by = \ cmp x xs . uncurry append (second (cons x) (span (C cmp x) xs))
+
+# sort-by :: (a -> a -> Boolean) -> List a -> List a # cmp ~ le
+sort-by = \ cmp . foldr (insert-by cmp) nil
+
+# foldl :: (z -> a -> z) -> z -> List a -> z
+foldl = \ fn z xs . xs z (B (foldl fn) (fn z))
+
+# scanl :: (z -> a -> z) -> z -> List a -> List z
+scanl = \ fn z xs . cons z (xs nil (B (scanl fn) (fn z)))
+
+# scanr :: (a -> z -> z) -> z -> List a -> List z
+scanr = \ fn z xs . xs (singleton z) \ x xs . ( \ zs . zs \ z _zs . cons (fn x z) zs ) (scanr fn z xs)
+
+# reverse :: List a -> List a
+reverse = foldl (C cons) nil
+
+# init :: List a -> List a
+init = \ xs . xs () (S (zip-with K) tail xs)
+
+# last :: List a -> a
+last = foldl KI ()
+
+# unzip :: List (Pair a b) -> Pair (List a) (List b)
+unzip = foldr ( \ xy xys . xy \ x y . bimap (cons x) (cons y) xys ) (Pair nil nil)
+unzip = foldr (CB \ x y . bimap (cons x) (cons y)) (Pair nil nil)
+
+# zip-with :: (a -> b -> z) -> List a -> List b -> List z
+zip-with = \ fn xs ys . xs nil \ x xs . ys nil \ y ys . cons (fn x y) (zip-with fn xs ys)
+
+# zip :: List a -> List b -> List (Pair a b)
+zip = zip-with Pair
+
+# slice :: Number -> Number -> List a -> List a
+slice = \ i j xs . gt j i nil (take (sub j i) (drop i xs))
+
+# uncons :: List a -> Option (Pair (a) (List a))
+uncons = \ xs . xs None (B Some Pair)
+
+# transpose :: List (List a) -> List (List a)
+transpose = \ xss . xss nil
+                        \ ys yss . ys (transpose yss)
+                                      (unzip (map-option uncons xss) \ xs xxs . cons xs (transpose xss))
+
+# unfold :: (a -> Option (Pair z a)) -> a -> List z
+unfold = \ fn x . fn x nil (T \ z x . cons z (unfold fn x))
+
+# take-while :: (a -> Boolean) -> List a -> List a
+take-while = \ p xs . xs nil \ x xs . p x nil (cons x (take-while p xs))
+
+# drop-while :: (a -> Boolean) -> List a -> List a
+drop-while = \ p xs . xs nil \ x xs . p x xs (drop-while p xs)
+
+# drop-while-end :: (a -> Boolean) -> List a -> List a
+drop-while-end = \ p . foldr ( \ x z . and (null z) (p x) (cons x z) nil ) nil
+
+# group-by :: (a -> a -> Bool) -> List a -> List (List a)
+group-by = \ eq xs . xs nil \ x xs . span (eq x) xs \ left right . cons (cons x left) (group-by eq right)
+group-by = \ eq xs . xs nil \ x xs . uncurry cons (bimap (cons x) (group-by eq) (span (eq x) xs))
+
+# inits
+
+# tails :: List a -> List (List a)
+tails = \ xs . cons xs (xs nil (K tails))
+
+# lookup-by :: (a -> Boolean) -> List (Pair a b) -> Option b
+lookup-by = \ eq xys . xys None \ xy xys . xy \ x y . eq x (lookup-by eq xys) (Some y)
+
+# nub-by
+# delete-by
+# delete-firsts-by
+# sort-on

tests/scott-lists/test.js

@@ -0,0 +1,35 @@
+const {assert} = require("chai");
+
+const LC = require("../../src/lambda-calculus.js");
+LC.config.purity = "LetRec";
+LC.config.numEncoding = "Scott";
+LC.config.verbosity = "Concise";
+
+const solution = LC.compile();
+const fromInt = LC.fromIntWith(LC.config);
+const toInt = LC.toIntWith(LC.config);
+
+const {nil,cons,singleton} = solution;
+const {foldr,head,tail,take} = solution;
+const {iterate,repeat,cycle,replicate} = solution;
+const {foldl,reverse} = solution;
+
+const fromList = foldl ( z => x => [...z,x] ) ([]) ;
+
+describe("Scott Lists",function(){
+  it("example tests",()=>{
+    assert.deepEqual( fromList( nil ), [] );
+    assert.deepEqual( fromList( singleton ("0") ), ["0"] );
+    assert.deepEqual( fromList( cons ("0") (singleton ("1")) ), ["0","1"] );
+    assert.deepEqual( fromList( replicate (fromInt(0)) ("0") ), [] );
+    assert.deepEqual( fromList( replicate (fromInt(1)) ("0") ), ["0"] );
+    assert.deepEqual( fromList( replicate (fromInt(2)) ("0") ), ["0","0"] );
+  });
+  it("random tests",()=>{
+    const rnd = (m,n=0) => Math.random() * (n-m) + m | 0 ;
+    for ( let i=1; i<=100; i++ ) {
+      const m = rnd(i), n = rnd(i);
+      assert.deepEqual( fromList( replicate (fromInt(m)) (String(n)) ), [], `after ${ i } tests` );
+    }
+  });
+});