From e6af1cefde4c50b1138ca8559a329eb0a8925d4b Mon Sep 17 00:00:00 2001
From: lamp
Date: Fri, 8 Dec 2023 14:03:25 +0000
Subject: add day 7 solutions

---
 7-2.scm | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100755 7-2.scm

(limited to '7-2.scm')

diff --git a/7-2.scm b/7-2.scm
new file mode 100755
index 0000000..63d25e3
--- /dev/null
+++ b/7-2.scm
@@ -0,0 +1,69 @@
+#!/usr/bin/env -S guile -s
+!#
+(use-modules (ice-9 regex)
+             (ice-9 textual-ports)
+             (srfi srfi-1)
+             (srfi srfi-69))
+
+(define (read-lines port)
+  (letrec ((loop (lambda (l ls)
+                   (if (eof-object? l)
+                       ls
+                       (loop (get-line port) (cons l ls))))))
+    (reverse (loop (get-line port) '()))))
+
+(define (max-occurence lst)
+  (define hash (make-hash-table))
+  (define zero (lambda () 0))
+  (let loop ((lst lst) (mfreq 0) (mcur #f))
+    (if (null? lst)
+        mcur
+        (let* ((element (car lst)) (freq (+ 1 (hash-table-ref hash element zero))))
+          (hash-table-set! hash element freq)
+          (if (> freq mfreq)
+              (loop (cdr lst) freq element)
+              (loop (cdr lst) mfreq mcur))))))
+
+(define (hand-class hand)
+  (let* ((joker-card (max-occurence (filter (lambda (x) (not (equal? x #\J)))(string->list hand))))
+         (hand (if joker-card (list->string (map (lambda (x) (if (equal? x #\J) joker-card x))
+                                                 (string->list hand)))
+                   hand))
+         (hand-uniq (length (delete-duplicates (string->list hand)))))
+    (cond ((= 1 hand-uniq) 6)
+          ((= 2 hand-uniq)
+           (let ((x (string-length (string-filter (string-ref hand 0) hand))))
+             (if (or (= 1 x) (= 4 x)) 5 4)))
+          ((= 3 hand-uniq)
+           (if (or (= 3 (string-length (string-filter (string-ref hand 0) hand)))
+                   (= 3 (string-length (string-filter (string-ref hand 1) hand)))
+                   (= 3 (string-length (string-filter (string-ref hand 2) hand)))) 3 2))
+          ((= 4 hand-uniq) 1)
+          (else 0))))
+
+(define (card-power card)
+  (length (member card '(#\A #\K #\Q #\T #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\J))))
+
+(define (card-power-less lhs rhs)
+  (let ((i 0))
+    (while (equal? (string-ref lhs i)
+                   (string-ref rhs i))
+      (set! i (1+ i)))
+    (< (card-power (string-ref lhs i)) (card-power (string-ref rhs i)))))
+
+(define (hand-less-than lhs rhs)
+  (let ((lhs-class (hand-class (car lhs)))
+        (rhs-class (hand-class (car rhs))))
+    (if (equal? lhs-class rhs-class)
+        (card-power-less (car lhs) (car rhs))
+        (< lhs-class rhs-class))))
+
+(let* ((port (open-input-file "7.txt"))
+       (lines (read-lines port))
+       (bids (sort (map (lambda (line) (let ((bid (string-split line char-set:whitespace)))
+                                   `(,(car bid) . ,(string->number (cadr bid))))) lines) hand-less-than))
+       (winnings 0))
+  (close-port port)
+  (do ((i 0 (1+ i))) ((= i (length bids)))
+    (list-set! bids i (* (+ i 1) (cdr (list-ref bids i)))))
+  (display (fold + 0 bids)))
-- 
cgit v1.2.3