parent
0e30b125c6
commit
80af1ea047
@ -0,0 +1,499 @@ |
||||
#!/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))) |
||||
|
||||
;=============== combine ====================== |
||||
(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 remove-adjacent-duplicates |
||||
(reduce-right '() |
||||
(lambda (current accumulator) |
||||
(if |
||||
(and (not (null? accumulator)) (equal? current (car accumulator))) |
||||
accumulator |
||||
(cons current accumulator))))) |
||||
|
||||
(assert-eq "remove-adjacent-duplicates test 1 failed" |
||||
'(1 2 3 4 3) |
||||
(remove-adjacent-duplicates '(1 1 2 3 3 4 3 3 3))) |
||||
|
||||
;=============== 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))) |
||||
|
||||
;=============== split ====================== |
||||
(define (chunks chunk-size) |
||||
(compose (list |
||||
cdr |
||||
(reduce-right '((1)) |
||||
(lambda (current accumulator) |
||||
(if |
||||
(= chunk-size (car (car accumulator))) |
||||
(cons '(1) (cons (cons current (cdr (car accumulator))) (cdr accumulator))) |
||||
(cons (cons (+ 1 (car (car accumulator))) (cons current (cdr (car accumulator)))) (cdr accumulator)))))))) |
||||
|
||||
(assert-eq "chunks test 1 failed" |
||||
'((101 102 103) (104 105 106) (107 108 109) (110 111 112)) |
||||
((chunks 3) '(101 102 103 104 105 106 107 108 109 110 111 112))) |
||||
|
||||
;=============== range intersections ====================== |
||||
(define symbol-in-first-range (quote in-first-range)) |
||||
(define symbol-in-second-range (quote in-second-range)) |
||||
(define symbol-in-both-ranges (quote in-both-ranges)) |
||||
|
||||
(define (get-range-intersections first-range-start first-range-end second-range-start second-range-end) |
||||
((compose (list |
||||
remove-adjacent-duplicates |
||||
(filter (lambda (range-intersection) (< (value-by-index range-intersection 1) (value-by-index range-intersection 2)))))) |
||||
(list |
||||
(list symbol-in-first-range first-range-start (min first-range-end second-range-start)) |
||||
(list symbol-in-first-range (max second-range-end first-range-start) first-range-end) |
||||
(list symbol-in-second-range second-range-start (min second-range-end first-range-start)) |
||||
(list symbol-in-second-range (max first-range-end second-range-start) second-range-end) |
||||
(list symbol-in-both-ranges (max first-range-start second-range-start) (min first-range-end second-range-end))))) |
||||
|
||||
(assert-eq "get-range-intersections test 1 (intersecting, first range lower) failed" |
||||
(list |
||||
(list symbol-in-first-range 10 20) |
||||
(list symbol-in-second-range 30 40) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 10 30 20 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 2 (intersecting, second range lower) failed" |
||||
(list |
||||
(list symbol-in-first-range 30 40) |
||||
(list symbol-in-second-range 10 20) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 20 40 10 30)) |
||||
|
||||
(assert-eq "get-range-intersections test 3 (non-overlapping, first range lower) failed" |
||||
(list |
||||
(list symbol-in-first-range 10 20) |
||||
(list symbol-in-second-range 30 40)) |
||||
(get-range-intersections 10 20 30 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 4 (non-overlapping, second range lower) failed" |
||||
(list |
||||
(list symbol-in-first-range 30 40) |
||||
(list symbol-in-second-range 10 20)) |
||||
(get-range-intersections 30 40 10 20)) |
||||
|
||||
(assert-eq "get-range-intersections test 5 (second inside first) failed" |
||||
(list |
||||
(list symbol-in-first-range 10 20) |
||||
(list symbol-in-first-range 30 40) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 10 40 20 30)) |
||||
|
||||
(assert-eq "get-range-intersections test 6 (first inside second) failed" |
||||
(list |
||||
(list symbol-in-second-range 10 20) |
||||
(list symbol-in-second-range 30 40) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 20 30 10 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 7 (second inside first, same starts) failed" |
||||
(list |
||||
(list symbol-in-first-range 30 40) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 20 40 20 30)) |
||||
|
||||
(assert-eq "get-range-intersections test 8 (second inside first, same ends) failed" |
||||
(list |
||||
(list symbol-in-first-range 20 30) |
||||
(list symbol-in-both-ranges 30 40)) |
||||
(get-range-intersections 20 40 30 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 9 (first inside second, same starts) failed" |
||||
(list |
||||
(list symbol-in-second-range 30 40) |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 20 30 20 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 10 (first inside second, same ends) failed" |
||||
(list |
||||
(list symbol-in-second-range 20 30) |
||||
(list symbol-in-both-ranges 30 40)) |
||||
(get-range-intersections 30 40 20 40)) |
||||
|
||||
(assert-eq "get-range-intersections test 11 (same ranges) failed" |
||||
(list |
||||
(list symbol-in-both-ranges 20 30)) |
||||
(get-range-intersections 20 30 20 30)) |
||||
|
||||
;=============== solution ====================== |
||||
(define symbol-current (quote current)) |
||||
(define symbol-previous (quote previous)) |
||||
|
||||
(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 cdr) |
||||
(define create-state-value cons) |
||||
(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-range start end) (list start end)) |
||||
(define (create-range-from-input input) (create-range |
||||
(car input) |
||||
(+ (car input) (car (cdr input))))) |
||||
(define get-range-start car) |
||||
(define get-range-end (compose (list car cdr))) |
||||
|
||||
(define parse-initial |
||||
(compose (list |
||||
(map (lambda (raw-range) (create-state-value symbol-current (create-range-from-input raw-range)))) |
||||
(chunks 2) |
||||
(map (compose (list |
||||
string->number |
||||
list->string))) |
||||
cdr |
||||
(split (is #\space)) |
||||
string->list))) |
||||
|
||||
(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 (get-map-source-start seed-map) (value-by-index seed-map 0)) |
||||
(define (get-map-source-end seed-map) (value-by-index seed-map 1)) |
||||
(define (get-map-destination-start seed-map) (value-by-index seed-map 2)) |
||||
|
||||
(define (apply-map-to-range map-source-start map-source-end map-destination-start range-start range-end) |
||||
((compose (list |
||||
(map (lambda (intersection) |
||||
(if |
||||
(equal? symbol-in-both-ranges (car intersection)) |
||||
(create-state-value symbol-current |
||||
(create-range |
||||
(+ map-destination-start (- (get-range-start (cdr intersection)) map-source-start)) |
||||
(+ map-destination-start (- (get-range-end (cdr intersection)) map-source-start)))) |
||||
(create-state-value symbol-previous (create-range (get-range-start (cdr intersection)) (get-range-end (cdr intersection))))))) |
||||
(filter (lambda (intersection) |
||||
(or |
||||
(equal? symbol-in-second-range (car intersection)) |
||||
(equal? symbol-in-both-ranges (car intersection))))))) |
||||
(get-range-intersections map-source-start map-source-end range-start range-end))) |
||||
|
||||
(define (apply-map-to-previous-state-value seed-map state-value) |
||||
(apply-map-to-range |
||||
(get-map-source-start seed-map) |
||||
(get-map-source-end seed-map) |
||||
(get-map-destination-start seed-map) |
||||
(get-range-start state-value) |
||||
(get-range-end state-value))) |
||||
|
||||
(define (apply-map-to-state-entry seed-map) |
||||
(lambda (state-entry) |
||||
(if |
||||
(is-state-value-current state-entry) |
||||
(list state-entry) |
||||
(apply-map-to-previous-state-value seed-map (get-state-value state-entry))))) |
||||
|
||||
(define (apply-map-to-state seed-map) |
||||
(compose (list |
||||
flat |
||||
(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-range-start) |
||||
(map get-state-value) |
||||
(filter is-state-value-current) |
||||
final-state))) |
||||
|
||||
(display (solve-all (read-lines))) |
||||
@ -0,0 +1,33 @@ |
||||
seeds: 79 14 55 13 |
||||
|
||||
seed-to-soil map: |
||||
50 98 2 |
||||
52 50 48 |
||||
|
||||
soil-to-fertilizer map: |
||||
0 15 37 |
||||
37 52 2 |
||||
39 0 15 |
||||
|
||||
fertilizer-to-water map: |
||||
49 53 8 |
||||
0 11 42 |
||||
42 0 7 |
||||
57 7 4 |
||||
|
||||
water-to-light map: |
||||
88 18 7 |
||||
18 25 70 |
||||
|
||||
light-to-temperature map: |
||||
45 77 23 |
||||
81 45 19 |
||||
68 64 13 |
||||
|
||||
temperature-to-humidity map: |
||||
0 69 1 |
||||
1 0 69 |
||||
|
||||
humidity-to-location map: |
||||
60 56 37 |
||||
56 93 4 |
||||
Loading…
Reference in new issue