day 13

13-transparent-origami/code.scm

@@ -0,0 +1,75 @@
+(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* [(axis (car axis-position))
+	 (position (cadr axis-position))
+	 (position*2 (* 2 position))]
+    (define (mirror-x x y) (list (if (> x position) (- position*2 x) x) y))
+    (define (mirror-y x y) (list x (if (> y position) (- position*2 y) y)))
+    (let [(mirror (if (char=? axis #\x) mirror-x mirror-y))]
+      (define (folder output coord)
+	(let* [(x (car coord))
+	       (y (cadr coord))
+	       (mirrored (mirror x y))]
+	  ; add mirrored coord only if it wasn't in output already
+	  (if (member mirrored output) 
+	    output
+	    (cons (mirror x y) output))))
+      (fold-left folder '() 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)))))))))