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/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
+