Ben / Nujel

#!/usr/bin/env nujel

[defun fold/load [filename]
       [def points #nil]
       [def γ [reduce [split [file/read filename] "\n"]
                       [\ [α β]
                         [cond [[zero? [string/length β]] α]
                               [[== [char-at β 0] #\f]
                                [tree/set! α :folds [cons [split [caddr [split β " "]] "="] [α :folds]]]]
                               [#t [def τ [map [split β ","] read/single]]
                                   [set! points [cons τ points]]
                                   [tree/set! α :width  [max [α  :width] [+ 1 [car τ]]]]
                                   [tree/set! α :height [max [α :height] [+ 1 [cadr τ]]]]]]]
                      @[:width 0 :height 0 :folds #nil]]]
       [tree/set! γ :data [-> [array/allocate [* [γ :width] [γ :height]]] [array/fill! 0]]]
       [while points
              [array/set! [γ :data] [+ [caar points] [* [γ :width] [cadar points]]] 1]
              [cdr! points]]
       [tree/set! γ :folds [reverse [γ :folds]]]]

[defun fold-y [data y]
       [def ret [array/2d/allocate [data :width] [/ [data :height] 2]]]
       [def dh [data :height]]
       [def rw [ret :width]]
       [def rh [ret :height]]

       [for [y 0 rh]
       [for [x 0 rw]
            [array/2d/set! ret x y [+ [array/2d/ref data x y]
                                      [array/2d/ref data x [- dh y 1]]]]]]
       [tree/set! ret :folds [cdr [data :folds]]]]

[defun fold-x [data y]
       [def ret [array/2d/allocate [/ [data :width] 2] [data :height]]]
       [def dw [data :width]]
       [def rw [ret :width]]
       [def rh [ret :height]]

       [for [y 0 rh]
       [for [x 0 rw]
            [array/2d/set! ret x y [+ [array/2d/ref data x y]
                                      [array/2d/ref data [- dw x 1] y]]]]]
       [tree/set! ret :folds [cdr [data :folds]]]]

[defun do-fold [α]
       [if [== [caar [α :folds]] "x"]
           [fold-x α [cadr [α :folds]]]
           [fold-y α [cadr [α :folds]]]]]

[defun do-all-folds [α]
       [while [α :folds]
              [set! α [do-fold α]]]
       α]

[defun dot-count [α]
       [def β [α :data]]
       [def len [array/length β]]
       [def ret 0]
       [for [i 0 len]
            [when [> [β i] 0] [++ ret]]]
       ret]

[defun print-folded [α]
       [for [y 0 [α :height]]
       [for [x 0 [α :width]]
            [if [zero? [array/2d/ref α x y]]
                [display "."]
                [display "#"]]
       ][newline]]]
[def res-p1 [dot-count [do-fold [fold/load "tests/slow/day13.input"]]]]
[def final-map [do-all-folds [fold/load "tests/slow/day13.input"]]]
[def res-p2 [dot-count final-map]]

[when [!= res-p1 842]
      [throw [list :wrong-result "Wrong result" res-p1]]]
[when [!= res-p2 95]
      [throw [list :wrong-result "Wrong result" res-p2]]]