You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
141 lines
5.3 KiB
Racket
141 lines
5.3 KiB
Racket
#lang br
|
|
(require racket/file rackunit racket/set)
|
|
|
|
(define edge-flipped
|
|
(let ()
|
|
(define cache (make-hasheq))
|
|
(define bit-count 10)
|
|
(define (edge-flipper x)
|
|
(for/sum ([(b i)
|
|
(in-indexed (for/list ([b (in-range (sub1 bit-count) -1 -1)])
|
|
(bitwise-bit-set? x b)))]
|
|
#:when b)
|
|
(arithmetic-shift 1 i)))
|
|
(λ (x) (hash-ref! cache x (λ () (edge-flipper x))))))
|
|
|
|
(struct tile (num edges css) #:transparent #:mutable)
|
|
|
|
(define (tilestr->edgevals tilestr)
|
|
(define vec (list->vector (string->list (string-replace tilestr "\n" ""))))
|
|
(for/list ([validxs (list (range 10) ; top
|
|
(range 9 100 10) ; right
|
|
(range 99 89 -1) ; bottom
|
|
(range 90 -1 -10) ; left
|
|
)])
|
|
(for/sum ([idx (in-list validxs)]
|
|
[i (in-naturals)]
|
|
#: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 ":"))
|
|
(define num (string->number numstr))
|
|
(tile num (tilestr->edgevals tilestr) (map string->list (string-split tilestr "\n"))))))
|
|
|
|
(define (matching-tiles tile [tiles tiles])
|
|
(for/list ([edge (in-list (tile-edges tile))])
|
|
(for/first ([other-tile (in-list (remove tile tiles))]
|
|
#:when
|
|
(for/or ([other-edge (in-list (tile-edges other-tile))])
|
|
(or (eq? edge other-edge) (eq? edge (edge-flipped other-edge)))))
|
|
other-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))
|
|
|
|
(define corners (filter corner-tile? tiles))
|
|
(check-equal? (apply * (map tile-num corners)) 15405893262491)
|
|
|
|
(define first-corner (car corners))
|
|
(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 (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))))))))))
|
|
|
|
(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)
|