AoC 2024, day 15, part 2 (smalltalk)

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

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

" Class to hold results of vertical push tests "
Object subclass: VerticalPushResults [
    | can boxes |
    VerticalPushResults class >> new  [^super new init]
    init  [can := true. boxes := Set new. ^self]

    addBox: box     [^boxes add: box]
    boxes           [^boxes]

    goodLeaf: bool  [^can := can & bool]
    canPush         [^can]
]

Object subclass: DoubleWideTextGrid [
    | grid dim robot |

    dirs := Dictionary from: {$< -> (-1@0). $^ -> (0@-1). $v -> (0@1). $> -> (1@0)}.

    DoubleWideTextGrid class >> new: mapArray [^super new init: mapArray]
    init: mapArray [
        " No sentinel needed, has boundary wall."
        dim  := (2 * mapArray first size) @ (mapArray size).
        grid := (mapArray join asArray gather: [:chr |
                    (chr == $O) ifTrue: [#($[ $])] ifFalse: [{chr. chr}]
                ]) asString.

        robot := grid indexOfSubCollection: '@@'.
        grid replaceFrom: robot to: robot + 1 with: '..'.
        robot := self toCoord: robot.
        ^self
    ]

    " Access to grid via Points "
    at: pt            [^grid at: (pt y * dim x) + pt x + 1]
    at: pt put: chr   [^grid at: (pt y * dim x) + pt x + 1 put: chr]
    toCoord: idx      [^(idx - 1 \\ dim x) @ (idx - 1 // dim x)]
    toIndex: pt       [^(pt y * dim x) + pt x + 1]

    " Basic access "
    dirs        [^dirs]
    dim         [^dim]
    robot       [^robot]
    robot: pt   [^robot := pt]

    " Return array of Points where aBlock on that character returns true "
    selectPoints: aBlock [
        | res |
        res := OrderedCollection new.
        grid keysAndValuesDo: [:idx :chr |
            (aBlock value: chr) ifTrue: [res add: (self toCoord: idx)].
        ].
        ^res
    ]

    " Recursive function for vertial push test "
    recursePos: boxLeft dir: dir result: res [
        | ahead |
        res addBox: boxLeft.
        ahead := {dir. dir + (dirs at: $>)} collect: [:d | self at: (boxLeft + d)].

        " Leaf checks... all empty is good, any wall is bad "
        (ahead conform:  [:chr | chr == $.]) ifTrue: [^res goodLeaf: true;  yourself].
        (ahead contains: [:chr | chr == $#]) ifTrue: [^res goodLeaf: false; yourself].

        " More multipushing to test: "
        ((ahead at: 1) == $[) ifTrue: [
            " Straight ahead is [], a single box "
            self recursePos: boxLeft + dir dir: dir result: res.

        ] ifFalse: [
            " A box to left of right, maybe both "
            ((ahead at: 1) == $]) ifTrue: [self recursePos: boxLeft + dir + (dirs at: $<) dir: dir result: res].
            ((ahead at: 2) == $[) ifTrue: [self recursePos: boxLeft + dir + (dirs at: $>) dir: dir result: res].
        ].
        ^res
    ]

    " Test vertical push, returns VerticalPushResults "
    testVertical: pos dir: dir [
        | res boxLeft |
        res     := VerticalPushResults new.
        boxLeft := ((self at: pos) == $[) ifTrue: [pos] ifFalse: [pos + (dirs at: $<)].

        ^self recursePos: boxLeft dir: dir result: res
    ]

    " Print grid on stream "
    printOn: aStream [
        | robotIdx |
        robotIdx := self toIndex: robot.
        grid keysAndValuesDo: [:idx :chr |
            aStream nextPut: (idx == robotIdx ifTrue: [$@] ifFalse: [chr]).
            (idx \\ dim x = 0) ifTrue: [aStream nl].
        ]
    ]
]

"
| Mainline
"
sections := (stdin contents tokenize: '\n\n') collect: #lines.

grid := DoubleWideTextGrid new: sections first.

sections second join do: [ :dchr |
    dir  := grid dirs at: dchr.
    move := grid robot + dir.
    targ := grid at: move.

    (targ == $.) | (targ == $#) ifTrue: [
        " Move or bump wall "
        (targ == $.) ifTrue: [grid robot: move]
    ] ifFalse: [
        (dchr == $<) | (dchr == $>) ifTrue: [
            " Horizonal push "
            end := move.
            [((grid at: end) == $[) | ((grid at: end) == $])] whileTrue: [end := end + dir].

            ((grid at: end) == $.) ifTrue: [
                " Toggle [ and ] along the push chain: "
                p := move.
                [p ~= end] whileTrue: [
                    grid at: p put: (((grid at: p) == $[) ifTrue: [$]] ifFalse: [$[]).
                    p := p + dir.
                ].

                " Fix ends and move "
                grid at: end  put: (grid at: move).
                grid at: move put: $..
                grid robot: move.
            ]

        ] ifFalse: [
            " Vertical push "
            results := grid testVertical: move dir: dir.

            results canPush ifTrue: [
                " Clear grid of old positions: "
                results boxes do: [:box |
                    grid at: box put: $..
                    grid at: box + (grid dirs at: $>) put: $..
                ].

                " Set new positions: "
                results boxes do: [:box |
                    newPos := box + dir.
                    grid at: newPos put: $[.
                    grid at: newPos + (grid dirs at: $>) put: $].
                ].
                grid robot: move.
            ]
        ]
    ]
].

grid displayNl.
part2 := (grid selectPoints: [:chr | chr == $[]) inject: 0 into: [:a :b| a + (100 * b y) + b x].
('Part 2: %1' % {part2}) displayNl.