AoC day 20, Smalltalk

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

Integer extend [
    bitAppend: bool [
        ^(self bitShift: 1) bitOr: bool asCBooleanValue.
    ]
]

Object subclass: Map [
    | tiles edges corners grid dim |

    Map class >> new [
        | bits val |
        Rev_map := Array new: 1023.
        (1 to: 1023) do: [ :i |
            bits := i.
            val  := 0.
            10 timesRepeat: [
                val  := val bitAppend: ((bits bitAnd: 1) ~= 0).
                bits := bits bitShift: -1.
            ].
            Rev_map at: i put: val.
        ].

        ^(super new) init.
    ]

    init [
        tiles := LookupTable new.
        edges := LookupTable new.
        ^self
    ]

    Map class >> revEdge: edge [
        ^Rev_map at: edge
    ]

    addTile: tile [
        tiles at: (tile getId) put: tile.

        tile getEdges do: [ :edgeId |
            (edges at: edgeId ifAbsentPut: [OrderedCollection new]) add: tile getId.
        ].
    ]

    getTile: tileId [ ^(tiles at: tileId) ]
    getDim          [ ^dim ]

    isInternal: edge [
        ^((edges at: edge) size = 2)
    ]

    findCorners [
        ^corners := tiles select: [ :tile |
            ((tile getEdges select: [ :e | self isInternal: e ]) size = 4).
        ]
    ]

    solveMap [
        | corner corn_edges intern rots |
        dim := tiles size sqrt asInteger.
        grid := (1 to: dim) collect: [ :i | Array new: dim ].

        corner := corners anyOne.
        corn_edges := corner getEdges.
        intern := (1 to: 4) select: [ :i | self isInternal: (corn_edges at: i) ].

        rots := ((intern at: 2) = 4) ifTrue:  [ ((intern at: 1) = 1) ifTrue: [1] ifFalse: [0] ]
                                     ifFalse: [ intern at: 2 ].

        rots timesRepeat: [ corner rotTile ].
        (grid at: 1) at: 1 put: corner.

        (2 to: dim) do: [ :x |
            | prev edgeId tile |
            prev := (grid at: 1) at: (x - 1).

            edgeId := Map revEdge: (prev getEdges at: 4).
            tile := tiles at: ((edges at: edgeId) detect: [ :t | t ~= prev getId ]).
            tile translate: edgeId to: 2.
            (grid at: 1) at: x put: tile.
        ].

        (2 to: dim) do: [ :y |
            (1 to: dim) do: [ :x |
                | prev edgeId tile |
                prev := (grid at: y - 1) at: x.
                edgeId := Map revEdge: (prev getEdges at: 3).

                tile := tiles at: ((edges at: edgeId) detect: [ :t | t ~= prev getId ]).
                tile translate: edgeId to: 1.
                (grid at: y) at: x put: tile.
            ].
        ].
    ]

    stitch [
        | mosaic my line |
        mosaic := Array new: dim * 8.
        my := 1.

        (1 to: dim) do: [ :gy |
            (1 to: 8) do: [ :y |
                line := ''.
                (1 to: dim) do: [ :gx |
                    line := (line, ((((grid at: gy) at: gx) getTile) at: y) asString).
                ].

                mosaic at: my put: line.
                my := my + 1.
            ]
        ].

        ^mosaic
    ]
]

