#!/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)))) (define (tee-with-comment comment) (lambda (value) (car (list value (display comment) (display " ") (display-ln value))))) ;=============== end of functions with side effects ====================== (define (id value) value) (define (is value) (lambda (x) (equal? x 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))) ;=============== reduce-left ====================== (define (reduce-left initial reducer) (lambda (values) ((Y2 (lambda (f) (lambda (rest accumulator) (if (null? rest) accumulator (f (cdr rest) (reducer (car rest) accumulator)))))) values initial))) (assert-eq "reduce-left test 1 failed" '(4 104 3 103 2 102 1 101 0) ((reduce-left '(0) (lambda (current accumulator) (cons (+ 1 (car accumulator)) (cons current accumulator)))) '(101 102 103 104))) ;=============== reverse ====================== (define reverse (reduce-left '() cons)) (assert-eq "reverse test 1 failed" '(4 3 2 1) (reverse '(1 2 3 4))) ;=============== 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))) (assert-eq "map test 2 failed" '(1 2 (3 4) 5) ((map id) '(1 2 (3 4) 5))) ;=============== concat ====================== (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))) ;=============== min-list ====================== (define min-list (reduce-right #f (lambda (current accumulator) (if accumulator (min current accumulator) current)))) (assert-eq "min-list test 1 failed" 2 (min-list '(7 3 8 5 2 6 9))) (assert-eq "min-list test 2 failed" #f (min-list '())) ;=============== 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)) ;=============== value-by-index ====================== (define value-by-index (Y2 (lambda (f) (lambda (values index) (if (= index 0) (car values) (f (cdr values) (- index 1))))))) (assert-eq "value-by-index test 1 failed" 12 (value-by-index '(10 11 12 13 14) 2)) ;=============== split ====================== (define (split predicate) (reduce-right '(()) (lambda (current accumulator) (if (predicate current) (cons '() accumulator) (cons (cons current (car accumulator)) (cdr accumulator)))))) (assert-eq "split test 1 failed" '((1 2) (3 4 5) (6 7)) ((split (is 0)) '(1 2 0 3 4 5 0 6 7))) (assert-eq "split test 2 failed" '(() (1 2) () (3 4 5) (6 7) ()) ((split (is 0)) '(0 1 2 0 0 3 4 5 0 6 7 0))) ;=============== solution ====================== (define symbol-current (quote current)) (define symbol-previous (quote previous)) (define parse-initial (compose (list (map (compose (list (lambda (number) (list symbol-current number)) string->number list->string))) cdr (split (is #\space)) string->list))) (define (mark-state-value-previous state-entry) (cons symbol-previous (cdr state-entry))) (define (is-state-value-current state-entry) (equal? symbol-current (car state-entry))) (define (get-state-value state-entry) (car (cdr state-entry))) (define swap-state (compose (list #!(tee-with-comment "state after swap")!# (map mark-state-value-previous) (filter is-state-value-current) #!(tee-with-comment "state before swap")!#))) (define (create-map numbers) (list ;; convert it from destination_start, source_start, length ;; to source_start, source_end, destination_start (value-by-index numbers 1) (+ (value-by-index numbers 1) (value-by-index numbers 2)) (value-by-index numbers 0))) (define (map-source-start seed-map) (value-by-index seed-map 0)) (define (map-source-end seed-map) (value-by-index seed-map 1)) (define (map-destination-start seed-map) (value-by-index seed-map 2)) (define (apply-map-to-previous-state-value seed-map state-value) (if (and (<= (map-source-start seed-map) state-value) (< state-value (map-source-end seed-map))) (list symbol-current (+ (- state-value (map-source-start seed-map)) (map-destination-start seed-map))) (list symbol-previous state-value))) (define (apply-map-to-state-entry seed-map) (lambda (state-entry) (if (is-state-value-current state-entry) state-entry (apply-map-to-previous-state-value seed-map (get-state-value state-entry))))) (define (apply-map-to-state seed-map) (map (apply-map-to-state-entry seed-map))) (define (seed-maps-processor raw-seed-maps) (compose (list ;; for state #!(tee-with-comment "state after applying mapset")!# ((compose (list ;; for list of map lines (within a single map set); should return state-transforming lambda compose (map apply-map-to-state) #!(tee-with-comment "current mapset")!# (prepend '(0 4294967295 0)) (map (compose (list ;; for map line create-map (map (compose (list ;; for number in map line string->number list->string))) (split (is #\space)) string->list ))) #!(tee-with-comment "raw seed maps without prefix")!# cdr)) raw-seed-maps) swap-state))) (define (final-state lines) (((compose (list compose (map seed-maps-processor) reverse (filter is-not-empty) (split (is "")))) (cdr lines)) (parse-initial (car lines)))) (define solve-all (compose (list min-list (map get-state-value) (filter is-state-value-current) final-state))) (display (solve-all (read-lines)))