AoC 2021 day 15 (smalltalk-heap/flat)

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

Integer extend [
    " Does number % N, but returns residue on interval of 1 to N, not 0 to N-1. "
    %% modulus [ ^self - 1 \\ modulus + 1 ]
]

" Heap class to implement priority queue "
Object subclass: Heap [
    | arr end |
    Heap class >> new: size [
        ^super new init: size
    ]

    init: size [
        arr := Array new: size.
        end := 0.
        ^self
    ]

    heapify: idx [
        | left right smallest |
        left  := 2 * idx.
        right := 2 * idx + 1.

        smallest := idx.

        ((left <= end) and: [(arr at: idx) > (arr at: left)]) ifTrue: [
            smallest := left
        ].

        ((right <= end) and: [(arr at: smallest) > (arr at: right)]) ifTrue: [
            smallest := right
        ].

        (smallest ~= idx) ifTrue: [
            arr swap: idx with: smallest.
            self heapify: smallest.
        ]
    ]

    insert: item [
        | i parent |
        end := end + 1.
        (end > arr size) ifTrue: [
            stderr nextPutAll: ('Heap size (%1) exceeded!' % {arr size}); nl.
            Error signal.
        ].

        arr at: end put: item.

        i := end.
        [(i ~= 1) and: [(arr at: (parent := i // 2)) > (arr at: i)]] whileTrue: [
            arr swap: i with: parent.
            i := parent.
        ].
        ^item
    ]

    next [
        | top |
        (end = 0) ifTrue: [ ^nil ].

        top := arr at: 1.
        end := end - 1.

        (end > 1) ifTrue: [
            arr at: 1 put: (arr at: end + 1).
            self heapify: 1.
        ].
        ^top
    ]
]

"
| PriorityQueue implementation using Heap
"
Object subclass: PriorityItem [
    | priority data |

    PriorityItem class >> new: pri data: anArray [ ^super new init: pri data: anArray ]
    init: pri data: array [ priority := pri. data := array. ^self ]

    > state   [ ^self priority > state priority ]
    priority  [ ^priority ]
    data      [ ^data     ]
]

Object subclass: PriorityQueue [
    | heap |
    PriorityQueue class >> new [ ^super new init ]
    init  [ heap := Heap new: 10000. ^self ]

    at: pri insert: data  [ heap insert: (PriorityItem new: pri data: data) ]

    next  [ ^heap next data ]
]

"
|  Class to handle the 2D Grid
"
Object subclass: DigitGrid [
    | grid xsize xwidth ysize dirs end visit |

    DigitGrid class >> new: arrayStrings [
        ^(super new) init: arrayStrings.
    ]

    init: mapArray [
        | inx iny |
        inx := (mapArray at: 1) size.
        iny := mapArray size.

        xsize := inx * 5.
        ysize := iny * 5.

        xwidth := xsize + 1.
        dirs   := { 1. xwidth. -1. -1 * xwidth }.
        end    := ysize * (xsize + 1) - 1.

        grid := Array new: end.

        (1 to: (mapArray at: 1) size) do: [ :y |
            (1 to: mapArray size) do: [ :x |
                self atPoint: (x@y) put: ((mapArray at: y) at: x) digitValue.
            ]
        ].

        (0 to: 4) do: [ :cy |
            (0 to: 4) do: [ :cx |
                ((cy ~= 0) | (cx ~= 0)) ifTrue: [
                    | inc |
                    inc := cy + cx.
                    (1 to: iny) do: [ :y |
                        (1 to: inx) do: [ :x |
                            self atPoint: ((inx * cx + x) @ (iny * cy + y))
                                 put: (self atPoint: (x@y)) + inc %% 9.
                        ]
                    ]
                ]
            ]
        ].

        visit := Array new: grid size withAll: SmallInteger largest.
        ^self
    ]

    " Access to grid by Points "
    atPoint: pt put: val  [ ^grid at: ((pt y - 1) * xwidth + pt x) put: val ]
    atPoint: pt           [ ^grid at: ((pt y - 1) * xwidth + pt x)          ]

    " Access to grid by index to flat array "
    at: idx   [ ^grid at: idx ]

    visited: idx         [ ^visit at: idx ]
    visit: idx at: risk  [ ^visit at: idx put: risk ]

    xsize     [ ^xsize ]
    ysize     [ ^ysize ]
    endIndex  [ ^end   ]

    " Get coordinates of neighbours "
    neighbours: idx [
        ^(dirs collect: [:d | idx + d ]) select: [:n |
            (n between: 1 and: end) and: [n \\ xwidth ~= 0]
        ]
    ]
]

"
| Mainline
"
Eval [
    grid := DigitGrid new: (stdin lines contents).
    end  := grid endIndex.

    queue := PriorityQueue new.
    queue at: 0 insert: {0. 1}.

    time := 0.

    [ (state := queue next) notNil ] whileTrue: [
        | pos risk |
        risk  := state first.
        pos   := state second.

        ((time := time + 1) \\ 50000 == 1) ifTrue: [
            stderr nextPutAll: ('Risk: %1' % {risk}); cr; flush.
        ].

        (pos = end) ifTrue: [
            ^('Part 2: %1' % {risk}) displayNl.
        ].

        ((grid visited: pos) > risk) ifTrue: [
            grid visit: pos at: risk.

            (grid neighbours: pos) do: [ :move |
                | new_risk |
                new_risk := risk + (grid at: move).
                queue at: new_risk insert: {new_risk. move}.
            ]
        ]
    ]
]