aoc2020/20.rkt

#lang curly-fn racket

(require "scripts/aoc.rkt")

;; solution for day 20

(define (tile->edges tile)
  (define n (for/vector ([x (in-range 10)])
              (vector-ref (vector-ref tile 0) x)))
  (define e (for/vector ([x (in-range 10)])
              (vector-ref (vector-ref tile x) 9)))
  (define s (for/vector ([x (in-range 10)])
              (vector-ref (vector-ref tile 9) x)))
  (define w (for/vector ([x (in-range 10)])
              (vector-ref (vector-ref tile x) 0)))
  (list e s w n))

(define (edge-match? e1 e2)
  (cond
    [(equal? e1 e2) 'match]
    [(equal? e1 (list->vector (reverse (vector->list e2)))) 'rev-match]
    [else #f]))

(define (input->graph input)
  (define ids (hash-keys input))
  (define meta (make-hash))
  (define edges
    (for*/list ([id1 (in-list ids)] [id2 (in-list ids)] #:unless (= id1 id2)
                [i1 (in-range 4)] [i2 (in-range 4)]
                [es1 (in-value (tile->edges (hash-ref input id1)))]
                [es2 (in-value (tile->edges (hash-ref input id2)))]
                [m (in-value (edge-match? (list-ref es1 i1) (list-ref es2 i2)))]
                #:when m)
      (hash-set! meta (cons id1 id2) (list i1 i2 m))
      (list id1 id2)))
  (values (undirected-graph edges) meta))

(define (part1 input)
  (define-values [G _] (input->graph input))
  (for/product ([v (in-vertices G)])
    (define nneigh (length (get-neighbors G v)))
    (if (= nneigh 2) v 1)))

(define (tile->string tile)
  (string-join (for/list ([x (in-vector tile)]) (list->string (vector->list x))) "\n"))

(define (rotate1 vec)
  (for/vector ([x (in-range (vector-length (vector-ref vec 0)))])
    (for/vector ([y (in-range (vector-length vec))])
      (vector-ref (vector-ref vec (- (vector-length vec) y 1)) x))))

(define (rotaten vec n)
  (for/fold ([vec vec]) ([i (in-range n)])
    (rotate1 vec)))

(define (flip-horiz vec)
  (for/vector ([y (in-range (vector-length vec))])
    (for/vector ([x (in-range (vector-length (vector-ref vec 0)))])
      (vector-ref (vector-ref vec y) (- (vector-length (vector-ref vec 0)) x 1)))))

(define (flip-vert vec)
  (for/vector ([y (in-range (vector-length vec))])
    (for/vector ([x (in-range (vector-length (vector-ref vec 0)))])
      (vector-ref (vector-ref vec (- (vector-length vec) y 1)) x))))

(define monster-in
  '("                  # "
    "#    ##    ##    ###"
    " #  #  #  #  #  #   "))
(define monster
  (for/vector ([line (in-list monster-in)])
    (list->vector (string->list line))))

(define (part2 input)
  (define-values [G meta] (input->graph input))
  (define corners
    (for/list ([v (in-vertices G)] #:when (= 2 (length (get-neighbors G v)))) v))
  (define rows (make-vector 12 #f))
  (define used-verts (mutable-set))
  (define nextrow (for*/first ([cand (in-list (rest corners))]
                               [path (in-value (fewest-vertices-path G (first corners) cand))]
                               #:when (= 12 (length path)))
                    path))
  (vector-set! rows 0 (list->vector nextrow))
  (set-union! used-verts (list->set nextrow))
  (for ([i (in-range 1 12)])
    (define l (first nextrow))
    (define r (last nextrow))
    (define lnext (for/first ([v (in-neighbors G l)] #:unless (set-member? used-verts v)) v))
    (define rnext (for/first ([v (in-neighbors G r)] #:unless (set-member? used-verts v)) v))
    (set! nextrow (fewest-vertices-path G lnext rnext))
    (vector-set! rows i (list->vector nextrow))
    (set-union! used-verts (list->set nextrow)))
  (pretty-write rows)
  (displayln (hash-ref meta (cons (vector-ref (vector-ref rows 0) 0)
                                  (vector-ref (vector-ref rows 0) 1))))
  (displayln (hash-ref meta (cons (vector-ref (vector-ref rows 0) 0)
                                  (vector-ref (vector-ref rows 1) 0))))
  (define corrected (make-hash))
  (define tl (vector-ref (vector-ref rows 0) 0))
  ;; assume top left is oriented right...
  ;; we tuned the parse to make it so
  (hash-set! corrected tl (hash-ref input tl))
  (displayln (tile->string (hash-ref input tl)))
  (displayln "meow")
  (for ([x (in-range 1 12)])
    (define v (vector-ref (vector-ref rows 0) x))
    (define left (vector-ref (vector-ref rows 0) (sub1 x)))
    (match-define (list rot _ __) (hash-ref meta (cons v left)))
    (define rotated (rotaten (hash-ref input v) (match rot
                                                  [2 0]
                                                  [3 3]
                                                  [0 2]
                                                  [1 1])))
    (define mt (edge-match? (first (tile->edges (hash-ref corrected left)))
                            (third (tile->edges rotated))))
    (define flipped (if (symbol=? mt 'match) rotated (flip-vert rotated)))
    (hash-set! corrected v flipped)
    ; (displayln (tile->string flipped))
    ; (displayln "meow")
    (void))

  (for* ([y (in-range 1 12)] [x (in-range 0 12)])
    (define v (vector-ref (vector-ref rows y) x))
    (define top (vector-ref (vector-ref rows (sub1 y)) x))
    (match-define (list rot _ __) (hash-ref meta (cons v top)))
    (define rotated (rotaten (hash-ref input v) (match rot
                                                  [0 3]
                                                  [1 2]
                                                  [2 1]
                                                  [3 0])))
    (define mt (edge-match? (second (tile->edges (hash-ref corrected top)))
                            (fourth (tile->edges rotated))))
    (define flipped (if (symbol=? mt 'match) rotated (flip-horiz rotated)))
    (hash-set! corrected v flipped)
    ; (displayln (tile->string flipped))
    ; (dispalyln "meow")
    (void))

  ; (for* ([yt (in-range 12)] [yc (in-range 10)])
  ;   (when (zero? yc) (printf "\n"))
  ;   (displayln (string-join (for/list ([xt (in-range 12)])
  ;                             (list->string
  ;                               (vector->list
  ;                                 (vector-ref
  ;                                   (hash-ref corrected
  ;                                             (vector-ref (vector-ref rows yt) xt))
  ;                                   yc))))
  ;                           " ")))

  (define full-image
    (for/vector ([y (in-range 96)])
      (for/vector ([x (in-range 96)])
        (define yt (quotient y 8))
        (define xt (quotient x 8))
        (define yr (remainder y 8))
        (define xr (remainder x 8))
        (define tile (hash-ref corrected (vector-ref (vector-ref rows yt) xt)))
        (vector-ref (vector-ref tile (add1 yr)) (add1 xr)))))

  (define (monster-match? check x y)
    (define coords (mutable-set))

    (define match?
      (for*/and ([dy (in-range (vector-length check))]
                 [dx (in-range (vector-length (vector-ref check 0)))])
        (cond
          [(char=? #\space (vector-ref (vector-ref check dy) dx)) #t]
          [(char=? #\# (vector-ref (vector-ref full-image (+ y dy)) (+ x dx)))
           (set-add! coords (cons (+ x dx) (+ y dy)))
           #t]
          [else #f])))
    (if match? coords #f))

  (define monster-coords (mutable-set))
  (for* ([func (in-list (list identity flip-vert))]
         [rotation (in-range 4)])
    (define check (func (rotaten monster rotation)))
    (for* ([y (in-range (- 96 (vector-length check)))]
           [x (in-range (- 96 (vector-length (vector-ref check 0))))])
      (define match? (monster-match? check x y))
      (when match?
        (set-union! monster-coords match?))))

  (define hashcount (for*/sum ([y (in-range 96)] [x (in-range 96)]
                               #:when (char=? (vector-ref (vector-ref full-image y) x) #\#))
                      1))


  (- hashcount (set-count monster-coords)))

;; parse input file
(define (parse fname)
  (define inputs (string-split (file->string fname) "\n\n"))
  (for/hash ([input (in-list inputs)])
    (define lines (string-split input "\n"))
    (define id (string->number (substring (first lines) 5 (sub1 (string-length (first lines))))))
    (when (false? id) (error "not shonks" (first lines)))
    (values id (rotate1 (for/vector ([line (in-list (rest lines))])
                 (list->vector (string->list line)))))))


(module+ test
  (require rackunit)
  ;; tests here
  (displayln "no tests :("))

(module+ main
  (define input (parse "inputs/20"))
  (answer 20 1 (time (part1 input)))
  (answer 20 2 (time (part2 input)))
  (displayln "meow"))