125 lines
4.8 KiB
Scheme
125 lines
4.8 KiB
Scheme
(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)))))
|