Object subclass: Tile [
    | id edges tile |
    Tile class >> withId: idNum tile: strArray [
        ^(super new) init: idNum tile: strArray.
    ]

    init: tileNum tile: tileStr [
        | top left bot right |
        id    := tileNum.
        edges := Array new: 8.
        tile  := Array new: 8.
        top   := 0.
        left  := 0.
        bot   := 0.
        right := 0.

        (1 to: 10) do: [ :i |
            top   := top   bitAppend: (((tileStr at: 1) at: i) = $#).
            left  := left  bitAppend: (((tileStr at: 11 - i) at: 1) = $#).
            bot   := bot   bitAppend: (((tileStr at: 10) at: 11 - i) = $#).
            right := right bitAppend: (((tileStr at: i) at: 10) = $#).
        ].

        edges at: 1 put: top; at: 2 put: left; at: 3 put: bot; at: 4 put: right;
              at: 5 put: (Map revEdge: left);
              at: 6 put: (Map revEdge: top);
              at: 7 put: (Map revEdge: right);
              at: 8 put: (Map revEdge: bot).

        (2 to: 9) do: [ :i |
            tile at: (i - 1) put: ((tileStr at: i) readStream copyFrom: 1 to: 8).
        ].

        ^self
    ]

    getId       [ ^id ]
    getEdges    [ ^edges ]
    getTile     [ ^tile ]

    flipTile [
        | flip f_edges |
        flip := (1 to: 8) collect: [ :i | Array new: 8 ].

        f_edges := Array new: 8.

        (1 to: 8) do: [ :y |
            (1 to: 8) do: [ :x |
                (flip at: y) at: x put: ((tile at: x) at: y).
            ]
        ].

        (1 to: 4) do: [ :i |
            f_edges at: i put: (edges at: (i + 4)).
            f_edges at: (i + 4) put: (edges at: i).
        ].

        tile := flip.
        edges := f_edges.
    ]

    rotTile [
        | rot r_edges |
        rot := (1 to: 8) collect: [ :i | Array new: 8 ].

        r_edges := Array new: 8.

        (1 to: 8) do: [ :y |
            (1 to: 8) do: [ :x |
                (rot at: y) at: x put: ((tile at: (9 - x)) at: y).
            ]
        ].

        (1 to: 3) do: [ :i |
            r_edges at: i put: (edges at: (i + 1)).
            r_edges at: (i + 5) put: (edges at: (i + 4)).
        ].
        r_edges at: 4 put: (edges at: 1).
        r_edges at: 5 put: (edges at: 8).

        tile := rot.
        edges := r_edges.
    ]

    translate: edgeId to: side [
        | idx |
        idx := (1 to: 8) detect: [ :i | (edges at: i) = edgeId ].
        (idx > 4) ifTrue: [ self flipTile. idx := idx - 4 ].
        ((idx - side) \\ 4) timesRepeat: [ self rotTile ].
    ]
]

"
|  Mainline
"
map := Map new.

inStream := stdin lines contents readStream.
[ (line := inStream next) notNil ] whileTrue: [
    id := line substrings second asNumber.  " read header "

    inTile := OrderedCollection new.
    10 timesRepeat: [ inTile addLast: inStream next ].  " read tile "

    map addTile: (Tile withId: id tile: inTile).

    inStream next.  " skip blank line "
].

stdout nextPutAll: 'Part 1: ', (map findCorners inject: 1 into: [:a :b | a * b getId]) asString; nl.

" Put the map together "
map solveMap.

" Get the mosaic in four orientations: as made, flipped diagonally, and lines reversed "
mosaic := Array new: 4.
mosaic at: 1 put: map stitch.

dim := (map getDim * 8).

" Flip diagonally "
mosaic at: 2 put: ((1 to: dim) collect: [ :i | String new: dim ]).
(1 to: dim) do: [ :y |
    (1 to: dim) do: [ :x |
        ((mosaic at: 2) at: y) at: x put: (((mosaic at: 1) at: x) at: y).
    ].
].

" Reverse lines of the above two "
(1 to: 2) do: [ :i |
    mosaic at: (i + 2) put: ((mosaic at: i) collect: [ :line | line reverse ]).
].

"
| The four remaining orientations are vertical flips of these four, so we can use
| the middle line of the monster to judge which matches best.
"
mons_mid := '#....##....##....###' asRegex.

best_map := nil.
best_match := nil.

(1 to: 4) do: [ :map |
    mat := (2 to: dim - 1) select: [:i | (((mosaic at: map) at: i) =~ mons_mid) matched].
    (mat size > best_match size) ifTrue: [
        best_match := mat.
        best_map := mosaic at: map.
    ].
].

" Scan map for monsters both up-side-up and up-side-down "
up_count := 0.
down_count := 0.

best_match do: [ :i |
    stream := (best_map at: i) readStream.
    pos := 0.
    [ (mat := (stream upToEnd =~ mons_mid)) matched ] whileTrue: [
        pos := pos + mat from.

        (((best_map at: i - 1) at: pos + 18) = $#) ifTrue: [
            below := (best_map at: i + 1) copyFrom: pos to: pos + 16.
            ((below =~ '^.#..#..#..#..#..#') matched) ifTrue: [
                up_count := up_count + 1.
            ].
        ].

        (((best_map at: i + 1) at: pos + 18) = $#) ifTrue: [
            above:= (best_map at: i - 1) copyFrom: pos to: pos + 16.
            ((above =~ '^.#..#..#..#..#..#') matched) ifTrue: [
                down_count := down_count + 1.
            ].
        ].

        stream position: pos.
    ].
].

" Count waves in stitched image "
waves := (best_map collect: [ :line | (line select: [ :c | c = $# ]) size ])
                inject: 0 into: [ :a :b | a + b ].

stdout nextPutAll: 'Part 2: ', (waves - ((up_count max: down_count) * 15)) asString; nl.