day 5, part 1

main
Inga 🏳‍🌈 11 months ago
parent 5b260d8dec
commit 0e30b125c6
  1. 358
      day05-easy/main.scm
  2. 33
      day05-easy/sample.in

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

@ -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…
Cancel
Save