haskal seriously this is the worst code i have ever seen

This commit is contained in:
xenia 2019-12-03 01:05:12 -05:00
parent cfaf2d03c9
commit f31e2ea3f3
1 changed files with 161 additions and 0 deletions

161
3.rkt Normal file
View File

@ -0,0 +1,161 @@
#lang racket
(define (parse-wire s)
(map parse-seg (string-split (string-trim s) ",")))
(define wire-defs
(string-split (string-trim (file->string "input.3.txt")) "\n"))
(define-struct seg (dir len))
(define-struct aseg (x1 y1 x2 y2))
(define-struct pt (x y))
(define (pa a) (list (aseg-x1 a) (aseg-y1 a) (aseg-x2 a) (aseg-y2 a)))
(define (pp p) (list (pt-x p) (pt-y p)))
(define (parse-seg str)
(make-seg
(string->symbol (substring str 0 1))
(string->number (substring str 1))))
(define wires (map parse-wire wire-defs))
(define (make-norm-aseg x1 y1 x2 y2)
(let ([nx1 (min x1 x2)]
[nx2 (max x1 x2)]
[ny1 (min y1 y2)]
[ny2 (max y1 y2)])
(make-aseg nx1 ny1 nx2 ny2)))
(define (seg->aseg seg x y)
(let ([dx (* (seg-len seg)
(match (seg-dir seg)
['R 1]
['L -1]
[_ 0]))]
[dy (* (seg-len seg)
(match (seg-dir seg)
['U 1]
['D -1]
[_ 0]))])
(values (make-norm-aseg x y (+ x dx) (+ y dy)) (+ x dx) (+ y dy))))
(define (wire->asegwire wire)
(define (wire->asegwire+ wire x y)
(cond
[(empty? wire) '()]
[else (let-values ([(aseg newx newy) (seg->aseg (first wire) x y)])
(cons aseg (wire->asegwire+ (rest wire) newx newy)))]))
(wire->asegwire+ wire 0 0))
(define aseg-wires (map wire->asegwire wires))
(define (horiz? aseg)
(= (aseg-y1 aseg) (aseg-y2 aseg)))
(define (vert? aseg)
(= (aseg-x1 aseg) (aseg-x2 aseg)))
(define (cross aseg1 aseg2)
(cond
;; both horizontal
[(and (horiz? aseg1) (horiz? aseg2) (= (aseg-y1 aseg1) (aseg-y1 aseg2))
(>= (aseg-x2 aseg2) (aseg-x1 aseg1))
(<= (aseg-x1 aseg2) (aseg-x2 aseg1)))
(list (make-pt (max (aseg-x1 aseg1) (aseg-x1 aseg2)) (aseg-y1 aseg1))
(make-pt (min (aseg-x2 aseg1) (aseg-x2 aseg2)) (aseg-y1 aseg1)))]
;; both vertical
[(and (vert? aseg1) (vert? aseg2) (= (aseg-x1 aseg1) (aseg-x1 aseg2))
(>= (aseg-y2 aseg2) (aseg-y1 aseg1))
(<= (aseg-y1 aseg2) (aseg-y2 aseg1)))
(list (make-pt (aseg-x1 aseg1) (max (aseg-y1 aseg1) (aseg-y1 aseg2)))
(make-pt (aseg-x1 aseg1) (min (aseg-y2 aseg1) (aseg-y2 aseg2))))]
;; h/v
[(and (horiz? aseg1) (vert? aseg2)
(>= (aseg-x1 aseg2) (aseg-x1 aseg1))
(<= (aseg-x1 aseg2) (aseg-x2 aseg1))
(>= (aseg-y1 aseg1) (aseg-y1 aseg2))
(<= (aseg-y1 aseg1) (aseg-y2 aseg2)))
(list (make-pt (aseg-x1 aseg2) (aseg-y1 aseg1)))]
;; v/h
[(and (vert? aseg1) (horiz? aseg2)
(>= (aseg-x1 aseg1) (aseg-x1 aseg2))
(<= (aseg-x1 aseg1) (aseg-x2 aseg2))
(>= (aseg-y1 aseg2) (aseg-y1 aseg1))
(<= (aseg-y1 aseg2) (aseg-y2 aseg1)))
(list (make-pt (aseg-x1 aseg1) (aseg-y1 aseg2)))]
[else '()]))
(define (aseg-cross aseg wire)
(cond
[(empty? wire) '()]
[else
(append (cross aseg (first wire)) (aseg-cross aseg (rest wire)))]))
(define (get-crossings+ wire1 wire2)
(cond
[(empty? wire1) '()]
[else (append (aseg-cross (first wire1) wire2) (get-crossings (rest wire1) wire2))]))
(define (get-crossings wire1 wire2)
(filter (lambda (p) (not (and (zero? (pt-x p)) (zero? (pt-y p)))))
(get-crossings+ wire1 wire2)))
(define crossings (get-crossings (first aseg-wires) (second aseg-wires)))
(define (manhattan pt)
(+ (abs (pt-x pt)) (abs (pt-y pt))))
(define (min-crossing crs)
(cond
[(empty? crs) +inf.0]
[else (min (manhattan (first crs)) (min-crossing (rest crs)))]))
;; Part 1
;; Holy SHIT i cannot believe this was actually the right answer WTF
;; i assumed i made some sort of typo in cross lol
;; UPDATE:
;; i had a bug where i forgot to have make-norm-aseg actually work
;; and THEN i also forgot to filter crossing '(0 0)
;; BUT this somehow didn't affect the answer for part 1
;; i just got screwed on part 2
;; anyway now both work
(displayln (min-crossing crossings))
(define (aseg-on-pt aseg pt)
(or
(and (= (pt-x pt) (aseg-x1 aseg) (aseg-x2 aseg))
;; yeah so i remembered that <= can take more than 2 args here
;; way before writing (cross)
;; huge oof
(<= (aseg-y1 aseg) (pt-y pt) (aseg-y2 aseg)))
(and (= (pt-y pt) (aseg-y1 aseg) (aseg-y2 aseg))
(<= (aseg-x1 aseg) (pt-x pt) (aseg-x2 aseg)))))
(define (aseg-pt-dist aseg pt)
(cond
[(horiz? aseg) (- (pt-x pt) (aseg-x1 aseg))]
[(vert? aseg) (- (pt-y pt) (aseg-y1 aseg))]))
(define (aseg-len aseg)
(+
(- (aseg-x2 aseg) (aseg-x1 aseg))
(- (aseg-y2 aseg) (aseg-y1 aseg))))
(define (get-steps wire pt)
(cond
[(empty? wire) (error "thinking")]
[else
(cond
[(aseg-on-pt (first wire) pt)
(aseg-pt-dist (first wire) pt)]
[else
(+ (aseg-len (first wire)) (get-steps (rest wire) pt))])]))
(define (min-len-crossing crs wire1 wire2)
(cond
[(empty? crs) +inf.0]
[else (min (+ (get-steps wire1 (first crs)) (get-steps wire2 (first crs)))
(min-len-crossing (rest crs) wire1 wire2))]))
;; Part 2
(displayln (min-len-crossing crossings (first aseg-wires) (second aseg-wires)))