AoC 2024 day 21 (smalltalk)

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

Character  extend  [ , chr  [^self asString, chr asString] ]
Collection extend  [
    sum    [^self inject: 0 into: [:a :b | a + b]]
    min    [^self inject: SmallInteger largest into: [:a :b | a min: b]]
]

SequenceableCollection extend [
    " Returns collection of results from calling binBlock for each link pair "
    chain: binBlock [
        | res |
        res := self copyEmptyForCollect.
        self fold: [:curr :next | res add: (binBlock value: curr value: next). next].
        ^res
    ]
]

" Class to hold details of a keypad. "
Object subclass: Keypad [
    | keyLoc dim paths grid |
    dirs := Dictionary from: {'^' -> (0@-1). '<' -> (-1@0). '>' -> (1@0). 'v' -> (0@1)}.

    Keypad class >> new: textLines  [^super new init: textLines]
    init: textLines [
        | sent delta steps queue state move |
        " Build grid with sentinel Xs "
        dim  := (textLines first size + 2) @ (textLines size + 2).
        sent := $X * dim x.
        grid := sent, (textLines collect: [:line | 'X',line,'X']) join, sent.

        " Find location of all keys "
        keyLoc := Dictionary new.
        grid keysAndValuesDo: [:idx :chr |
            (chr ~= $X) ifTrue: [keyLoc at: chr put: (self toCoord: idx)]
        ].

        " Find paths between all pairs of keys "
        paths := Dictionary new.
        keyLoc keysAndValuesDo: [:ikey :iloc |
            keyLoc keysAndValuesDo: [:jkey :jloc |
                (ikey = jkey) ifTrue: [
                    paths at: (ikey,jkey) put: {'A'}.
                ] ifFalse: [
                    " Only head towards key, no expensive looping: "
                    delta := jloc - iloc.
                    steps := Set from: {(delta x < 0) ifTrue: ['<'] ifFalse: ['>'].
                                        (delta y < 0) ifTrue: ['^'] ifFalse: ['v']}.

                    " BFS routes from start (iloc) to end (jloc): "
                    queue := OrderedCollection from: {{iloc. ''}}.
                    [queue notEmpty] whileTrue: [
                        state := queue removeFirst.  " first: pos; second: path string "

                        (state first = jloc) ifTrue: [
                            (paths at: (ikey,jkey) ifAbsentPut: [OrderedCollection new])
                                   add: (state second, 'A').
                        ] ifFalse: [
                            steps do: [:dstr |
                                move := state first + (dirs at: dstr).
                                ((self at: move) ~= $X) ifTrue: [
                                    queue add: {move. state second,dstr}.
                                ]
                            ]
                        ]
                    ]
                ]
            ]
        ].
        ^self
    ]

    at: pt           [^grid at: (pt y * dim x) + pt x + 1]
    toCoord: idx     [^(idx - 1 \\ dim x) @ (idx - 1 // dim x)]

    " Return list of paths between two keys: "
    paths: toFrom    [^paths at: toFrom]
]

" Class to represent relay of robots using Keypads. "
Object subclass: RobotRelay [
    | robots memo |
    keypad := Keypad new: #('789'
                            '456'
                            '123'
                            'X0A').

    dirpad := Keypad new: #('X^A'
                            '<v>').

    RobotRelay class >> new: num  [^super new init: num]
    init: num  [robots := num. memo := Dictionary new. ^self]

    " Internal recursive method.  For a given sequence and depth, returns minimum length. "
    recurseSequence: seq depth: depth [
        | pad paths |

        ^memo at: (seq->depth) ifAbsentPut: [
            pad := (depth == 0) ifTrue: [keypad] ifFalse: [dirpad].

            " Always start (and end) at $A so append it for first. "
            (($A,seq) asOrderedCollection chain: [:start :end |
                paths := pad paths: (start,end).

                (depth == robots) ifTrue: [
                    paths first size  " all paths same size, no chance of variance at bottom "
                ] ifFalse: [
                    (paths collect: [:subseq | self recurseSequence: subseq depth: depth+1]) min
                ]
            ]) sum.
        ]
    ]

    " Call this to start recursion: "
    getSequenceLen: seq [^self recurseSequence: seq depth: 0]
]

"
| Mainline
"
input := stdin lines contents.

{1 -> 2. 2 -> 25} do: [:test |
    relay := RobotRelay new: test value.
    part  := (input collect: [:seq | (relay getSequenceLen: seq) * seq asNumber]) sum.
    ('Part %1: %2' % {test key. part}) displayNl.
]