renamed folders with days' name

05-hydrothermal-venture/code.scm

@@ -0,0 +1,142 @@
+(import (srfi :43)) ; vector extensions
+
+; returns numbers 0 to 9 from ascii character
+(define (char->number c)
+  (- (char->integer c) 48)) ; 48 is ASCII's number zero
+
+; reads a numnber from input
+; also consumes the next non-number character in the file!
+(define (get-number file)
+  (let loop [(n 0)]
+    (let [(c (get-char file))]
+      (if (char-numeric? c)
+	[loop (+ (char->number c) (* n 10))]
+	n))))
+
+; reads pairs of coordinates
+; returns a list of the form (((x1 y1) (x2 y2))...)
+(define (read-lines file)
+  (let loop [(lines '())]
+    (if (eof-object? (peek-char file))
+      lines
+      [loop
+	(cons 
+	  (list 
+	    (list 
+	      (get-number file)  ; x1
+	      (get-number file)) ; y1
+	    (list 
+	      (begin
+		(get-char file)    ; consume -
+		(get-char file)    ; consume >
+		(get-char file)    ; consume space
+		(get-number file)) ; x2
+	      (get-number file)))  ; y2
+	  lines)])))
+
+; coordinate getters
+(define (get-x1 coords) (car (car coords)))
+(define (get-x2 coords) (car (cadr coords)))
+(define (get-y1 coords) (cadr (car coords)))
+(define (get-y2 coords) (cadr (cadr coords)))
+(define (get-max-x coords) (max (get-x1 coords) (get-x2 coords)))
+(define (get-max-y coords) (max (get-y1 coords) (get-y2 coords)))
+
+; returns the largest value obtained while applying pick to each element of lst
+(define (get-max lst pick)
+  (let loop [(m 0)
+	     (lst lst)]
+    (if (null? lst)
+      m
+      [loop
+	(max m (pick (car lst)))
+	(cdr lst)])))
+
+(define (sign value)
+  (cond
+    [(= 0 value) 0]
+    [(< 0 value) 1]
+    [else -1]))
+
+; image get/setters
+(define (make-image width height)
+  (list width
+	height
+	(make-vector (* width height) 0)))
+(define (get-width image) (car image))
+(define (get-height image) (cadr image))
+(define (get-pixels image) (caddr image))
+(define (get-offset image x y) (+ x (* y (get-width image))))
+(define (get-pixel image x y)
+  (vector-ref (get-pixels image) (get-offset image x y)))
+(define (set-pixel! image x y value)
+  (vector-set! (get-pixels image) (get-offset image x y) value))
+
+; rasterize a line from given coordinates
+(define (additively-rasterize-line! image coords allow-diagonal)
+  (let* [(x1 (get-x1 coords)) 
+	 (y1 (get-y1 coords))
+	 (x2 (get-x2 coords)) 
+	 (y2 (get-y2 coords))
+	 (dx (sign (- x2 x1)))
+	 (dy (sign (- y2 y1)))]
+    (when (or allow-diagonal
+	      (and (= dx 0) (not (= dy 0)))
+	      (and (= dy 0) (not (= dx 0))))
+      [let loop! [(x x1) (y y1)]
+	(set-pixel! image x y (+ 1 (get-pixel image x y)))
+	(unless (and (= x x2) (= y y2))
+	  [loop! (+ x dx) (+ y dy)])])))
+
+; rasterize all given lines to an image
+; each pixel represents the number of lines touching it
+; diagonals must be 45° if allowed
+(define (additively-rasterize lines allow-diagonals)
+  (let* [(width (+ 1 (get-max lines get-max-x)))
+	 (height (+ 1 (get-max lines get-max-y)))
+	 (image (make-image width height))]
+    (let loop! [(lines lines)]
+      (when (not (null? lines))
+	(additively-rasterize-line! image (car lines) allow-diagonals)
+	(loop! (cdr lines))))
+    image))
+
+; count pixels with value strictly higher than 1
+(define (count-crossings image)
+  (vector-fold
+    (lambda (index state pixel)
+      (if (> pixel 1)
+	[+ state 1]
+	state))
+    0
+    (get-pixels image)))
+
+; output ASCII pgm formatted image with max 3 shades of gray to given file
+(define (output-pgm image filename)
+  (when (file-exists? filename)
+    (delete-file filename))
+  (call-with-output-file
+    filename
+    (lambda (file)
+      (fprintf file "P2~%#~%~a ~a~%3~%"
+	       (get-width image) 
+	       (get-height image))
+      (vector-for-each
+	(lambda (index pixel)
+	  (fprintf file "~a " pixel)
+	  (when (= 0 (modulo index (get-width image)))
+	    (newline file)))
+	(get-pixels image)))))
+
+(call-with-input-file
+  "input"
+  (lambda (file)
+    (let [(lines (read-lines file))]
+      (let [(image (additively-rasterize lines #f))]
+	(output-pgm image "part1.pgm")
+	(printf "part 1:~% dangerous areas = ~a~%"
+		(count-crossings image)))
+      (let [(image (additively-rasterize lines #t))]
+	(output-pgm image "part2.pgm")
+	(printf "part 2:~% dangerous areas = ~a~%"
+		(count-crossings image))))))