[-] kato_dax@programming.dev 2 points 1 week ago

Guile Scheme

Runs in 3.2 seconds.

I quickly got part 2 two to work on the example input, but i struggled a lot with bugs in the polygon-test code before getting the right result. To find my bugs, i made a visualization using raylib. It's not part of the snippet, but you can find the full code here.

(define-module (day9)
  #:use-module (input)
  #:use-module (util)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (ice-9 control)
  #:use-module (system foreign)
  #:use-module (rnrs bytevectors)
  #:use-module (raylib)
  #:export (day))

(define (parse-coord str)
  (map string->number (string-split str #\,)))

(define (parse port)
  (-> (read-lines port)
      (curry map string-trim-both)
      (curry filter (negate string-empty?))
      (curry map parse-coord)
      (curry map (match-lambda [(a b) (cons a b)]))))

(define (area a b)
  (match-let ([(ax . ay) a] [(bx . by) b])
             (* (+ 1 (abs (- bx ax)))
                (+ 1 (abs (- by ay))))))

(define (is-in-polygon pos corners)
  (match-let ([(x . y) pos])
    (call/ec (位 (return)
      (odd? (let go ([corners (cons (last corners) corners)])
        (match corners
          [() 0]
          [(_) 0]
          [((bx . by) (ax . ay) . rest)
           (+ (call/ec (位 (next)
                          (cond
                            [(= bx ax)
                             (when (< y (min ay by))
                               (next 0))
                             (when (>= y (max ay by))
                               (next 0))
                             (when (= x ax)
                               (return #t))
                             (when (< x ax)
                               (next 1))
                             (when (> x ax)
                               (next 0))]
                            [(= by ay)
                             (when (not (= y ay))
                               (next 0))
                             (when (< x (min ax bx))
                               (next 0))
                             (when (> x (max ax bx))
                               (next 0))
                             (return #t)])))
                             (go (cons `(,ax . ,ay) rest)))])))))))

(define (lines-intersect? a b)
  (match-let* ([((asx . asy) . (aex . aey)) a]
               [((bsx . bsy) . (bex . bey)) b]
               [alx (min asx aex)]
               [ahx (max asx aex)]
               [blx (min bsx bex)]
               [bhx (max bsx bex)]
               [aly (min asy aey)]
               [ahy (max asy aey)]
               [bly (min bsy bey)]
               [bhy (max bsy bey)]
               [a-horizontal (= asy aey)]
               [b-horizontal (= bsy bey)])
    (and
      (not (equal? a-horizontal b-horizontal))
      (if a-horizontal
        (and
          (<= alx blx)
          (>= ahx blx)
          (> aly bly)
          (< ahy bhy))
        (lines-intersect? b a)))))

(define (line-intersects-polygon? line corners)
  (let go ([corners (cons (last corners) corners)])
    (match corners
        [() #f]
        [(a) #f]
        [(a b . rest)
         (or
           (lines-intersect? line `(,a . ,b))
           (go (cons b rest)))])))

(define (rectangle-corners a b)
  (match-let ([(ax . ay) a] [(bx . by) b])
    `((,(min ax bx) . ,(min ay by))
      (,(min ax bx) . ,(max ay by))
      (,(max ax bx) . ,(min ay by))
      (,(max ax bx) . ,(max ay by)))))

(define (rectangle-edges a b)
  (match-let ([(tl bl tr br) (rectangle-corners a b)])
    `((,tl . ,tr)
      (,tr . ,br)
      (,br . ,bl)
      (,bl . ,tl))))

(define-day day 9 'real
  (位 (port called-directly)
     (define red-tiles (parse port))

     (define is-in-loop? (cached (位 (pos) (is-in-polygon pos red-tiles))))
     (define intersects-loop? (cached (位 (line) (line-intersects-polygon? line red-tiles))))

     (define tile-combinations (pairs red-tiles))

     (define part1 (-> tile-combinations
                       (curry map (match-lambda [(a . b) (area a b)]))
                       (sort _ >)
                       car))

     (define part2 (-> tile-combinations
                       (curry filter (match-lambda [(a . b)
                                                    (and (all is-in-loop? (rectangle-corners a b))
                                                         (all (位 (edge) (not (intersects-loop? edge))) (rectangle-edges a b)))]))
                       (curry map (match-lambda [(a . b) `(,(area a b) . (,a . ,b))]))
                       (sort _ (lambda (a b) (on car > a b)))
                       car))

     (when called-directly (visualization red-tiles (cdr part2)))

     `(,part1 ,(car part2))))

kato_dax

0 post score
0 comment score
joined 2 months ago