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