added more tests

day01-hard/main.scm

@@ -23,8 +23,13 @@
 (define (is-not value) (lambda (x) (not (equal? x value))))
 (define (is-not-empty value) (not (null? value)))
 
+;=============== prepend ======================
 (define (prepend first-value) (lambda (rest) (cons first-value rest)))
 
+(assert-eq "prepend test failed"
+  '(1 2 3 4)
+  ((prepend 1) '(2 3 4)))
+
 ;=============== combinators ======================
 (define (Y f) (f (lambda (x) ((Y f) x))))
 (define (Y2 f) (f (lambda (x y) ((Y2 f) x y))))
@@ -39,17 +44,35 @@
     (if (= a 0) 1 (if (= b 0) 1 (+ (f (- a 1) b) (f a (- b 1))))))))
     3 4))
 
+;=============== reduce-right ======================
 (define (reduce-right initial reducer) (Y
   (lambda (f) (lambda (values)
     (if (null? values) initial (reducer (car values) (f (cdr values))))))))
 
+(assert-eq "reduce-right test 1 failed"
+  '(4 101 3 102 2 103 1 104 0)
+  ((reduce-right '(0)
+    (lambda (current accumulator) (cons (+ 1 (car accumulator)) (cons current accumulator))))
+    '(101 102 103 104)))
+
+;=============== map ======================
 (define (map mapper) (reduce-right '()
   (lambda (current accumulator) (cons (mapper current) accumulator))))
 
+(assert-eq "map test 1 failed"
+  '(1 4 9 16)
+  ((map (lambda (x) (* x x)))
+    '(1 2 3 4)))
+
+;=============== map ======================
 (define (concat left right)
   ((reduce-right right (lambda (current accumulator) (cons current accumulator)))
     left))
 
+(assert-eq "concat test 1 failed"
+  '(1 2 3 4 5)
+  (concat '(1 2) '(3 4 5)))
+
 ;=============== flat ======================
 (define flat (reduce-right '() concat))
 
@@ -57,10 +80,16 @@
   '(1 2 3 4 5 (6 7) 8)
   (flat '((1 2) () (3 4) (5 (6 7) 8))))
 
+;=============== filter ======================
 (define (filter predicate) (reduce-right '()
   (lambda (current accumulator)
     (if (predicate current) (cons current accumulator) accumulator))))
 
+(assert-eq "filter test 1 failed"
+  '(2 4 4 2)
+  ((filter (lambda (x) (= (modulo x 2) 0)))
+    '(1 2 3 4 4 3 2 1)))
+
 ;=============== first ======================
 (define (first predicate) (reduce-right '()
   (lambda (current accumulator)
@@ -70,23 +99,98 @@
   '(1 2 3)
   ((first is-not-empty) '(() (1 2 3))))
 
+;=============== coalesce ======================
 (define (coalesce-not-empty default-lazy) (lambda (value) (if (null? value) (default-lazy) value)))
 
+(assert-eq "coalesce-not-empty test 1 failed"
+  '(1)
+  ((coalesce-not-empty (lambda () '(1))) '()))
+
+(assert-eq "coalesce-not-empty test 2 failed"
+  '(2)
+  ((coalesce-not-empty (lambda () '(1))) '(2)))
+
+(assert-eq "coalesce-not-empty test 3 failed (wrong result)"
+  '(2)
+  ((coalesce-not-empty (lambda () (display-ln "coalesce-not-empty test 3 failed (called default-lazy)")))
+    '(2)))
+
+;=============== truthy-chaining ======================
 (define (truthy-chaining f) (lambda (value) (if value (f value) #f)))
 
+(assert-eq "coalesce-not-empty test 1 failed"
+  2
+  ((truthy-chaining (lambda (x) (+ x 1))) 1))
+
+(assert-eq "coalesce-not-empty test 2 failed"
+  #f
+  ((truthy-chaining (lambda (x) (+ x 1))) #f))
+
+;=============== compose-two ======================
 (define (compose-two f g) (lambda (x) (f (g x))))
 
+(assert-eq "compose-two test 1 failed"
+  6
+  ((compose-two
+    (lambda (x) (* x 2))
+    (lambda (x) (+ x 2)))
+    1))
+
+;=============== compose ======================
 (define compose (reduce-right id compose-two))
 
+(assert-eq "compose test 1 failed"
+  '(1 2 3 4)
+  ((compose (list
+    (prepend 1)
+    (prepend 2)
+    (prepend 3)))
+    '(4)))
+
+;=============== compose ======================
 (define (combine combiner)
   (lambda (a b) (if (null? a) b (if (null? b) a (combiner a b)))))
 
+(assert-eq "combine test 1 failed"
+  '(1 3)
+  ((combine (lambda (a b) (list (car a) (car b))))
+    '(1 2)
+    '(3 4)))
+
+(assert-eq "combine test 1 failed"
+  '(1 2)
+  ((combine (lambda (a b) (list (car a) (car b))))
+    '(1 2)
+    '()))
+
+(assert-eq "combine test 1 failed"
+  '(3 4)
+  ((combine (lambda (a b) (list (car a) (car b))))
+    '()
+    '(3 4)))
+
+(assert-eq "combine test 1 failed"
+  '()
+  ((combine (lambda (a b) (list (car a) (car b))))
+    '()
+    '()))
+
+;=============== sum ======================
 (define sum (reduce-right 0 +))
 
+(assert-eq "sum test 1 failed"
+  6
+  (sum '(1 2 3)))
+
+;=============== repeat ======================
 (define (repeat value) (Y
   (lambda (f) (lambda (n)
     (if (= n 0) '() (cons value (f (- n 1))))))))
 
+(assert-eq "repeat test 1 failed"
+  '(1 1 1)
+  ((repeat 1) 3))
+
 ;=============== starts-with ======================
 (define starts-with (Y2
   (lambda (f) (lambda (prefix values)