day 9

04-giant-squid/code.scm

@@ -2,10 +2,6 @@
 
 (load "../common.scm")
 
-; returns numbers 0 to 9 from ascii character
-(define (char->number c)
-  (- (char->integer c) 48)) ; 48 is ASCII's number zero
-
 ; returns a number from two characters
 ; ex: '0' and '9' => 9
 ;     ' ' and '6' => 6

09-smoke-basin/code.scm

@@ -0,0 +1,187 @@
+(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)
+  (list x y altitude))
+(define (low-point-x lp) (car lp))
+(define (low-point-y lp) (cadr lp))
+(define (low-point-altitude lp) (caddr lp))
+
+; on a given heightmap, gives the list of points that are
+; strictly lower than their left/right/up/down neighbors
+(define (find-low-points heightmap)
+  (let [(low-points '())]
+    (vector-for-each
+      (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)))]
+	      (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))
+    low-points))
+
+; compute risk level from low point list
+(define (risk-level low-points)
+  (apply + (map 1+ (map low-point-altitude low-points))))
+
+; 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))
+	 (width-1 (- width 1))
+	 (height-1 (- height 1))
+	 (visited (make-vector (* width height) 0))]
+    (define (offset x y)
+      (+ (* y width) x))
+    (let flood-fill [(x (low-point-x low-point))
+		     (y (low-point-y low-point))]
+      (let [(ofs (offset x y))]
+	(when (= (vector-ref visited ofs) 0)
+	  (vector-set! visited ofs 1)
+	  (when (< (sample-heightmap heightmap x y) 9)
+	    (closure x y)
+	    (when (> x 0)        (flood-fill (- x 1) y))
+	    (when (< x width-1)  (flood-fill (+ x 1) y))
+	    (when (> y 0)        (flood-fill x (- y 1)))
+	    (when (< y height-1) (flood-fill x (+ y 1)))))))))
+
+; compute size of basin starting at given low point
+(define (basin-size heightmap low-point)
+  (let [(size 0)]
+    (visit-basin heightmap low-point
+		 (lambda (x y)
+		   (set! size (+ 1 size))))
+    size))
+
+; returns list of basin sizes corresponding to given low points
+(define (compute-basin-sizes heightmap low-points)
+  (map
+    (lambda (lp)
+      (basin-size heightmap lp))
+    low-points))
+
+; write a PGM file for given heightmap and low points
+; max altitude (9) is white
+; basins are red-ish (brighter the higher the point)
+; low points are bright green
+;
+; for debugging purposes
+(define (dump-heightmap heightmap low-points filename)
+  (when (file-exists? filename)
+    (delete-file filename))
+  (call-with-output-file
+    filename
+    (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))
+
+      (let* [(width (heightmap-width heightmap))
+	     (width*3 (* width 3))
+	     (height (heightmap-height heightmap))
+	     (data (make-vector (* width*3 width)))]
+
+	; from (x,y) returns of offset of pixel's red channel in data vector
+	; green and blue follow as ofs+1 and ofs+2
+	(define (offset x y)
+	  (+ (* width*3 y)
+	     (* 3 x)))
+
+	; show heightmap as gray levels
+	(let y-loop [(y 0)]
+	  (let x-loop [(x 0)]
+	    (let [(ofs (offset x y))
+		  (gray-level (* (sample-heightmap heightmap x y) 20))]
+	      ; red channel
+	      (vector-set! data ofs gray-level)
+	      ; green channel
+	      (vector-set! data (+ 1 ofs) gray-level)
+	      ; blue channel
+	      (vector-set! data (+ 2 ofs) gray-level))
+	    (when (< x (- width 1))
+	      (x-loop (+ x 1))))
+	  (when (< y (- height 1))
+	    (y-loop (+ y 1))))
+
+	; show basins as redish areas
+	; show low points as full green pixels
+	(for-each
+	  (lambda (lp)
+	    ; red channel to max on pixels of basins
+	    (visit-basin heightmap lp
+			 (lambda (x y)
+			   (let [(ofs (offset x y))]
+			     (vector-set! data ofs 255))))
+	    ; green channel to max on pixels of low point
+	    (let [(ofs (offset (low-point-x lp) (low-point-y lp)))]
+	      (vector-set! data ofs 255)
+	      (vector-set! data (+ 1 ofs) 255)
+	      (vector-set! data (+ 2 ofs) 255)))
+	  low-points)
+
+	; write pixels to file
+	(vector-for-each
+	  (lambda (index bits)
+	    (fprintf file "~a " bits)
+	    (when (= (mod index width*3) 0)
+	      fprintf file "~%"))
+	  data)))))
+
+(call-with-input-file
+  "input"
+  (lambda (file)
+    (let* [(heightmap (load-heightmap file))
+	   (low-points (find-low-points heightmap))]
+      (printf "part 1:~% Risk level: ~a~%"
+	      (risk-level low-points))
+      (let [(basin-sizes (sort > (compute-basin-sizes heightmap low-points)))]
+	(dump-heightmap heightmap low-points "heightmap.pgm")
+	(printf "part 2:~% Three largest basin sizes multiplied: ~a~%"
+		(* (car basin-sizes)
+		   (cadr basin-sizes)
+		   (caddr basin-sizes)))))))

