Ben / Nujel

#!/usr/bin/env nujel

[def lines [split [file/read "tests/fast/day8.dat"] "\n"]]
[def counts [-> [array/allocate 10] [array/fill! 0]]]

[defn output/count [entry]
       [def len [string/length entry]]
       [case len
             [2 [array/++ counts 1]]
             [3 [array/++ counts 7]]
             [4 [array/++ counts 4]]
             [7 [array/++ counts 8]]
             [otherwise #f]]]

[defn find/by-length [vals arr len pos]
       [if-not vals #nil
               [if [== len [popcount [car vals]]]
                   [do [array/set! arr pos [car vals]]
                       [find/by-length [cdr vals] arr len pos]]
                   [cons [car vals]
                         [find/by-length [cdr vals] arr len pos]]]]]

[defn find/six [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 6]]]
                [filter [fn [α] [== [popcount [logand α [array/ref numbers 1]]] 1]]]
       ]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 6 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn find/five [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 5]]]
                [filter [fn [α] [== α [logand α [array/ref numbers 6]]]]]]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 5 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn find/nine [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 6]]]
                [filter [fn [α] [== α [logior α [array/ref numbers 4]]]]]]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 9 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn find/zero [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 6]]]]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 0 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn find/three [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 5]]]
                [filter [fn [α] [== α [logior α [array/ref numbers 1]]]]]]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 3 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn find/two [vals numbers]
       [def ret [-> vals
                [filter [fn [α] [== [popcount α] 5]]]
                [filter [fn [α] [!= α [logior α [array/ref numbers 1]]]]]]]
       [when [> [length ret] 1] [stacktrace]]
       [array/set! numbers 2 [car ret]]
       [filter vals [fn [α] [!= α [car ret]]]]]

[defn seven-seg->binary [str]
       [reduce [split str ""]
               [fn [α β] [logior α [case β ["a" #x01]
                                          ["b" #x02]
                                          ["c" #x04]
                                          ["d" #x08]
                                          ["e" #x10]
                                          ["f" #x20]
                                          ["g" #x40]]]] 0]]

[defn translate [vals out-vals]
       [def numbers [-> [array/allocate 10]
                        [array/fill! #nil]]]

       [-> [map vals seven-seg->binary]
           [find/by-length numbers 2 1]
           [find/by-length numbers 3 7]
           [find/by-length numbers 4 4]
           [find/by-length numbers 7 8]
           [find/six numbers]
           [find/five numbers]
           [find/nine numbers]
           [find/zero numbers]
           [find/three numbers]
           [find/two numbers]]

       [defn translate/val [val i]
              [when-not i [def i 0]]
              [when [> i 10] [throw [list :error ""]]]
              [if [== [array/ref numbers i] val]
                  i
                  [translate/val val [+ 1 i]]]]
       [reduce [map [map out-vals seven-seg->binary] translate/val] [fn [α β] [+ [* α 10] β]] 0]]

[def part-2 [reduce lines [fn [Σ line]
          [def split-args [split line "|"]]
          [def output-raw [map [read [cadr split-args]] string]]
          [for-each output-raw output/count]
          [def table-raw [map [read [car split-args]] string]]
          [def output-sum [translate table-raw output-raw]]
          [+ Σ output-sum]] 0]]

[def result [sum counts]]
[when [!= result 532]
      [throw [list :wrong-result "Wrong result" result]]]
[def result part-2]
[when [!= result 1011284]
      [throw [list :wrong-result "Wrong result" result]]]