diff --git a/2020/20.rkt b/2020/20.rkt index d397441..2a24ad6 100644 --- a/2020/20.rkt +++ b/2020/20.rkt @@ -1,5 +1,5 @@ #lang br -(require racket/file rackunit) +(require racket/file rackunit racket/dict) (define edge-flipped (let () @@ -13,7 +13,7 @@ (arithmetic-shift 1 i))) (λ (x) (hash-ref! cache x (λ () (edge-flipper x)))))) -(struct tile (num edges) #:transparent) +(struct tile (num edges css) #:transparent #:mutable) (define (tilestr->edgevals tilestr) (define vec (list->vector (string->list (string-replace tilestr "\n" "")))) @@ -27,15 +27,17 @@ #:when (char=? (vector-ref vec idx) #\#)) (arithmetic-shift 1 i)))) +(define tilestrs (make-hash)) + (define tiles (let* ([recs (string-split (file->string "20.rktd") "Tile")] [recs (map string-trim recs)]) (for/list ([rec recs]) (match-define (list numstr tilestr) (string-split rec ":")) - (tile (string->number numstr) - (tilestr->edgevals tilestr))))) + (define num (string->number numstr)) + (tile num (tilestr->edgevals tilestr) (map string->list (string-split tilestr "\n")))))) -(define (matching-edges tile) +(define (matching-tiles tile [tiles tiles]) (for/list ([edge (in-list (tile-edges tile))]) (for/first ([other-tile (in-list (remove tile tiles))] #:when @@ -43,7 +45,131 @@ (or (eq? edge other-edge) (eq? edge (edge-flipped other-edge))))) other-tile))) -(define (corner-tile? tile) - (= 2 (length (filter values (matching-edges tile))))) +(define (matching-edge-count tile count) + (= count (length (filter values (matching-tiles tile))))) +(define (edge-tile? tile) (matching-edge-count tile 3)) +(define (corner-tile? tile) (matching-edge-count tile 2)) (check-equal? (apply * (map tile-num (filter corner-tile? tiles))) 15405893262491) + +(define corners (filter corner-tile? tiles)) +(define first-corner (car corners)) + +(require racket/set) +(define tileset (apply mutable-set (map tile-num tiles))) +(define tile-grid (make-hasheqv)) + +(define (flip-css css) (map reverse css)) + +(define (flip t) + (tile (tile-num t) (tile-edges t) (flip-css (tile-css t)))) + +(define (rotate-css css) + (map reverse (apply map list css))) + +(define (rotate t) + (tile (tile-num t) (tile-edges t) (rotate-css (tile-css t)))) + +#;(define (place-line tile coord orientation) + (hash-set! tile-grid coord tile) + (set-remove! tileset (tile-num tile)) + (for ([(edge idx) (in-indexed (tile-edges tile))] + [dir '(+i 1 -i -1)] + [matching-tile (matching-tiles tile)] + #:when (and matching-tile (= dir orientation))) + ;; match polarity + (unless (memq edge (tile-edges matching-tile)) + (flip! matching-tile)) + ;; match rotation + (let loop () + (rotate! matching-tile) + (unless (eq? (list-ref (tile-edges tile) idx) + (list-ref (tile-edges matching-tile) idx)) + (loop))) + ;; rotate 180 + (rotate! matching-tile) + (rotate! matching-tile) + ;; invert polarity + (flip! matching-tile) + (place-line matching-tile (+ coord dir) orientation))) + +(define (top tile) (first (tile-css tile))) +(define (bottom tile) (last (tile-css tile))) +(define (left tile) (map first (tile-css tile))) +(define (right tile) (map last (tile-css tile))) + +(define (joiner tile left-proc right-proc) + (for*/first ([other-tile tiles] + #:unless (eq? (tile-num tile) (tile-num other-tile)) + [flip-proc (list values flip)] + [rotate-proc (list values rotate (compose1 rotate rotate) (compose1 rotate rotate rotate))] + [adjusted-tile (in-value (rotate-proc (flip-proc other-tile)))] + #:when (equal? (left-proc tile) (right-proc adjusted-tile))) + adjusted-tile)) + +(define (insert-joiners! coord) + (define tile (hash-ref tile-grid coord)) + (for ([edge-proc (list top left bottom right)] + [opp-edge-proc (list bottom right top left)] + [dir (list +i -1 -i 1)]) + (match (joiner tile edge-proc opp-edge-proc) + [#false (void)] + [joiner (hash-set! tile-grid (+ coord dir) joiner)]))) + + +(hash-set! tile-grid 0 first-corner) +(for* ([imag (in-range 12)] + [real (in-range 0 -12 -1)]) + (insert-joiners! (+ real (* imag +i)))) + +(define (trim-edge css) + (drop-right (cdr (map (λ (cs) (drop-right (cdr cs) 1)) css)) 1)) + +(define actual-image + (append* + (for/list ([imag (in-range 11 -1 -1)]) + (apply map append + (for/list ([real (in-range -11 1)]) + (trim-edge (tile-css (hash-ref tile-grid (+ real (* imag +i)))))))))) + +#;(for-each (λ (x) (displayln (list->string x))) actual-image) + +(define row-width (length (car actual-image))) +(define (css->vec css) (list->vector (apply append css))) + +(define sea-monster-offsets (list 0 + (- row-width 18) + (- row-width 13) + (- row-width 12) + (- row-width 7) + (- row-width 6) + (- row-width 1) + row-width + (+ row-width 1) + (- (* 2 row-width) 2) + (- (* 2 row-width) 5) + (- (* 2 row-width) 8) + (- (* 2 row-width) 11) + (- (* 2 row-width) 14) + (- (* 2 row-width) 17))) + +(define (sea-monster-at? vec idx) + (for/and ([offset (in-list sea-monster-offsets)]) + (define pos (+ idx offset)) + (and + (< pos (vector-length vec)) + (char=? (vector-ref vec pos) #\#)))) + +(define vec (css->vec (rotate-css (rotate-css (rotate-css actual-image))))) +(define sea-monster-idxs + (for/list ([idx (in-range (vector-length vec))] + #:when (sea-monster-at? vec idx)) + idx)) + +(define sea-monster-parts + (set->list + (for*/set ([idx sea-monster-idxs] + [offset sea-monster-offsets]) + (+ idx offset)))) + +(check-equal? (- (count (λ (c) (char=? #\# c)) (apply append actual-image)) (length sea-monster-parts)) 2133)