70 lines
2.3 KiB
Scheme
70 lines
2.3 KiB
Scheme
(load "../common.scm")
|
|
|
|
; reads a number from file up until the first non numeric character
|
|
(define (read-number file)
|
|
(let loop [(n 0)]
|
|
(let [(c (get-char file))]
|
|
(if (or (eof-object? c)
|
|
(not (char-numeric? c)))
|
|
n
|
|
(loop (+ (* n 10)
|
|
(char->number c)))))))
|
|
|
|
; parses pairs of numbers separated by one character
|
|
(define (read-coords file)
|
|
(let loop [(coords '())]
|
|
(if (char-numeric? (peek-char file))
|
|
(loop (cons (list (read-number file)
|
|
(read-number file))
|
|
coords))
|
|
coords)))
|
|
|
|
; parses lines of "fold along A=N" where A is a character or N is a number
|
|
(define (read-folds file)
|
|
(let loop [(folds '())]
|
|
(if (eof-object? (peek-char file))
|
|
(reverse folds)
|
|
(begin
|
|
(get-string-n file 11) ; consume "fold along "
|
|
(let [(axis (get-char file))
|
|
(position (begin
|
|
(get-char file) ; consume =
|
|
(read-number file)))]
|
|
(loop (cons (list axis position) folds)))))))
|
|
|
|
; mirrors coordinates along given axis and line/column
|
|
; returns a new list of coordinates
|
|
(define (fold coords axis-position)
|
|
(let-values [((axis position) (apply values axis-position))]
|
|
(let* [(position*2 (* position 2))
|
|
(mirror (if (char=? axis #\x)
|
|
(lambda (x y) (list (if (> x position) (- position*2 x) x) y))
|
|
(lambda (x y) (list x (if (> y position) (- position*2 y) y)))))
|
|
(transform (lambda (output coord)
|
|
(let [(mirrored (apply mirror coord))]
|
|
(if (member mirrored output) output (cons mirrored output)))))]
|
|
(fold-left transform '() coords))))
|
|
|
|
(call-with-input-file
|
|
"input"
|
|
(lambda (file)
|
|
(let* [(coords (read-coords file))
|
|
(folds (begin
|
|
(get-char file) ; consume newline
|
|
(read-folds file)))]
|
|
(let [(first-fold (fold coords (car folds)))]
|
|
(printf "part 1:~% ~a dots after first fold.~%"
|
|
(length first-fold)))
|
|
(let [(fully-folded (fold-left fold coords folds))]
|
|
(let [(width (+ 1 (fold-left (lambda (m c) (max m (car c))) 0 fully-folded)))
|
|
(height (+ 1 (fold-left (lambda (m c) (max m (cadr c))) 0 fully-folded)))]
|
|
(printf "part 2:~% Code is:~%")
|
|
(let y-loop [(y 0)]
|
|
(when (< y height)
|
|
(let x-loop [(x 0)]
|
|
(when (< x width)
|
|
(printf (if (member (list x y) fully-folded) "#" " "))
|
|
(x-loop (+ x 1))))
|
|
(printf "~%")
|
|
(y-loop (+ y 1)))))))))
|