You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
335 lines
9.0 KiB
335 lines
9.0 KiB
#!/usr/bin/guile -s
|
|
!#
|
|
|
|
;=============== functions with side effects (I/O) ======================
|
|
(use-modules (ice-9 rdelim))
|
|
|
|
(define (read-lines)
|
|
((lambda (line)
|
|
(if (eof-object? line) '() (cons line (read-lines))))
|
|
(read-line)))
|
|
|
|
(define (display-ln value) (list (display value) (display "\n")))
|
|
|
|
(define (assert-eq error-message expected actual)
|
|
(if (not (equal? expected actual))
|
|
(display-ln (list error-message (list "expected" expected) (list "actual" actual)))
|
|
'()))
|
|
|
|
(define (tee value) (car (list value (display-ln value))))
|
|
;=============== end of functions with side effects ======================
|
|
|
|
(define (id value) value)
|
|
(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))))
|
|
|
|
(assert-eq "Y test 1 (factorial) failed"
|
|
120
|
|
((Y (lambda (f) (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) 5))
|
|
|
|
(assert-eq "Y2 test 1 (pascal triangle) failed"
|
|
35
|
|
((Y2 (lambda (f) (lambda (a b)
|
|
(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))
|
|
|
|
(assert-eq "flat test 1 failed"
|
|
'(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)
|
|
(if (predicate current) current accumulator))))
|
|
|
|
(assert-eq "first with is-not-empty test 1 failed"
|
|
'(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)
|
|
(if
|
|
(null? prefix)
|
|
values
|
|
(if
|
|
(null? values)
|
|
#f
|
|
(if (equal? (car prefix) (car values))
|
|
(f (cdr prefix) (cdr values))
|
|
#f)))))))
|
|
|
|
(assert-eq "starts-with test 1 failed"
|
|
'(4)
|
|
(starts-with '(1 2 3) '(1 2 3 4)))
|
|
|
|
(assert-eq "starts-with test 2 failed"
|
|
'()
|
|
(starts-with '(1 2 3) '(1 2 3)))
|
|
|
|
(assert-eq "starts-with test 3 failed"
|
|
#f
|
|
(starts-with '(1 2 3) '(1 2)))
|
|
|
|
(assert-eq "starts-with test 4 failed"
|
|
#f
|
|
(starts-with '(1 2 3) '(4 5 6 7)))
|
|
|
|
(assert-eq "starts-with test 5 failed"
|
|
(string->list "de")
|
|
(starts-with (string->list "abc") (string->list "abcde")))
|
|
|
|
;=============== tokenize ======================
|
|
(define (tokenize-generic tokens next) (Y
|
|
(lambda (f) (lambda (values)
|
|
(if
|
|
(null? values)
|
|
'(())
|
|
((compose (list
|
|
(coalesce-not-empty (lambda () (f (cdr values))))
|
|
flat
|
|
(map (lambda (token) ((compose (list
|
|
(map (prepend (car token)))
|
|
(lambda (rest) (if rest (f (next rest values)) '()))))
|
|
(starts-with (cdr token) values))))))
|
|
tokens))))))
|
|
|
|
(define (tokenize tokens)
|
|
(tokenize-generic tokens (lambda (rest values) rest)))
|
|
|
|
(assert-eq "tokenize test 1 failed"
|
|
'((101 201) (101 202) (102 201) (102 202))
|
|
((tokenize '((101 1) (102 1) (201 2) (202 2)))
|
|
'(1 2)))
|
|
|
|
(assert-eq "tokenize test 2 failed"
|
|
'((101 102 102 101 102))
|
|
((tokenize '((101 1) (102 2)))
|
|
'(1 2 3 2 1 2)))
|
|
|
|
(assert-eq "tokenize test 3 failed"
|
|
'((101 102 101) (101 1021) (1012 101))
|
|
((tokenize '((101 1) (102 2) (1012 1 2) (1021 2 1)))
|
|
'(1 2 1)))
|
|
|
|
(define (tokenize-aoc tokens)
|
|
(tokenize-generic tokens (lambda (rest values) (cdr values))))
|
|
|
|
;=============== solution ======================
|
|
(define solution-tokens
|
|
(list
|
|
(cons #\0 (string->list "0"))
|
|
(cons #\1 (string->list "1"))
|
|
(cons #\2 (string->list "2"))
|
|
(cons #\3 (string->list "3"))
|
|
(cons #\4 (string->list "4"))
|
|
(cons #\5 (string->list "5"))
|
|
(cons #\6 (string->list "6"))
|
|
(cons #\7 (string->list "7"))
|
|
(cons #\8 (string->list "8"))
|
|
(cons #\9 (string->list "9"))
|
|
(cons #\1 (string->list "one"))
|
|
(cons #\2 (string->list "two"))
|
|
(cons #\3 (string->list "three"))
|
|
(cons #\4 (string->list "four"))
|
|
(cons #\5 (string->list "five"))
|
|
(cons #\6 (string->list "six"))
|
|
(cons #\7 (string->list "seven"))
|
|
(cons #\8 (string->list "eight"))
|
|
(cons #\9 (string->list "nine"))))
|
|
|
|
(assert-eq "solution tokenize test 1 failed"
|
|
(list (string->list "219"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "two1nine")))
|
|
|
|
(assert-eq "solution tokenize test 2 failed"
|
|
(list (string->list "823"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "eightwothree")))
|
|
|
|
(assert-eq "solution tokenize test 3 failed"
|
|
(list (string->list "123"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "abcone2threexyz")))
|
|
|
|
(assert-eq "solution tokenize test 4 failed"
|
|
(list (string->list "2134"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "xtwone3four")))
|
|
|
|
(assert-eq "solution tokenize test 5 failed"
|
|
(list (string->list "49872"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "4nineeightseven2")))
|
|
|
|
(assert-eq "solution tokenize test 6 failed"
|
|
(list (string->list "18234"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "zoneight234")))
|
|
|
|
(assert-eq "solution tokenize test 7 failed"
|
|
(list (string->list "76"))
|
|
((tokenize-aoc solution-tokens)
|
|
(string->list "7pqrstsixteen")))
|
|
|
|
(define solve-line (compose (list
|
|
string->number
|
|
list->string
|
|
(reduce-right '()
|
|
(combine (lambda (left right) (cons (car left) (cdr right)))))
|
|
(map (lambda (char) ((repeat char) 2)))
|
|
car
|
|
(tokenize-aoc solution-tokens)
|
|
string->list)))
|
|
|
|
(define solve-all (compose (list
|
|
sum
|
|
(map solve-line))))
|
|
|
|
(display (solve-all (read-lines)))
|
|
|