factorized heightmap code into matrix code, and using records now
This commit is contained in:
@@ -1,39 +1,6 @@
|
||||
(import (srfi :43)) ; vector extensions
|
||||
(load "../common.scm")
|
||||
|
||||
; constructor of heightmap object
|
||||
; from a vector of vector of altitudes
|
||||
(define (make-heightmap data)
|
||||
(list
|
||||
(vector-length (vector-ref data 0)) ; width
|
||||
(vector-length data) ; height
|
||||
data))
|
||||
|
||||
; heightmap object getters
|
||||
(define (heightmap-width heightmap) (car heightmap))
|
||||
(define (heightmap-height heightmap) (cadr heightmap))
|
||||
(define (heightmap-data heightmap) (caddr heightmap))
|
||||
(define (sample-heightmap heightmap x y)
|
||||
(if (or (< x 0)
|
||||
(< y 0)
|
||||
(>= x (heightmap-width heightmap))
|
||||
(>= y (heightmap-height heightmap)))
|
||||
9
|
||||
(vector-ref (vector-ref (heightmap-data heightmap) y) x)))
|
||||
|
||||
; parse altitude data from file and return an heightmap object
|
||||
(define (load-heightmap file)
|
||||
(let y-loop [(heightmap '())]
|
||||
(let x-loop [(line '())]
|
||||
(let [(c (get-char file))]
|
||||
(cond
|
||||
[(eof-object? c)
|
||||
(make-heightmap (reverse-list->vector heightmap))]
|
||||
[(char-whitespace? c)
|
||||
(y-loop (cons (reverse-list->vector line) heightmap))]
|
||||
[(char-numeric? c)
|
||||
(x-loop (cons (char->number c) line))])))))
|
||||
|
||||
; constructor of low point objects
|
||||
; from their position and altitude
|
||||
(define (make-low-point x y altitude)
|
||||
@@ -50,17 +17,17 @@
|
||||
(lambda (y line)
|
||||
(vector-for-each
|
||||
(lambda (x altitude)
|
||||
(let [(left (sample-heightmap heightmap (- x 1) y))
|
||||
(right (sample-heightmap heightmap (+ x 1) y))
|
||||
(up (sample-heightmap heightmap x (- y 1)))
|
||||
(down (sample-heightmap heightmap x (+ y 1)))]
|
||||
(let [(left (matrix-get heightmap (- x 1) y))
|
||||
(right (matrix-get heightmap (+ x 1) y))
|
||||
(up (matrix-get heightmap x (- y 1)))
|
||||
(down (matrix-get heightmap x (+ y 1)))]
|
||||
(when (and (< altitude left)
|
||||
(< altitude right)
|
||||
(< altitude up)
|
||||
(< altitude down))
|
||||
(set! low-points (cons (make-low-point x y altitude) low-points)))))
|
||||
line))
|
||||
(heightmap-data heightmap))
|
||||
(matrix-data heightmap))
|
||||
low-points))
|
||||
|
||||
; compute risk level from low point list
|
||||
@@ -70,8 +37,8 @@
|
||||
; starting with from a given low-point
|
||||
; call closure with and all points of the corresponding basin
|
||||
(define (visit-basin heightmap low-point closure)
|
||||
(let* [(width (heightmap-width heightmap))
|
||||
(height (heightmap-height heightmap))
|
||||
(let* [(width (matrix-width heightmap))
|
||||
(height (matrix-height heightmap))
|
||||
(width-1 (- width 1))
|
||||
(height-1 (- height 1))
|
||||
(visited (make-vector (* width height) 0))]
|
||||
@@ -82,7 +49,7 @@
|
||||
(let [(ofs (offset x y))]
|
||||
(when (= (vector-ref visited ofs) 0)
|
||||
(vector-set! visited ofs 1)
|
||||
(when (< (sample-heightmap heightmap x y) 9)
|
||||
(when (< (matrix-get heightmap x y) 9)
|
||||
(closure x y)
|
||||
(when (> x 0) (flood-fill (- x 1) y))
|
||||
(when (< x width-1) (flood-fill (+ x 1) y))
|
||||
@@ -118,12 +85,12 @@
|
||||
(lambda (file)
|
||||
; write header to file: "P3" followed by width, height and max value of channel
|
||||
(fprintf file "P3~%~a ~a~%255~%"
|
||||
(heightmap-width heightmap)
|
||||
(heightmap-height heightmap))
|
||||
(matrix-width heightmap)
|
||||
(matrix-height heightmap))
|
||||
|
||||
(let* [(width (heightmap-width heightmap))
|
||||
(let* [(width (matrix-width heightmap))
|
||||
(width*3 (* width 3))
|
||||
(height (heightmap-height heightmap))
|
||||
(height (matrix-height heightmap))
|
||||
(data (make-vector (* width*3 width)))]
|
||||
|
||||
; from (x,y) returns of offset of pixel's red channel in data vector
|
||||
@@ -136,7 +103,7 @@
|
||||
(let y-loop [(y 0)]
|
||||
(let x-loop [(x 0)]
|
||||
(let [(ofs (offset x y))
|
||||
(gray-level (* (sample-heightmap heightmap x y) 20))]
|
||||
(gray-level (* (matrix-get heightmap x y) 20))]
|
||||
; red channel
|
||||
(vector-set! data ofs gray-level)
|
||||
; green channel
|
||||
@@ -173,7 +140,7 @@
|
||||
(call-with-input-file
|
||||
"input"
|
||||
(lambda (file)
|
||||
(let* [(heightmap (load-heightmap file))
|
||||
(let* [(heightmap (load-matrix file))
|
||||
(low-points (find-low-points heightmap))]
|
||||
(printf "part 1:~% Risk level: ~a~%"
|
||||
(risk-level low-points))
|
||||
|
||||
26
common.scm
26
common.scm
@@ -12,3 +12,29 @@
|
||||
(define (char->number c)
|
||||
(- (char->integer c) 48)) ; 48 is ASCII's number zero
|
||||
|
||||
(define-record-type matrix (fields width height data))
|
||||
(define (matrix-get matrix x y)
|
||||
(if (or (< x 0)
|
||||
(< y 0)
|
||||
(>= x (matrix-width matrix))
|
||||
(>= y (matrix-height matrix)))
|
||||
9
|
||||
(vector-ref (vector-ref (matrix-data matrix) y) x)))
|
||||
(define (matrix-from-data data)
|
||||
(make-matrix
|
||||
(vector-length (vector-ref data 0))
|
||||
(vector-length data)
|
||||
data))
|
||||
|
||||
; parse 0-9 numerical data from file and return a matrix
|
||||
(define (load-matrix file)
|
||||
(let y-loop [(heightmap '())]
|
||||
(let x-loop [(line '())]
|
||||
(let [(c (get-char file))]
|
||||
(cond
|
||||
[(eof-object? c)
|
||||
(matrix-from-data (reverse-list->vector heightmap))]
|
||||
[(char-whitespace? c)
|
||||
(y-loop (cons (reverse-list->vector line) heightmap))]
|
||||
[(char-numeric? c)
|
||||
(x-loop (cons (char->number c) line))])))))
|
||||
|
||||
Reference in New Issue
Block a user