From 5b260d8decf83ed1f66da4a157e40e858eb6244f Mon Sep 17 00:00:00 2001 From: Inga Date: Wed, 6 Dec 2023 23:10:11 +0000 Subject: [PATCH] added more tests --- day01-hard/main.scm | 104 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) diff --git a/day01-hard/main.scm b/day01-hard/main.scm index 8948cb0..1f085b1 100755 --- a/day01-hard/main.scm +++ b/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)