09-smoke-basin/heightmap.pgm

@@ -0,0 +1,4 @@
+P3
+100 100
+255
+255 255 255 255 20 20 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 100 100 255 120 120 255 140 140 180 180 180 255 255 255 255 80 80 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 120 120 255 120 120 255 140 140 255 160 160 180 180 180 180 180 180 255 160 160 180 180 180 255 100 100 255 80 80 255 60 60 255 40 40 255 60 60 255 40 40 255 60 60 255 80 80 255 100 100 180 180 180 255 160 160 180 180 180 255 100 100 255 80 80 255 100 100 255 140 140 255 160 160 180 180 180 180 180 180 255 160 160 255 160 160 255 120 120 255 140 140 255 160 160 180 180 180 255 160 160 255 140 140 255 120 120 255 140 140 180 180 180 255 160 160 255 120 120 255 100 100 255 120 120 255 140 140 255 120 120 255 140 140 255 160 160 180 180 180 255 255 255 255 20 20 180 180 180 255 160 160 180 180 180 255 160 160 180 180 180 255 60 60 255 40 40 255 60 60 180 180 180 180 180 180 255 140 140 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 20 20 255 40 40 180 180 180 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 255 255 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 100 100 180 180 180 180 180 180 180 180 180 255 140 140 255 120 120 255 100 100 255 80 80 255 60 60 255 80 80 255 100 100 255 120 120 255 160 160 180 180 180 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 255 255 255 80 80 255 100 100 180 180 180 180 180 180 255 160 160 255 140 140 255 160 160 180 180 180 255 100 100 180 180 180 255 20 20 255 255 255 255 20 20 255 80 80 255 100 100 180 180 180 255 160 160 255 140 140 255 160 160 255 80 80 255 60 60 255 80 80 255 100 100 255 140 140 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 120 120 255 140 140 255 160 160 180 180 180 255 120 120 255 100 100 180 180 180 255 160 160 255 140 140 255 100 100 255 80 80 255 255 255 255 80 80 255 100 100 180 180 180 180 180 180 255 40 40 255 20 20 180 180 180 255 160 160 255 140 140 180 180 180 255 140 140 255 160 160 180 180 180 255 255 255 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 20 20 255 255 255 180 180 180 255 160 160 180 180 180 255 120 120 180 180 180 255 80 80 180 180 180 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 140 140 255 160 160 180 180 180 255 160 160 255 100 100 255 80 80 255 60 60 255 40 40 255 100 100 255 80 80 255 100 100 255 120 120 255 160 160 180 180 180 180 180 180 255 160 160 255 160 160 255 140 140 255 100 100 255 120 120 255 100 100 255 140 140 255 160 160 180 180 180 255 100 100 255 120 120 255 140 140 180 180 180 180 180 180 255 160 160 180 180 180 255 20 20 255 40 40 255 100 100 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 60 60 255 40 40 255 60 60 255 120 120 180 180 180 255 160 160 180 180 180 255 120 120 255 100 100 255 80 80 255 100 100 255 120 120 255 140 140 180 180 180 255 255 255 255 80 80 255 100 100 180 180 180 255 140 140 255 120 120 255 100 100 255 80 80 255 100 100 255 120 120 255 140 140 255 160 160 180 180 180 180 180 180 255 160 160 255 140 140 255 120 120 255 160 160 255 120 120 180 180 180 255 160 160 180 180 180 180 180 180 180 180 180 255 160 160 180 180 180 255 160 160 255 140 140 255 80 80 255 60 60 255 80 80 180 180 180 180 180 180 255 140 140 255 160 160 180 180 180 255 160 160 180 180 180 255 160 160 180 180 180 180 180 180 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 255 255 255 120 120 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 20 20 255 40 40 255 60 60 255 80 80 255 100 100 255 140 140 255 160 160 180 180 180 180 180 180 180 180 180 255 160 160 255 120 120 255 140 140 255 120 120 255 140 140 255 160 160 180 180 180 255 80 80 255 100 100 255 140 140 255 160 160 180 180 180 255 140 140 255 160 160 180 180 180 255 60 60 180 180 180 255 160 160 255 140 140 255 120 120 255 100 100 255 80 80 255 60 60 255 20 20 255 40 40 255 100 100 255 160 160 255 140 140 255 160 160 180 180 180 255 80 80 255 255 255 255 80 80 255 140 140 255 160 160 180 180 180 255 80 80 255 100 100 255 120 120 180 180 180 255 160 160 255 160 160 255 140 140 255 100 100 180 180 180 180 180 180 255 160 160 180 180 180 255 100 100 255 80 80 180 180 180 255 80 80 255 100 100 255 140 140 255 100 100 255 120 120 255 140 140 255 160 160 180 180 180 180 180 180 180 180 180 180 180 180 180 180 180 255 120 120 255 100 100 255 80 80 180 180 180 255 160 160 255 140 140 255 120 120 180 180 180 255 160 160 255 140 140 255 120 120 255 140 140 255 160 160 180 180 180 180 180 180 255 120 120 255 100 100 255 80 80 255 60 60 255 40 40 255 100 100 255 120 120 180 180 180 255 160 160 255 140 140 255 80 80 255 60 60 255 255 255 255 20 20 255 120 120 255 100 100 255 120 120 255 160 160 180 180 180 180 180 180 255 120 120 255 140 140 180 180 180 180 180 180 255 160 160 255 140 140 255 160 160 180 180 180 255 255 255 255 60 60 255 80 80 255 160 160 180 180 180 255 80 80 255 120 120 255 140 140 255 160 1Line truncated

