parent
b50ad6a020
commit
5ed8b1729e
@ -0,0 +1,201 @@ |
||||
#!/usr/bin/guile -s |
||||
!# |
||||
|
||||
(use-modules (ice-9 rdelim)) |
||||
|
||||
(define (read-lines) |
||||
((lambda (line) |
||||
(if (eof-object? line) '() (cons line (read-lines)))) |
||||
(read-line))) |
||||
|
||||
(define (assert-eq error-message expected actual) |
||||
(if (not (equal? expected actual)) |
||||
(list |
||||
(display (list error-message (list "expected" expected) (list "actual" actual))) |
||||
(display "\n")) |
||||
'())) |
||||
|
||||
(define (id value) value) |
||||
(define (is-not value) (lambda (x) (not (= x value)))) |
||||
(define is-not-empty (lambda (x) (not (null? x)))) |
||||
|
||||
(define Y (lambda (f) (f (lambda (x) ((Y f) x))))) |
||||
(define Y2 (lambda (f) (f (lambda (x y) ((Y2 f) x y))))) |
||||
|
||||
(define (reduce-right reducer initial) (Y |
||||
(lambda (f) (lambda (values) |
||||
(if (null? values) initial (reducer (car values) (f (cdr values)))))))) |
||||
|
||||
(define (map mapper) (reduce-right |
||||
(lambda (current accumulator) (cons (mapper current) accumulator)) |
||||
'())) |
||||
|
||||
(define (concat left right) |
||||
((reduce-right |
||||
(lambda (current accumulator) (cons current accumulator)) |
||||
right) |
||||
left)) |
||||
|
||||
;=============== starts-with ====================== |
||||
(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)))) |
||||
|
||||
(define (filter predicate) (reduce-right |
||||
(lambda (current accumulator) |
||||
(if (predicate current) (cons current accumulator) accumulator)) |
||||
'())) |
||||
|
||||
;=============== 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)))) |
||||
|
||||
(define (compose-two f g) (lambda (x) (f (g x)))) |
||||
|
||||
(define compose (reduce-right compose-two id)) |
||||
|
||||
(define (combine combiner) |
||||
(lambda (a b) (if (null? a) b (if (null? b) a (combiner a b))))) |
||||
|
||||
(define sum (reduce-right + 0)) |
||||
|
||||
(define (repeat value) (Y |
||||
(lambda (f) (lambda (n) |
||||
(if (= n 0) '() (cons value (f (- n 1)))))))) |
||||
|
||||
|
||||
;=============== 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 "d") |
||||
(starts-with (string->list "abc") (string->list "abcd"))) |
||||
|
||||
;=============== tokenize ====================== |
||||
(define (tokenize tokens) (Y |
||||
(lambda (f) (lambda (values) |
||||
(if |
||||
(null? values) |
||||
'(()) |
||||
((first is-not-empty) (list |
||||
(flat |
||||
((filter id) |
||||
((map |
||||
(lambda (token) |
||||
((lambda (rest) |
||||
(if |
||||
rest |
||||
((map |
||||
(lambda (rest-tokenized) |
||||
(cons (car token) rest-tokenized))) |
||||
(f rest)) |
||||
#f)) |
||||
(starts-with (cdr token) values)))) |
||||
tokens))) |
||||
(f (cdr values)) |
||||
'((77 78) (79 76))))))))) |
||||
|
||||
(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))) |
||||
|
||||
;=============== 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" |
||||
'((2 1 9)) |
||||
((tokenize solution-tokens) |
||||
(string->list "two1nine"))) |
||||
|
||||
(assert-eq "solution tokenize test 2 failed" |
||||
'((8 2 3)) |
||||
((tokenize solution-tokens) |
||||
(string->list "eightwothree"))) |
||||
|
||||
(define solve-line (compose (list |
||||
string->number |
||||
list->string |
||||
(reduce-right |
||||
(combine (lambda (left right) (cons (car left) (cdr right)))) |
||||
'()) |
||||
(map (lambda (char) (if (char-numeric? char) ((repeat char) 2) '()))) |
||||
string->list))) |
||||
|
||||
(define solve-all (compose (list |
||||
sum |
||||
(map solve-line)))) |
||||
|
||||
#!(display (solve-all (read-lines)))!# |
||||
|
||||
#!(display (starts-with (list 5 6 7) (list 5 6)))!# |
||||
|
||||
#!(display ((filter (isnot 5)) (list 3 4 5 6 7)))!# |
||||
|
||||
#!(display (flat (list (list 1 2 3) (list 4 5 6) (list 7 8))))!# |
||||
|
||||
#!(assert-eq "mew" (list 1 2 (list 3 4)) (list 1 2 (list 3 4)))!# |
@ -0,0 +1,4 @@ |
||||
1abc2 |
||||
pqr3stu8vwx |
||||
a1b2c3d4e5f |
||||
treb7uchet |
Loading…
Reference in new issue