From 1fbb07c54523c7a576bfff1cb689e155dd55f15a Mon Sep 17 00:00:00 2001
From: Prefetch
Date: Sat, 2 Mar 2024 19:36:12 +0100
Subject: Add first five days

---
 04/lib.scm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100644 04/lib.scm

(limited to '04/lib.scm')

diff --git a/04/lib.scm b/04/lib.scm
new file mode 100644
index 0000000..5a1fff5
--- /dev/null
+++ b/04/lib.scm
@@ -0,0 +1,74 @@
+(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))))
+
+  ; Sort chars in string according to `proc'
+  (define (string-sort proc str)
+    (list->string (list-sort proc (string->list str))))
+
+  ; Partially applied equality check
+  (define (check-identical? word1)
+    (lambda (word2) (equal? word1 word2)))
+
+  ; Partially applied anagram check
+  (define (check-anagram? word1)
+    (lambda (word2)
+      ; Sort chars by Unicode value, then check string equality
+      (string=? (string-sort char<? word1)
+                (string-sort char<? word2))))
+
+  ; Count for how many elements of `xs' `proc' returns true
+  (define (count proc xs)
+    (length (filter proc xs)))
+
+  ; Count how many passphrases in `lines' are reported valid by `proc'
+  (define (solve-puzzle proc lines)
+    (count
+      (lambda (phrase)
+        ; For each word in `phrase', does it have any copies/anagrams?
+        (let loop ((words phrase))
+          (if (null? words)
+              #t
+              ; Count copies/anagrams, including `(car words)' itself
+              (if (> (count (proc (car words)) phrase) 1)
+                  #f
+                  (loop (cdr words))))))
+      (map string-split lines)))
+
+  (define (solve-part1 lines)
+    (solve-puzzle check-identical? lines))
+
+  (define (solve-part2 lines)
+    (solve-puzzle check-anagram? lines))
+
+)
-- 
cgit v1.2.3