09-smoke-basin/input

@@ -0,0 +1,100 @@
+0198765456793498765667899895432323459895457899886789876798656767890198989323997654321296543219876545
+9997654345689987654345998789591014598784345798765678965987543459921987978919876543210989694998765432
+7898543254568998875657895679989125987653236989654567934597654567899876869899989874349978989899654321
+6987654123457899986767894578978939876543125878943478945698875998954945756789999965498769876789965432
+5698743016568996799878923489467894985432014567896567896789989899893234545678999876987658765679896545
+4987652123789785656999434679379993999654623478998878998894598798789101234567893989876543434598789956
+5699543234897654348989645789234989898965434678969989999943987656578992345778932398765432125987679897
+6988994345998743219978956890199878787896545989543296987659876548467889476799321459989521019876565689
+9877789457898754398767897921986867696789659897654345699769987434345678987896430124987632129865434578
+8765678998989766987657889549875456545698998789765456798978964321234589398989945786798747634987521289
+9854989549679997896545678956984321234987987678978967987989876544345691239878896897899876545698642456
+4543479934598889987656899767993210129976876578999899976899987656457789398969797929956987656789653767
+3212567895997678998767954979876343298765465456789798765678999787578899987654689212349999787898769878
+2101489959876546789878963298765454987654332347895679954789449898678999876543578923998779898949899989
+5232398949988678996989876459876567898765101258954569875694321999989998765432389899899569999136989899
+4365457898799789345699989969987698969876232349543456987893210987796989876545456789789498798945679789
+5476567997679893234567999898998789246987453458954767898954429896565879987658767899698997587896798678
+7677878986545990123456798787899899959876576567895689989896539765434567898767878978587895456789898789
+9788989876437889235678989665943999899987689878986789876797698954323459919899989656476794347899989899
+9899898984323978956789876543892398788798799989987898765989987993212368929978597642345689256789678999
+8954767895434567899899998764791989698689898993299987654979876789423489998765459831234890135794599788
+7643456789545679965999879765699878587578987889349876543456985678934567897654345942356789236893987656
+6532345697656799974598769876789765432456976678999987432349874567895779929891259843457994347992996546
+7821234589869899865987855989899877643567894567989876545498765979999998912989398764567896598989765435
+8730123478978998999876543496921989954678923679876987656569879898998787899878989875678999679779976946
+7632564567899987989987542965430198765678934598765498897678998787999656798767678976799998789567899897
+6543456778924976878999859879641249986789745789879329998789398676789545987654567897897899895456987679
+8784569899999865969898767998752356897897659899998910989891299545678939876543598998956788994329876545
+9895989968987654856789878997543497998998769989997899878989987634589323987658789999645676789310984234
+3976797659876763645678989987654689329439878978986798767679876545678919998769897896534545698929892123
+1097895432985432134589392398998789468920989869875987654567998656789998999989946789421434567999799234
+9989976943986741014589201299769899878939997756964599543456789767899897895491234579210123479878678965
+8976899894697832123678912987654999989898976549943498956567899878989756679210345678921234899764569986
+7865788789798947234567899898543498998757997698712987897678935989875437598921234789432345679965998997
+6754567679899986349678998789312387898646789987629876999789523998765324456892345678993456798979897898
+5433226598998765498989987654101456987534990196534965699898439899854212345789456789989567987899786799
+6321012456789977697899998763212359894323491987749854989986598798767301245699987996578979876737655688
+8743233767897898986788987654923498765436789998998643878997987679873212346898998965456899965421434667
+7654344689976679765647899789899569876545678989987432367898964597654343457987999876567899876510123458
+9765656797234598754636798998768999987956989975496541456999896789876456789656890987688954987673234567
+3998789896125987653125457897657889999867899876987432346789789893987867892345691998789643498754345778
+2139899965434598761012346789547678999978999989998646456895678932198978901256789869995432569965456789
+3234999896545699832133487890134567898999989999998657567954567891019989212345678998789321279879597892
+4349989789956986543234589999295679967899878999899877679543456789424599935456799997678932389998989921
+5698878677897987654345679578989989656798767898789988796532345678935989896567989987567893456797978990
+6987664576789998768458789456679694547698756347678999976543456789549978789879879876456789567986567789
+9876573465878969877669893234569543234599743236567899987754567898698765678989965985347978979875455699
+9995432454567943988789932123678940123987652125456998798765878929987654567899854324236567899954234789
+9876210123478952399895321034789432458998761012347997659876989212398543458998743210123478999863135993
+9976323234589543456976532165896573467989872123656789745989992101987432134999656321254567899874547894
+8765434545697654569876543876997987569876543334567895434598893212976543015899766435367678998765656795
+9876549876789767699987656987898998978987654545698954323456789343988754876789899549878989439878767896
+7989689989892988789998767898989799399898875698789765454567895454599765989899998756789493323989978997
+6798798992921099899899878939976543298769989789999876565678996565999878999989659877896321012498989789
+5639897921092125998789989123987654997654599899878999776989789879897989999878943988965432133567897679
+4324956899989234989698991019999869876543467999769678997897689998786596988767892199876749545689934599
+3212345678978945976567892198989878985432355988756569898987569986653445977656792012987898767895423989
+7425656989567959865456789987678989876321234978543458789999498795341239865445689123598989888976519878
+6434567894359898764345678996567998765432349865452345678999569653210198764324579235999679999987998767
+7587678921239799843239789965456899879545698754321236789998998754421239873213467949894598992399865456
+7679989210198678954378999876567896987656799875210123898987899986532349986501678998789987789910999597
+8789894321987567896567894987689934698767891984321234987676789997653498795413789987679876669892988989
+9898765939876458789698932198794323989898932395432449896545678919764569654329899876567995458799876678
+9969879896954345698999545989899319879909543986543498765436789101975679885434998787456984345689765566
+9852998765423234767897999878958909768919655987656569896517899919876789976545689654349876456897843445
+8643489987610123456976878954347898754598996799789678987698978892987893987656789743256998667896532134
+9759579897521234567895667893236789843456789899998789998789768791298932199787895434123498778965431012
+9898998765432347688943456789045678932345689987679895989894545679379321019899987321012369899876559423
+3987679986543458799432367892127899431256799899562923976943234579459832123999876543143456998997678934
+2976565698654567896521456793298986562345898764321019895432123478998763236789988654234587896498789545
+3987434598767699987932367895459997878487989897632398789321014567987654445789799895678999989349899856
+9897523459878789299893456789568998989568976989543987676932124568998765676797658976799345678996998767
+9788412345989890198789569899878999997679895878954976545893238679109877787896547989891249899985459878
+8654301234599921987698978976989287898799754767895985437789548789298998898995435695910198999875334989
+7543212345678999876567899765690176799987643456796984325678956789987669959789324954321297899654219895
+8654323456799987987698999854321245678998321345689875434789767893299542345698919895439986798943109764
+9765436567899976598789898767433366989986210123678986546899878954998753457987998789598765987893299843
+9887567679979865429896789876549456799965321234567987897899999999898764569976787679999654576789987659
+5998789789567978539965656997698967899876432347678998999998999889789875698765436567897643235895499878
+4569899897679987698754345698987898976987543656789989789767998775678986987654323456987732146789398989
+3478910998998898987653234789996789895498654777898765678956987654589997898843212369876545256893227890
+1245699899876799999865545678965456789329769899999954599549876543459998998764101236987984345789106791
+0134987654765778998986676989894345678919879932198765988959765432467899987654323345699875656895415899
+1949896563244569987698789899789236989998989543249899767898654321348976798765634789789986767894323978
+9898765432123456976539899788678949899997897694345987658989965442459345899876545678990987898965434569
+8769876551012345895423987657569898789876898985459876545679878643769456799989876789991298929876775778
+9854998743256566789109876543469797678965789976569987635589989767978987998999997899873349212997889899
+8765987654345689899219765432398654567894678989698965323489999878989999876669998998764569109898998912
+9896798965456789978997654521449765678932567898987894313878893989999899944558999439975678998789987101
+8987899986567994567998743210139878989543458987876995305456794599878799432347994321986989987678976532
+7698999897879543456899765323234989297654569876765789212346789798765678901236789432987899878567899945
+4569998798989432345799876436545891019765798765434994323457899899654567892345678949899929765456987896
+3445989659699921234689986545656789129879899896549895935668955998743456793456789998779910979345985679
+1239876546559892345679197968987899998989998987898789896799943298654567976567999987667899898959874567
+0545989632346789467789239879999999897698997698987676789899899398765678987699898976548998787598765789
+1356797521248999578997659989901298766567799549976545689988798999989989298989767895439987656469876789
+2987985432345678989998767997892987655456678998765434679878697889996799109878658789698765432345987894
+3567976765456789998999879876789886844344567989878323598764566978945678998754345678999875321234698943
+4568987876567893867894998765498765432123479877945412459843434569236899876543234567999986410126789101
+6789998989678912356913987654329874321014698765432101568932012489345789997654123456789994323434893213

common.scm

@@ -7,3 +7,8 @@
 	[(char=? c #\,) (loop (cons n draws) 0)]
 	[(char-whitespace? c) (reverse (cons n draws))]
 	[else (loop draws (+ (* n 10) (string->number (string c))))]))))
+
+; returns numbers 0 to 9 from ascii character
+(define (char->number c)
+  (- (char->integer c) 48)) ; 48 is ASCII's number zero
+