day 1, part 2 (doesn't actually work because I misunderstood requirements)

day01-hard/main.scm

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

day01-hard/sample.in

@@ -0,0 +1,4 @@
+1abc2
+pqr3stu8vwx
+a1b2c3d4e5f
+treb7uchet