A solution to challenge #20 of Advent of Code's 2020 edition

aoc-2020-20.rkt

#lang racket

; SOLUTION TO CHALLENGE #20 OF ADVENT OF CODE'S 2020 EDITION
;
; https://adventofcode.com/2020/day/20

(define (main (filename "sample"))
  (define tiles (read-tiles filename))
  (define part-1 (apply * (corner-tiles tiles)))
  (define part-2 (sea-roughness (tiles->string tiles)))
  (list part-1 part-2))

;
; PARSING
;

; Parse the puzzle input into a dict of <tile id> -> <tile rows>.
(define (read-tiles (filename "sample"))
  (define (parse-tile str)
    (string->number (car (regexp-match #px"\\d+" str))))
  (call-with-input-file
    filename
    (λ (in)
       (for/hash ((tile-string (string-split (port->string in) "\n\n")))
         (let* ((tile-block (string-split tile-string "\n")))
           (values (parse-tile (first tile-block))
                   (map string->list (rest tile-block))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PART ONE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; HANDLING TILES REGARDLESS OF ORIENTATION
;

; Since each tile may be rotated or flipped in any direction, the first idea
; is to represent each tile border by a single number, so borders can be
; compared across tiles. This number is simply a binary reading of the
; sequence of # and . characters. Because each row can be read from any
; direction, the number is defined as the least possible number.

(define (border->number border)
  (define (char->digit char) (if (char=? #\. char) 0 1))
  (define (chars->number chars)
    (for/fold ((acc 0)) ((c chars))
      (+ (* 2 acc) (char->digit c))))
  (min (chars->number border)
       (chars->number (reverse border))))

; Now we can map each tile to a set of such border numbers...

(define tile-sides
  `((top    . ,(λ (tile) (first tile)))
    (right  . ,(λ (tile) (map last tile)))
    (bottom . ,(λ (tile) (last tile)))
    (left   . ,(λ (tile) (map first tile)))))

(define (tile->numbers tile)
  (map border->number
       (map (λ (accessor) (accessor tile))
            (dict-values tile-sides))))

; ... into a single dict:
;
; '(
;   [1234 . (434 778 ...)]
;   ...
; )

(define (map-borders tiles)
  (for/hash (((k v) (in-hash tiles)))
    (values k (tile->numbers v))))

;
; FINDING TILES THAT FIT TOGETHER
;

; By flipping the map of borders, we can group tiles according to the borders
; that they share.
;
; '(
;   (1234 2345 3456)
;   (2345 9876 8765)
;   ...
;  )

(define (connection-sets tiles)
  (remove-duplicates
    (map remove-duplicates
         (dict-values
           (dict-condense
             (dict-reverse
               (map-borders tiles)))))))

; Lastly, we map each tile to tiles that it can connect with.
;
; By itself, this shouldn't mean that we have found all adjacent tiles. But,
; thankfully, it seems that in this challenge no single border is present in
; more than two different tiles. This means that the rest of the solution will
; be much more linear and won't require cycles of testing and backtracking.
;
; '(
;   [1234 . (2345 3456)]
;   [2345 . (1234 9876 8765)]
;   ...
; )

(define (map-connections tiles)
  (define sets (connection-sets tiles))
  (for*/fold ((result (make-immutable-hash)))
    ((s sets)
     (t s))
    (let ((connections (remove t s)))
      (hash-update result t (curry append connections) '()))))

;
; FINDING THE CORNERS OF THE JIGSAW
;

; Thanks to the above observation, corner tiles are easily spotted by the fact
; that they only share borders with two other tiles. So we filter the
; connections map to solve part one of the challenge.
;
; '(1234 2345 3456 4567)

(define (corner-tiles tiles)
  (for/list (((t connections) (in-hash (map-connections tiles)))
             #:when (= 2 (length connections)))
    t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PART TWO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; PUTTING THE JIGSAW TOGETHER
;

; Looking at the connections map, another useful observation emerges: that the
; outer tiles of the jigsaw are those with no more than three tiles in their
; respective connection sets. Corners are just a special case of outer tile
;
; Drawing on paper, the quickest path to solve the jigsaw is by drawing its
; perimeter first. Starting by one of its corners, t0, we then move to its
; first neighbor t1. Then we take the neighbor's remaining connecting tiles
; and, crucially, we pick the one that is itself an outer tile. And so on
; until we have closed the perimeter.
;
;     0   1   2   3
;    11           4
;    10           5
;     9   8   7   6
;
; This will be implemented in `solve-perimeter`.
;
; Once we have the perimeter, we can start back at t1 and notice that it only
; has one remaining connection: t12. We proceed to t2, whose last connection
; gives us t13. We keep following the spiral of tiles until all have been
; allocated. In the case of a 4x4 jigsaw, the last allocation happens at t8:
;
;     0   1   2   3
;    11  12  13   4
;    10  15  14   5
;     9   8   7   6
;
; This will be implemented in `solve-spiral`.
;
; You'll notice that we didn't bother with Cartesian coordinates: our jigsaw
; solution can be described as a single list: '(t0 t1 ... t15). We can map the
; spiral to (x, y) positions separately.

; Starting from a corner, list the tiles that make up the perimeter.
(define (solve-perimeter tiles)
  ; The initial tile choice is arbitrary as long as it's a corner tile, so
  ; choose `second` to match the AoC problem example.
  (define initial-tile (second (corner-tiles tiles)))
  (define connections (map-connections tiles))
  (let loop ((path '()) (id initial-tile))
    (define next
      (for/first ((t (dict-ref connections id))
                  #:when (and (not (member t path))
                              ((length (dict-ref connections t)) . < . 4)))
                 t))
    (if next
      (loop (cons id path) next)
      (reverse (cons id path)))))

(define (solve-spiral tiles)
  (define all-connections (map-connections tiles))
  (define initial-spiral (solve-perimeter tiles))
  (for/fold ((spiral initial-spiral)) ((i (dict-count tiles)))
    (define ref-tile (list-ref spiral i))
    (define next-tile (for/first ((t (dict-ref all-connections ref-tile))
                                  #:when (not (member t spiral)))
                                 t))
    (if next-tile `(,@spiral ,next-tile) spiral)))

; Converting spiral indices to Cartesian coordinates can be done recursively.
; For a 4x4 jigsaw, position 2 corresponds to '(2 0), and 15 to '(1 2).

(define (spiral->cartesian size position)
  (if (< size 2)
    '(0 0)
    (let* ((base (sub1 size))
           (face (quotient position base)))
      (match face
        (0 (list position 0))
        (1 (list base (remainder position base)))
        (2 (list (- base (remainder position base)) base))
        (3 (list 0 (- base (remainder position base))))
        (else
          (map add1 (spiral->cartesian (- size 2)
                                       (- position (* 4 base)))))))))

; Finally, we can zip everything together to map (x, y) coordinates to tiles.

(define (place-tiles tiles)
  (define size (sqrt (dict-count tiles)))
  (sort-by-position
    (for/hash (((t i) (in-indexed (solve-spiral tiles))))
      (values (spiral->cartesian size i) t))))

(define (sort-by-position dict)
  (sort (dict->list dict) pos<? #:key car))

(define (pos<? a b)
  (if (= (second a) (second b))
    (< (first a) (first b))
    (< (second a) (second b))))

;
; ORIENTING ALL TILES CORRECTLY
;

; By determining the positions of all the tiles of the jigsaw, we have
; greatly reduced the search space for orienting each tile so as to connect
; with its neighbors.
;
; The next step is to reveal the orientation constraints of each tile by
; combining the positioning information with the borders map (`map-borders`).
; Let's consider t14 and its neighbors:
;     
;      Positions          Borders           Constraints for t14
;
;         13          t5 : a, b, c, d    top   : one of (i j k l)
;     15  14   5      t7 : e, f, g, h    right : one of (a b c d)
;          7          t13: i, j, k, l    bottom: one of (e f g h)
;                     t15: m, n, o, p    left  : one of (m n o p)

(define adjacent-positions
  `((left   . ,(λ (i j) `(,i ,(sub1 j))))
    (right  . ,(λ (i j) `(,i ,(add1 j))))
    (top    . ,(λ (i j) `(,(sub1 i) ,j)))
    (bottom . ,(λ (i j) `(,(add1 i) ,j)))))

; Returns a dict of constraints for a given tile as follows:
;
;   '((left 18) (right) (top 399) (bottom))
;
; Empty lists indicate the absence of a neighboring tile.
(define (tile-constraints positions borders-map tile-id)
  (define tile-pos (for/first (((pos tid) (in-dict positions))
                               #:when (= tid tile-id)) pos))
  (define tile-borders (dict-ref borders-map tile-id))
  (for/list (((side accessor) (in-dict adjacent-positions)))
    (define neighbor-id (dict-ref positions (apply accessor tile-pos) #f))
    (define neighbor-borders (dict-ref borders-map neighbor-id '()))
    `(,side . ,(intersect tile-borders neighbor-borders))))

; With each tile's constraints describable as a dict, testing whether a tile
; is correctly oriented amounts to verifying that its four sides satisfy their
; neighborhood constraints.

(define (tile-satisfies? tile constraints)
  (for/and (((side numbers) (in-dict constraints))
            #:unless (empty? numbers))
    (let ((accessor (dict-ref tile-sides side)))
      (member (border->number (accessor tile)) numbers))))

; The last step is to try all possible orientations of a tile until all
; constraints are satisfied. By considering each tile on its own, our search
; space is very small.
;
; First, we define our rotating and flipping functions.

(define (rotate90 tile)
  (define size (length tile))
  (for/list ((i (in-range size)))
    (for/list ((j (in-range (sub1 size) -1 -1)))
      (list-ref (list-ref tile j) i))))

(define rotate180 (compose rotate90 rotate90))
(define rotate270 (compose rotate180 rotate90))

(define (fliph tile) (map reverse tile))
(define (flipv tile) (reverse tile))

; Now back to our problem space. It consists of all combinations of:
;
;    Rotate        Flip         Flip
;               horizontal   vertically
; ┌         ┐               
; │     0°  │  ┌         ┐  ┌         ┐     
; │    90°  │  │   yes   │  │   yes   │
; │   180°  │  │   no    │  │   no    │
; │   270°  │  └         ┘  └         ┘
; └         ┘ 
;
; In other words, the Cartesian product: R × H × V.
;
; However, this set of composed transformations contains duplicates. For
; instance, rotating 90° then flipping horizontally is equivalent to rotating
; 270° then flipping vertically. Avoiding duplicate transformations is
; important, not for performance, but — down the line — to make sure we don't
; spot repeated sea monsters. So, empirically, we simplify our Cartesian
; product by excluding vertical flips:

(define orientation-search-space
  (cartesian-product
    (list identity rotate90 rotate180 rotate270)
    (list identity fliph)))

; Let's turn these transformations into actual functions that take a tile and
; transform it:

(define orientation-attempts
  (map (curry apply compose) orientation-search-space))

; Return a tile's rows in the correct orientation:

(define (tile-orient constraints tile-rows)
  (for/first ((o orientation-attempts)
        #:when (tile-satisfies? (o tile-rows) constraints))
    (o tile-rows)))

;
; PRINTING OUT THE SOLVED JIGSAW
;

; Returns a string of lines describing the solved jigsaw, after removal of the
; gaps in between tiles and the borders of the tiles.
(define (tiles->string tiles)
  (define positions-matrix (place-tiles tiles))
  (define borders-map (map-borders tiles))
  (tiles-stitch
    positions-matrix
    (for/hash (((pos id) (in-dict positions-matrix)))
      (define constraints (tile-constraints positions-matrix borders-map id))
      (define rows (dict-ref tiles id))
      (values id (remove-borders (tile-orient constraints rows))))))

(define (tiles-stitch positions tiles)
  (define grid-size (sqrt (dict-count positions)))
  (define tile-size (length (first (dict-values tiles))))
  (define rows
    (for*/list ((i grid-size) (j tile-size))
      (for/list ((k grid-size))
        (let* ((tile (dict-ref tiles (dict-ref positions (list i k))))
               (row (list-ref tile j)))
          (list->string row)))))
  (string-join
    (map (λ (row) (string-join row "")) rows)
    "\n"))

(define (remove-borders tile)
  (define (trim lst)
    (drop (drop-right lst 1) 1))
  (map trim (trim tile)))

;
; FINDING SEA MONSTERS
;

; Sea monsters are more elusive than one might think.

(define sea-monster
  '("                  # "
    "#    ##    ##    ###"
    " #  #  #  #  #  #   "))

; The two main challenges are:
;
; 1. We are not doing a single string search, we are doing a set of searches
; on contiguous lines. Each of these searches may find sub-occurrences — that
; is, a row — of the sea monster, but they won't count unless they align with
; the other sub-occurrences. Consider the first row of the sea monster and
; it's clear that individual rows can easily match on their own, even in the
; absence of an actual monster. A mirage, as it were.
;
; 2. Each individual row of the sea monster, in this problem, is 20 characters
; long, while the image is 24 characters wide. Thus, there are 4 different
; possible positions (i ∈ [0, 3]) on any given line for a monster to hide in.
; We need to make sure that a string match at i=0 doesn't stop the search from
; also matching at i=1. That is, we must ensure our search supports
; overlapping matches.

; Let's address #2 first by building a regular expressions that use positive
; lookahead so as to not consume the input even if there is a match. Positive
; lookahead is represented as `(?=<expr>)`.
(define (parse-monster rows)
  (for/list ((row rows))
    (pregexp (format "(?=(~a))" (string-replace row " " ".")))))

; To address #1, here is the approach:
;
; The monster is 3 rows tall, so examine the input in slices of three lines:
; lines 0 to 2, then lines 1 to 3, then 2 to 4, and so on. For each such
; slice, search for row 0 of the monster in line 0, row 1 in line 1, etc.
;
; For every match in a row, collect its offset (which in practice will be 0 <=
; i <= 3). Discard any offset that doesn't match the other lines' offsets. So,
; if in a slice of text we have the following matches:
;
;     line 0: matched row 0 at offset 0 and offset 1
;     line 1: matched row 1 at offset 1 and offset 2
;     line 2: matched row 2 at offset 1
;
; Then the intersection of offsets is 1.
;
; Racket's `regexp-match-positions*` gives us a list of ranges (not just
; offsets) for every match, which serves just as well.  The ability to examine
; the input in overlapping slices of three lines comes from our own function
; `slice`.
;
; The implementation becomes concise:

(define (block-match-positions* patterns input)
  (append*
    (for/list ((lines (slice (length patterns) (string-split input "\n"))))
      (apply intersect (map regexp-match-positions* patterns lines)))))

; Counting monsters now amounts to counting these matches in all possible
; orientations of the full image:

(define (count-monsters input)
  (define patterns (parse-monster sea-monster))
  (for/sum ((o orientation-attempts))
    (length
      (block-match-positions* patterns (string-map o input)))))

; And our puzzle is entirely solved:

(define (sea-roughness input)
  (define pieces-per-monster
    (for/sum ((line sea-monster))
      (for/sum ((char line) #:when (char=? char #\#)) 1)))
  (define pieces-in-sea
    (for/sum ((char input) #:when (char=? char #\#)) 1))
  (- pieces-in-sea (* pieces-per-monster (count-monsters input))))

;
; UTILITY FUNCTIONS
;

; Like set-intersect, but for lists
(define (intersect . lsts)
  (set->list
    (apply set-intersect
           (map list->set lsts))))

; Turns (slice 3 (range 6))
; into  '((0 1 2) (1 2 3) (2 3 4) (3 4 5))
;
; Not the same as `in-slice`.
(define (slice size lst)
  (cond (((length lst) . < . size) '())
        (((length lst) . = . size) (list lst))
        (else (cons (take lst size)
                    (slice size (cdr lst))))))

; Turns '((a . (1 2)) (b . (2 3)))
; into  '((1 . a) (2 . a) (2 . b) (3 . b))
(define (dict-reverse d)
  (append-map
    (λ (p) (map (λ (v) (cons v (car p))) (cdr p)))
    (dict->list d)))

; Turns '((1 . a) (2 . a) (2 . b) (3 . b))
; into  '#hash((1 . (a)) (2 . (b a)) (3 . (b)))
(define (dict-condense d)
  (for/fold ((acc (make-immutable-hash)))
    (((k v) (in-dict d)))
    (hash-update acc k (curry cons v) '())))

; Given a function and a string representing n lines of n characters, applies
; the function to the two-dimensional list of characters of the string, and
; returns the result back in string form.
;
; (string-map rotate90 "abc\ndef\nghi") -> "gda\nheb\nifc"
(define (string-map fn str)
  (define (unpack str) (map string->list (string-split str "\n")))
  (define (repack rows) (string-join (map list->string rows) "\n"))
  (repack (fn (unpack str))))

;
; THE END.
;

(provide (all-defined-out))

; vim: set et tw=78: