more functional approach

day01-easy/main.scm

@@ -10,51 +10,46 @@
       '()
       (cons line (loop (read-line))))))
 
-(define (reduce-right reducer initial list)
+(define (id value) value)
-  (if
-    (null? list)
-    initial
-    (reducer (car list) (reduce-right reducer initial (cdr list)))))
 
-(define (map mapper list)
+(define (compose result-transformer f argument-transformer)
+  (lambda (value)
+    (result-transformer (f (argument-transformer value)))))
+
+(define Y (lambda (f) (f (lambda (x) ((Y f) x)))))
+
+(define (reduce-right reducer initial) (Y
+  (lambda (f) (lambda (list)
+    (if (null? list) initial (reducer (car list) (f (cdr list))))))))
+
+(define (map mapper)
   (reduce-right
     (lambda (current accumulator) (cons (mapper current) accumulator))
-    '()
+    '()))
-    list))
 
-(define (combine combiner a b)
+(define (combine combiner)
-  (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 numbers) (reduce-right + 0 numbers))
+(define sum (reduce-right + 0))
 
-(define
+(define (repeat value) (Y
-  (repeat value number)
+  (lambda (f) (lambda (n)
-  (if
+    (if (= n 0) '() (cons value (f (- n 1))))))))
-    (= number 0)
-    '()
-    (cons value (repeat value (- number 1)))))
 
 (define (is-numeric-char char) (if (char-numeric? char) #t #f))
 
-(define (first-last predicate list)
+(define (first-last predicate) (compose
+  id
   (reduce-right
-    (lambda (current accumulator)
+    (combine (lambda (left right) (cons (car left) (cdr right))))
-      (combine
+    '())
-        (lambda (left right) (cons (car left) (cdr right)))
+  (map (lambda (entry) (if (predicate entry) ((repeat entry) 2) '())))))
-        current
+
-        accumulator))
+(define solve-line (compose
-    '()
+  (lambda (first-last-result) (string->number (list->string first-last-result)))
-    (map
+  (first-last is-numeric-char)
-      (lambda (entry)
+  string->list))
-        (if (predicate entry) (repeat entry 2) '()))
+
-      list)))
+(define (solve-all lines) (sum ((map solve-line) lines)))
-
-(define (solve-line line)
-  ((lambda (first-last-result)
-    (string->number (list->string first-last-result)))
-    (first-last is-numeric-char (string->list line))))
-
-(define (solve-all lines)
-  (sum (map solve-line lines)))
 
 (display (solve-all (read-lines)))