AoC 2023 day 16 (Smalltalk)

#!/usr/local/bin/gst -q

Symbol extend [ value: arg  [^arg perform: self] ]

Integer extend [
    bitCount [
        | bits num |
        num := self. bits := 0.
        [num ~= 0] whileTrue: [num := num bitAnd: (num - 1).  bits := bits + 1].
        ^bits
    ]
]

Object subclass: BitMap [
    | array loops |
    BitMap class >> new: rows [
        ^super new init: rows
    ]

    init: rows [
        array := Array new: rows withAll: 0.
        loops := Set new.
        ^self
    ]

    at: row     [ ^array at: row ]

    set: pt     [ ^array at: pt y put: ((array at: pt y) bitOr: (1 bitShift: pt x)) ]
    isSet: pt   [ ^((array at: pt y) bitAnd: (1 bitShift: pt x) ~= 0) ]

    bitCount    [ ^array inject: 0 into: [:a :b | a + b bitCount] ]
    bitOr: map  [
        (1 to: array size) do: [ :i |
            array at: i put: ((array at: i) bitOr: (map at: i)).
        ].
        loops addAll: map loops.
    ]

    addLoop: keyString     [ ^loops add: keyString ]
    removeLoop: keyString  [ ^loops remove: keyString ]

    loops              [ ^loops ]
    clearLoops         [ ^loops empty ]
]

Object subclass: MirrorGrid [
    | grid dim memo visit |

    dirs := { (0 @ 1). (1 @ 0). (0 @ -1). (-1 @ 0) }.       " SENW "
    piece := Dictionary from: {
                 $| -> #(   #(1) #(1 3)   #(3) #(1 3) ).
                 $- -> #( #(2 4)   #(2) #(2 4)   #(4) ).

                 $\ -> #( #(2) #(1) #(4) #(3) ).
                 $/ -> #( #(4) #(3) #(2) #(1) ).

                 $. -> #( #(1) #(2) #(3) #(4) ).
                 $~ -> #( #() #() #() #() )
             }.

    MirrorGrid class >> new: mapArray [
        ^super new init: mapArray
    ]

    init: mapArray [
        | sent |
        dim   := mapArray size + 2.     " ASSUME: grid is square "
        sent  := (1 to: dim) inject: '' into: [:a :b | a, '~'].
        grid  := sent, (mapArray collect: [:row | '~', row, '~']) join, sent.
        memo  := Dictionary new.
        ^self
    ]

    " Access to grid via Points "
    at: pt           [^grid at: (pt y * dim) + pt x + 1]
    at: pt put: chr  [^grid at: (pt y * dim) + pt x + 1 put: chr]

    size  [ ^dim - 2 ]

    recurseAt: pos movingDir: d [
        | key map chr dir |
        chr := self at: pos.
        dir := d.

        (chr = $|) & (dir = 4) ifTrue: [ dir := 2 ].
        (chr = $-) & (dir = 3) ifTrue: [ dir := 1 ].

        key := pos displayString, ':', dir asString.
        (memo includesKey: key) ifTrue: [
            (memo at: key) loops do: [ :l |
                (memo includesKey: l) ifTrue: [
                    (memo at: key) bitOr: (memo at: l).
                    (memo at: key) removeLoop: l.
                ]
            ].
            ^memo at: key
        ].

        map := BitMap new: dim.

        (chr = $~) ifTrue: [^map].
        map set: pos.
        (visit includesKey: key) ifTrue: [
            map addLoop: key.
            ^map
        ].
        visit at: key put: 1.

        ((piece at: chr) at: dir) do: [:move |
            map bitOr: (self recurseAt: pos + (dirs at: move) movingDir: move).
        ].

        memo at: key put: ((memo at: key ifAbsent: [map]) bitOr: map).
        ^map
    ]

    fireFrom: pos dir: dir [
        visit := Dictionary new.
        ^self recurseAt: pos movingDir: dir.
    ]
]

"
| Mainline
"
ObjectMemory spaceGrowRate: 500.0.

grid := MirrorGrid new: stdin lines contents.
map := grid fireFrom: (1 @ 1) dir: 2.
part1 := map bitCount.
stdout nextPutAll: ('Part 1: %1' % {part1}); nl; flush.

part2 := part1.
(1 to: grid size) do: [ :i |
    stderr nextPutAll: ('Pos: %1' % {i}); cr; flush.
    part2 := part2 max: (grid fireFrom: (i @ 1)         dir: 1) bitCount.
    part2 := part2 max: (grid fireFrom: (1 @ i)         dir: 2) bitCount.
    part2 := part2 max: (grid fireFrom: (i @ grid size) dir: 3) bitCount.
    part2 := part2 max: (grid fireFrom: (grid size @ i) dir: 4) bitCount.
].

('Part 2: %1' % {part2}) displayNl.