Solutions of some puzzles in Scheme (Lisp), my first experience with it.
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.

201 lines
5.3 KiB

#!/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)))!#