factorized heightmap code into matrix code, and using records now

This commit is contained in:
2021-12-11 10:30:24 +01:00
parent 3df3a70754
commit a1266ca648
2 changed files with 40 additions and 47 deletions

View File

@@ -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))

View File

@@ -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))])))))