added more tests

main
Inga 🏳‍🌈 11 months ago
parent 6fcf46ec3f
commit 5b260d8dec
  1. 104
      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)

Loading…
Cancel
Save