diff --git a/14-extended-polymerization/code.scm b/14-extended-polymerization/code.scm new file mode 100644 index 0000000..c417ed1 --- /dev/null +++ b/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))))) diff --git a/14-extended-polymerization/input b/14-extended-polymerization/input new file mode 100644 index 0000000..4706b75 --- /dev/null +++ b/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