day 14

14-extended-polymerization/code.scm

@@ -0,0 +1,124 @@
+(import (srfi :43)) ; vector extensions
+
+; hash function for a list of two characters
+(define (char-pair-hash cp)
+  (+ (* (char->integer (car cp)) 79)
+     (char->integer (cadr cp))))
+
+; parses lines of "AB -> C" with A, B and C being characters
+; returns hashtable where keys are ABs and values are Cs
+(define (read-table file)
+  (let loop [(table (make-hashtable char-pair-hash equal? 32))]
+    (let [(line (get-line file))]
+      (if (eof-object? line)
+	table
+	(let [(key (list (string-ref line 0) (string-ref line 1)))
+	      (value (string-ref line 6))]
+	  (hashtable-set! table key value)
+	  (loop table))))))
+
+; generate new polymer from inserting elements in between each pair according to given table
+(define (insert polymer table)
+  (let [(end (- (string-length polymer) 1))]
+    (let loop [(i 0) (output "")]
+      (if (< i end)
+	(loop (+ i 1)
+	      (let* [(pair (list (string-ref polymer i) (string-ref polymer (+ i 1))))
+		     (element (hashtable-ref table pair #f))]
+		(if element
+		  (string-append output (string (car pair)) (string element))
+		  (string-append output (string (car pair))))))
+	(string-append output (substring polymer end (+ end 1)))))))
+
+; parameter counts is a vector where each entry is a list (C N)
+; where C is a key and N is a number.
+; returns a vector where entry of ele has increased by count.
+(define (add-ele-count counts ele count)
+  (let [(index (vector-index (lambda (p) (equal? (car p) ele)) counts))]
+    (if index
+      (begin
+	(vector-set! counts index (list ele (+ count (cadr (vector-ref counts index)))))
+	counts)
+      (vector-append counts (vector (list ele count))))))
+
+; count amount of each character in input string.
+; returns vector of lists where car is a character and cadr is the amount of it in input
+; sorted from most common to least common
+(define (count-chars str)
+  (let [(count (vector))]
+    (string-for-each (lambda (c) (set! count (add-ele-count count c 1))) str)
+    count))
+
+; print result to console
+(define (display-subtracted-most-least-elements elements)
+  (let* [(elements (vector-sort (lambda (l r) (> (cadr l) (cadr r))) elements))
+	 (most-common (vector-ref elements 0))
+	 (least-common (vector-ref elements (- (vector-length elements) 1)))]
+    (printf "Most common ~a (~a) - least common ~a (~a) = ~a~%"
+	    (car most-common) (cadr most-common)
+	    (car least-common) (cadr least-common)
+	    (- (cadr most-common) (cadr least-common)))))
+
+; returns a vector counting the number of each consecutive characters in str
+(define (count-pairs str)
+  (let [(len-1 (- (string-length str) 1))]
+    (let loop [(n 0) (pairs '#())]
+      (if (< n len-1)
+	(loop (+ n 1)
+	      (let [(pair (list (string-ref str n) (string-ref str (+ n 1))))]
+		(add-ele-count pairs pair 1)))
+	pairs))))
+
+; count the number of elements where given pairs-count is a vector
+; with amounts of pairs of elements
+; #(((a b) N) ((c d) N') ...)
+(define (count-elements pairs-count)
+  (vector-fold
+    (lambda (index elements-count pair-count)
+      (let [(pair (car pair-count))
+	    (count (cadr pair-count))]
+	(set! elements-count (add-ele-count elements-count (car pair) count))
+	(add-ele-count elements-count (cadr pair) count)))
+    '#() pairs-count))
+
+; directly computes resulting element amounts of
+; inserting elements in input polymer up to depth steps
+; returns vector of lists where car is an element's character and cadr is the amount of it
+(define (polymerize polymer table depth)
+  (let step [(d 0)
+	     (polymer-pairs (count-pairs polymer))
+	     (candidate-pairs '#())]
+    (if (< d depth)
+      (let [(new-polymer-pairs '#()) (new-candidates '#())]
+	(define (multiply index pair-count)
+	  (let* [(pair (car pair-count))
+		 (count (cadr pair-count))
+		 (element (hashtable-ref table pair #f))]
+	    (if element
+	      (let [(new-pair (list (car pair) element))
+		    (new-candidate (list element (cadr pair)))]
+		(set! new-polymer-pairs (add-ele-count new-polymer-pairs new-pair count))
+		(set! new-candidates (add-ele-count new-candidates new-candidate count)))
+	      (add-ele-count pair count))))
+	(vector-for-each multiply polymer-pairs)
+	(vector-for-each multiply candidate-pairs)
+	(step (+ d 1) new-polymer-pairs new-candidates))
+      (let [(elements (count-elements polymer-pairs))
+	    (last (string-ref polymer (- (string-length polymer) 1)))]
+	(add-ele-count elements last 1)))))
+
+(call-with-input-file
+  "input"
+  (lambda (file)
+    (let* [(polymer (get-line file))
+	   (table (begin
+		    (get-line file) ; skip empty line
+		    (read-table file)))]
+      (let loop [(n 0) (polymer polymer)]
+	(if (< n 10)
+	  (loop (+ n 1) (insert polymer table))
+	  (begin
+	    (printf "part 1:~% After 10 polymerization steps: ~% ")
+	    (display-subtracted-most-least-elements (count-chars polymer)))))
+      (printf "part 2:~% After 40 polymerization steps: ~% ")
+      (display-subtracted-most-least-elements (polymerize polymer table 40)))))

14-extended-polymerization/input

@@ -0,0 +1,102 @@
+OHFNNCKCVOBHSSHONBNF
+
+SV -> O
+KP -> H
+FP -> B
+VP -> V
+KN -> S
+KS -> O
+SB -> K
+BS -> K
+OF -> O
+ON -> S
+VS -> F
+CK -> C
+FB -> K
+CH -> K
+HS -> H
+PO -> F
+NP -> N
+FH -> C
+FO -> O
+FF -> C
+CO -> K
+NB -> V
+PP -> S
+BB -> N
+HH -> B
+KK -> H
+OP -> K
+OS -> V
+KV -> F
+VH -> F
+OB -> S
+CN -> H
+SF -> K
+SN -> P
+NF -> H
+HB -> V
+VC -> S
+PS -> P
+NK -> B
+CV -> P
+BC -> S
+NH -> K
+FN -> P
+SH -> F
+FK -> P
+CS -> O
+VV -> H
+OC -> F
+CC -> N
+HK -> N
+FS -> P
+VF -> B
+SS -> V
+PV -> V
+BF -> V
+OV -> C
+HO -> F
+NC -> F
+BN -> F
+HC -> N
+KO -> P
+KH -> F
+BV -> S
+SK -> F
+SC -> F
+VN -> V
+VB -> V
+BH -> O
+CP -> K
+PK -> K
+PB -> K
+FV -> S
+HN -> K
+PH -> B
+VK -> B
+PC -> H
+BO -> H
+SP -> V
+NS -> B
+OH -> N
+KC -> H
+HV -> F
+HF -> B
+HP -> S
+CB -> P
+PN -> S
+BK -> K
+PF -> N
+SO -> P
+CF -> B
+VO -> C
+OO -> K
+FC -> F
+NV -> F
+OK -> K
+NN -> O
+NO -> O
+BP -> O
+KB -> O
+KF -> O