haskal seriously this is the worst code i have ever seen
This commit is contained in:
parent
cfaf2d03c9
commit
f31e2ea3f3
|
@ -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)))
|
Loading…
Reference in New Issue