summaryrefslogtreecommitdiff
path: root/06
diff options
context:
space:
mode:
Diffstat (limited to '06')
-rw-r--r--06/input.txt1
-rw-r--r--06/lib.scm82
-rw-r--r--06/main.scm14
-rw-r--r--06/test.scm29
4 files changed, 126 insertions, 0 deletions
diff --git a/06/input.txt b/06/input.txt
new file mode 100644
index 0000000..04f1425
--- /dev/null
+++ b/06/input.txt
@@ -0,0 +1 @@
+4 1 15 12 0 9 9 5 5 8 7 3 14 5 12 3
diff --git a/06/lib.scm b/06/lib.scm
new file mode 100644
index 0000000..76bd34d
--- /dev/null
+++ b/06/lib.scm
@@ -0,0 +1,82 @@
+(library (lib)
+ (export solve-part1 solve-part2)
+ (import (chezscheme))
+
+ ; Split list at first delimiter into `prefix' and `suffix'
+ ; Return value is a pair like `((p r e f i x) s u f f i x)'
+ (define (list-split-left delimiter? xs)
+ (let loop ((prefix '())
+ (suffix xs))
+ (if (null? suffix)
+ (cons prefix suffix)
+ (let ((x (car suffix)))
+ (if (delimiter? x)
+ ; Found first delimiter, so return immediately
+ (cons prefix (cdr suffix))
+ ; `x' isn't a delimiter, so append it to `prefix'
+ (loop (append prefix (list x)) (cdr suffix)))))))
+
+ ; Split list at given delimiter into list of sublists
+ (define (list-split delimiter? xs)
+ (let loop ((pieces '())
+ (rest xs))
+ (if (null? rest)
+ ; Fix order and remove all empty sublists from output
+ ; (which are caused by consecutive delimiters in `xs')
+ (reverse (remp null? pieces))
+ ; Extract next piece from `rest' and prepend it to `pieces'
+ (let ((next (list-split-left delimiter? rest)))
+ (loop (cons (car next) pieces) (cdr next))))))
+
+ ; Split string at whitespace into list of words
+ (define (string-split str)
+ (map list->string (list-split char-whitespace? (string->list str))))
+
+ ; Find the index at which `needle' occurs in `haystack', or `#f'
+ (define (find-index needle haystack)
+ (let loop ((xs haystack) (i 0))
+ (if (null? xs)
+ #f
+ (if (equal? needle (car xs))
+ i
+ (loop (cdr xs) (+ i 1))))))
+
+ ; `apply' but for vectors, assuming `proc' returns a scalar
+ (define (vector-apply proc vec)
+ (apply proc (vector->list vec)))
+
+ ; Redistribute the items according to the puzzle description
+ (define (redistribute old)
+ (let* ((n-max (vector-apply max old)) ; largest value in `old'
+ (i-max (find-index n-max (vector->list old))) ; index of `n-max' in `old'
+ (new (vector-apply vector old)) ; allocate copy of `old'
+ (len (vector-length old))) ; number of slots in `old'
+ ; Clear the slot that had the most items
+ (vector-set! new i-max 0)
+ ; Add those items to the other slots one by one
+ (let loop ((i (mod (+ i-max 1) len))
+ (remaining n-max))
+ (if (= remaining 0)
+ new
+ (let ((n (vector-ref new i)))
+ (vector-set! new i (+ n 1))
+ (loop (mod (+ i 1) len) (- remaining 1)))))))
+
+ ; Keep redistributing items until a previous state is revisited
+ (define (solve-puzzle str)
+ (let ((init (list->vector (map string->number (string-split str)))))
+ (let loop ((states (list init)))
+ (if (find-index (car states) (cdr states))
+ states
+ (loop (cons (redistribute (car states)) states))))))
+
+ ; Loop detected after `(length states)' cycles, minus initial state
+ (define (solve-part1 str)
+ (- (length (solve-puzzle str)) 1))
+
+ ; Loop start state first seen somewhere in `(cdr states)', at which index?
+ (define (solve-part2 str)
+ (let ((states (solve-puzzle str)))
+ (+ (find-index (car states) (cdr states)) 1)))
+
+)
diff --git a/06/main.scm b/06/main.scm
new file mode 100644
index 0000000..4e58151
--- /dev/null
+++ b/06/main.scm
@@ -0,0 +1,14 @@
+(import (chezscheme))
+
+; Where the magic happens
+(import (lib))
+
+; Read my personal puzzle input
+(define input
+ (call-with-input-file "input.txt" get-line))
+
+; Part 1 gives 6681 for me
+(printf "Part 1 solution: ~a\n" (solve-part1 input))
+
+; Part 2 gives 2392 for me
+(printf "Part 2 solution: ~a\n" (solve-part2 input))
diff --git a/06/test.scm b/06/test.scm
new file mode 100644
index 0000000..e8efb7c
--- /dev/null
+++ b/06/test.scm
@@ -0,0 +1,29 @@
+(import (chezscheme))
+
+; Where the magic happens
+(import (lib))
+
+; My quick-and-dirty unit testing framework (copied for each day)
+(define (run-test name proc input expected)
+ (let ((result (proc input)))
+ (if (equal? result expected)
+ (printf "\x1b;[32;1mPASS\x1b;[0m: ~a\n"
+ name)
+ (printf "\x1b;[31;1mFAIL\x1b;[0m: ~a: got ~a, expected ~a\n"
+ name result expected))))
+
+(printf "Part 1 tests:\n")
+
+(define (test-part1 name input expected)
+ (run-test name solve-part1 input expected))
+
+(test-part1 "part 1 example 1"
+ "0 2 7 0" 5)
+
+(printf "Part 2 tests:\n")
+
+(define (test-part2 name input expected)
+ (run-test name solve-part2 input expected))
+
+(test-part2 "part 2 example 1"
+ "0 2 7 0" 4)