From 0e30b125c6ed4d892048ab53a04441c14db43fa2 Mon Sep 17 00:00:00 2001 From: Inga Date: Thu, 7 Dec 2023 13:21:06 +0000 Subject: [PATCH] day 5, part 1 --- day05-easy/main.scm | 358 +++++++++++++++++++++++++++++++++++++++++++ day05-easy/sample.in | 33 ++++ 2 files changed, 391 insertions(+) create mode 100755 day05-easy/main.scm create mode 100644 day05-easy/sample.in diff --git a/day05-easy/main.scm b/day05-easy/main.scm new file mode 100755 index 0000000..48b2620 --- /dev/null +++ b/day05-easy/main.scm @@ -0,0 +1,358 @@ +#!/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))) diff --git a/day05-easy/sample.in b/day05-easy/sample.in new file mode 100644 index 0000000..bd902a4 --- /dev/null +++ b/day05-easy/sample.in @@ -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 \ No newline at end of file