improved reduce-right interface

main
Inga 🏳‍🌈 12 months ago
parent f86261baff
commit a96161a5ae
  1. 32
      day01-hard/main.scm

@ -28,37 +28,32 @@
(define (Y f) (f (lambda (x) ((Y f) x)))) (define (Y f) (f (lambda (x) ((Y f) x))))
(define (Y2 f) (f (lambda (x y) ((Y2 f) x y)))) (define (Y2 f) (f (lambda (x y) ((Y2 f) x y))))
(define (reduce-right reducer initial) (Y (define (reduce-right initial reducer) (Y
(lambda (f) (lambda (values) (lambda (f) (lambda (values)
(if (null? values) initial (reducer (car values) (f (cdr values)))))))) (if (null? values) initial (reducer (car values) (f (cdr values))))))))
(define (map mapper) (reduce-right (define (map mapper) (reduce-right '()
(lambda (current accumulator) (cons (mapper current) accumulator)) (lambda (current accumulator) (cons (mapper current) accumulator))))
'()))
(define (concat left right) (define (concat left right)
((reduce-right ((reduce-right right (lambda (current accumulator) (cons current accumulator)))
(lambda (current accumulator) (cons current accumulator))
right)
left)) left))
;=============== flat ====================== ;=============== flat ======================
(define flat (reduce-right concat '())) (define flat (reduce-right '() concat))
(assert-eq "flat test 1 failed" (assert-eq "flat test 1 failed"
'(1 2 3 4 5 (6 7) 8) '(1 2 3 4 5 (6 7) 8)
(flat '((1 2) (3 4) (5 (6 7) 8)))) (flat '((1 2) (3 4) (5 (6 7) 8))))
(define (filter predicate) (reduce-right (define (filter predicate) (reduce-right '()
(lambda (current accumulator) (lambda (current accumulator)
(if (predicate current) (cons current accumulator) accumulator)) (if (predicate current) (cons current accumulator) accumulator))))
'()))
;=============== first ====================== ;=============== first ======================
(define (first predicate) (reduce-right (define (first predicate) (reduce-right '()
(lambda (current accumulator) (lambda (current accumulator)
(if (predicate current) current accumulator)) (if (predicate current) current accumulator))))
'()))
(assert-eq "first with is-not-empty test 1 failed" (assert-eq "first with is-not-empty test 1 failed"
'(1 2 3) '(1 2 3)
@ -70,12 +65,12 @@
(define (compose-two f g) (lambda (x) (f (g x)))) (define (compose-two f g) (lambda (x) (f (g x))))
(define compose (reduce-right compose-two id)) (define compose (reduce-right id compose-two))
(define (combine combiner) (define (combine combiner)
(lambda (a b) (if (null? a) b (if (null? b) a (combiner a b))))) (lambda (a b) (if (null? a) b (if (null? b) a (combiner a b)))))
(define sum (reduce-right + 0)) (define sum (reduce-right 0 +))
(define (repeat value) (Y (define (repeat value) (Y
(lambda (f) (lambda (n) (lambda (f) (lambda (n)
@ -214,9 +209,8 @@
(define solve-line (compose (list (define solve-line (compose (list
string->number string->number
list->string list->string
(reduce-right (reduce-right '()
(combine (lambda (left right) (cons (car left) (cdr right)))) (combine (lambda (left right) (cons (car left) (cdr right)))))
'())
(map (lambda (char) ((repeat char) 2))) (map (lambda (char) ((repeat char) 2)))
car car
(tokenize-aoc solution-tokens) (tokenize-aoc solution-tokens)

Loading…
Cancel
Save