123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133 |
- (import
- (except (rnrs base) let-values map error)
- (only (guile)
- lambda* λ
- current-output-port)
- (fileio)
- (math)
- (list-helpers)
- (array-helpers)
- ;; lists
- (srfi srfi-1)
- ;; let-values
- (srfi srfi-11)
- ;; hash tables
- (srfi srfi-69)
- ;; functional records
- (srfi srfi-9 gnu)
- (ice-9 pretty-print))
- (define lines (get-lines-from-file "input"))
- (define noop?
- (λ (line)
- (string=? line "noop")))
- (define addx?
- (λ (line)
- (string-prefix? "addx" line)))
- (define addx-get-number
- (λ (line)
- (string->number
- (second (string-split line #\space)))))
- (define signal-strength
- (λ (cycle register)
- (* cycle register)))
- (define-immutable-record-type <state>
- (make-state cycle register)
- state?
- (cycle state-cycle set-state-cycle)
- (register state-register set-state-register))
- (set-record-type-printer!
- <state>
- (lambda (record port)
- (simple-format port "<state: cycle:~a register:~a>"
- (state-cycle record)
- (state-register record))))
- (define initial-state (make-state 0 1))
- (define run-instruction
- (λ (state instruction)
- (cond
- [(noop? instruction)
- (set-state-cycle state (+ (state-cycle state) 1))]
- [(addx? instruction)
- (let ([register-increment (addx-get-number instruction)])
- (set-fields state
- ((state-cycle) (+ (state-cycle state) 1))
- ((state-register) (+ (state-register state) register-increment))))]
- [else
- (error "unrecognized instruction" instruction)])))
- ;; Idea: Translate addx <number> to 2 instructions, a noop
- ;; instruction and the actual adding instruction, both
- ;; taking 1 cycle. This should make it easier to write the
- ;; rest of the logic, because one does not have to consider
- ;; addx <number> taking 2 cycles.
- (define instructions
- (let iter-lines ([lines° lines])
- (cond
- [(null? lines°) '()]
- [else
- (let ([line (car lines°)])
- (cond
- [(noop? line)
- (cons line (iter-lines (cdr lines°)))]
- [(addx? line)
- (cons "noop"
- (cons line
- (iter-lines (cdr lines°))))]
- [else
- (error "unrecognized input line" line)]))])))
- (define significant-cycle?
- (λ (cycle)
- (= (remainder (+ cycle 20) 40) 0)))
- (define calc-score
- (λ (state instruction previous-score)
- (cond
- [(significant-cycle? (state-cycle state))
- (+ previous-score
- (signal-strength (state-cycle state)
- (state-register state)))]
- [else previous-score])))
- ;; Now we can act, as if every instruction merely takes 1
- ;; cycle.
- (define final-signal-strength
- (let iter ([state initial-state]
- [instructions° instructions]
- [score 0])
- (simple-format (current-output-port) "~a\n" state)
- (cond
- [(null? instructions°) score]
- [else
- (let ([instruction (car instructions°)])
- (iter (run-instruction state instruction)
- (cdr instructions°)
- (calc-score state instruction score)))])))
- (simple-format (current-output-port)
- "~a\n"
- final-signal-strength)
|