[p9] Done part 2;

I am officially an idiot; I got the area of the rectangle wrong
master
Jacopo De Simoi 6 months ago
parent e67c57ef4d
commit daeb44775a
  1. 270
      p9/p9.org

@ -1,5 +1,7 @@
#+title: Solution to p9
Well, this was quite the shitshow…
I need to cleanup this mess
#+begin_src emacs-lisp :results none
(with-temp-buffer
(insert-file-contents "input")
@ -19,8 +21,8 @@ Find max area
(defun area (el)
(let ((a (car el))
(b (cdr el)))
(abs (* (- (car a) (car b) -1)
(- (cadr a) (cadr b) -1)))))
(* (1+ (abs (- (car a) (car b))))
(1+ (abs (- (cadr a) (cadr b)))))))
(defun symmetric-pairs (list)
(apply #'append (--map-indexed (-map (lambda (other) (cons it other))
@ -33,12 +35,12 @@ Find max area
#+RESULTS:
: 4737096935
For part 2, we begin by removing the vertices that are not corners.
(there may be some, or none, but I don't know for sure)
For part 2, we begin by doing some preparation.
We collect corners and edges.
#+begin_src emacs-lisp :results none
(setq data-prev (-rotate 1 data)
data-next (-rotate -1 data)
edges (-zip-lists data data-next)
data-edges (-zip-lists data data-next)
data-pv (-zip-lists data data-prev data-next))
(defun normalize (x)
@ -58,23 +60,261 @@ For part 2, we begin by removing the vertices that are not corners.
(cons (cornerize (cadr it) (car it))
(cornerize (car it) (caddr it))))
data-pv))
(setq data-horizontal-edges (--filter (eq 'horizontal (apply #'hor-or-ver it)) data-edges)
data-vertical-edges (--filter (eq 'vertical (apply #'hor-or-ver it)) data-edges))
;; Let us sort the edges
(setq data-horizontal-edges (--sort (< (cadar it) (cadar other)) data-horizontal-edges)
data-vertical-edges (--sort (< (caar it) (caar other)) data-vertical-edges))
#+end_src
We do some sanity check: is there any vertex that is not a corner?
#+begin_src emacs-lisp
(--remove (= 0 (advent/dot (cadr it) (cddr it))) data-corners)
#+end_src
#+RESULTS:
No, that's good. Now check if all vertices are distinct.
#+begin_src emacs-lisp
(= (length (-distinct data)) (length data))
#+end_src
OK, the datapoints are all corners. Now I know. Find which way is inside
#+RESULTS:
: t
That's good. This eliminates some corner cases. Now examine the
orientation; the result can be 1 or -1
if it is 1, then the domain is always to the right of the edges
if it is -1, then the domain is always to the left of the edges
#+begin_src emacs-lisp
(setq orientation (normalize (apply '- (-map #'cadr (car data-vertical-edges)))))
#+end_src
#+RESULTS:
: 1
Now we cook up a function to check if a given point X Y is inside or outside
#+begin_src emacs-lisp :results none
;; find the leftmost and topmost coordinate
(setq leftmost (-min (-map #'car data))
topmost (-min (-map #'cadr data)))
;; The next two functions could be sped up by using bisection. See if it is necessary
(defun vertical-edges-up-to (x)
(--take-while (<= (caar it) x) data-vertical-edges))
(defun horizontal-edges-up-to (y)
(--take-while (<= (cadar it) y) data-horizontal-edges))
(defun vertical-edge-goes-through (edge y)
(let ((miny (min (cadar edge) (cadadr edge)))
(maxy (max (cadar edge) (cadadr edge))))
(and (< miny y) (< y maxy))))
(defun horizontal-edge-goes-through (edge x)
(let ((minx (min (caar edge) (caadr edge)))
(maxx (max (caar edge) (caadr edge))))
(and (< minx x) (< x maxx))))
(defun odd-p (n)
(= 1 (logand n 1)))
(defun even-p (n)
(= 0 (logand n 1)))
(defun inside-p (x y)
(let* ((horizontal-head (horizontal-edges-up-to y))
(vertical-head (vertical-edges-up-to x))
(x (+ x 0.5))
(y (+ y 0.5))
(filtered-horizontal-head (--filter (horizontal-edge-goes-through it x) horizontal-head))
(filtered-vertical-head (--filter (vertical-edge-goes-through it y) vertical-head)))
(and (odd-p (length filtered-horizontal-head))
(odd-p (length filtered-vertical-head)))))
#+end_src
Let me be silly and draw the thing.
#+begin_src emacs-lisp
(setq svg-preamble "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
<svg
version=\"1.1\"
id=\"svg1\"
width=\"1000\"
height=\"1000\"
sodipodi:docname=\"tmp.svg\"
xmlns=\"http://www.w3.org/2000/svg\"
xmlns:svg=\"http://www.w3.org/2000/svg\">
<defs
id=\"defs1\" />
<sodipodi:namedview
id=\"namedview1\"
pagecolor=\"#ffffff\"
bordercolor=\"#666666\"
borderopacity=\"1.0\"
inkscape:showpageshadow=\"2\"
inkscape:pageopacity=\"0.0\"
inkscape:pagecheckerboard=\"0\"
inkscape:deskcolor=\"#d1d1d1\"
showgrid=\"false\"
inkscape:zoom=\"1\"
inkscape:cx=\"150\"
inkscape:cy=\"75.067024\"
inkscape:window-width=\"1000000\"
inkscape:window-height=\"1000000\"
inkscape:window-x=\"0\"
inkscape:window-y=\"0\"
inkscape:window-maximized=\"1\"
inkscape:current-layer=\"svg1\" />")
(defun scale-coordinate (x)
(* .01 x))
(defun draw-svg ()
(with-temp-buffer
(let ((minx (-min (-map #'car data)))
(maxx (-max (-map #'car data)))
(miny (-min (-map #'cadr data)))
(maxy (-max (-map #'cadr data))) )
(insert svg-preamble) ; (format "<svg height=%d width=%d xmlns=\"http://www.w3.org/2000/svg\">" (+ maxy miny) (+ maxx minx))
(--each data-edges (insert (format "<line x1=\"%f\" y1=\"%f\" x2=\"%f\" y2=\"%f\" style=\"stroke:#000;stroke-width:0.1\"/>\n"
(scale-coordinate (caar it))
(scale-coordinate (cadar it))
(scale-coordinate (caadr it))
(scale-coordinate (cadadr it)))))
(insert (format "<rect x=\"%f\" y=\"%f\" width=\"%f\" height=\"%f\" style=\"fill:FF000080\"/>"
(scale-coordinate 5639)
(scale-coordinate 50249)
(scale-coordinate (- 94532 5639))
(scale-coordinate (- 68743 50249))))
(insert "</svg>")
)
(write-file "tmp-2.svg")))
(draw-svg)
#+end_src
#+RESULTS:
Oh motherfucker; the domain has a very special shape.
Find the two possible vertices
#+begin_src emacs-lisp
;; find the two longest horizontal edges
(defun edge-width (it)
(abs (- (caadr it) (caar it))))
(setq special-two-edges (-take 2 (--sort (> (edge-width it) (edge-width other)) data-horizontal-edges))
special-two-vertices (--map (list (max (caar it) (caadr it)) (cadar it)) special-two-edges))
;; the maximal rectangle will have one of these two as its vertex
;; let us now find the height at which the x cuts the outer shape
(defun vertical-edge-goes-through (edge y)
(let ((miny (min (cadar edge) (cadadr edge)))
(maxy (max (cadar edge) (cadadr edge))))
(and (<= miny y) (<= y maxy))))
(defun horizontal-edge-goes-through (edge x)
(let ((minx (min (caar edge) (caadr edge)))
(maxx (max (caar edge) (caadr edge))))
(and (<= minx x) (<= x maxx))))
;; this only gives two edges. We are lucky. These are the two y-coordinates
(setq y-range (-map #'cadar (-difference (--filter (horizontal-edge-goes-through it (caar special-two-vertices)) data-horizontal-edges) special-two-edges)))
;; now we filter the other vertices
(setq candidates-top (--filter (and (>= (cadr it) (car y-range)) (< (cadr it) 50000) (< (car it) 50000)) data)
candidates-bottom (--filter (and (<= (cadr it) (cadr y-range)) (> (cadr it) 50000) (< (car it) 50000)) data))
(car (-sort '> (-map #'area (--map (cons (cadr special-two-vertices) it) candidates-bottom))))
1643916742
(-sort '> (-map #'area (--map (cons (car special-two-vertices) it) candidates-top)))
candidates-bottom
(cadr (--map (cons (cadr special-two-vertices) it) candidates-bottom))
#+end_src
#+RESULTS:
| (94532 50249) | 5639 | 68743 |
#+begin_src emacs-lisp
largest-good-rect
#+end_src
#+RESULTS:
| (5639 68743) | 94532 | 50249 |
(area largest-good-rect)
1644057540
Of course it would be too costly to check for every square in the
candidate rects, so we first remove rectangles that cannot work for a
number of reasons; since vertices are unique, if a vertex sits
strictly inside a rectangle, the rectangle must have some bad tiles
inside. We call a rect _reasonable_ if such a thing does not happen.
#+begin_src emacs-lisp
(setq rects (symmetric-pairs data))
(defun strictly-contains-p (rect p)
(let ((minx (min (caar rect) (cadr rect)))
(maxx (max (caar rect) (cadr rect)))
(miny (min (cadar rect) (caddr rect)))
(maxy (max (cadar rect) (caddr rect)))
(px (car p))
(py (cadr p)))
(and (< minx px) (< px maxx)
(< miny py) (< py maxy))))
(setq reasonable-rects
(-remove (lambda (rect) (--any (strictly-contains-p rect it) data)) rects))
(length reasonable-rects)
#+end_src
Nice, that is an OK number.
Since a rectangle is reasonable, possible edges that cut through it
would have to do through all of it. We can thus check along the edges
only
#+begin_src emacs-lisp
(defun whole-rect-inside-p (rect)
(let ((minx (min (caar rect) (cadr rect)))
(maxx (max (caar rect) (cadr rect)))
(miny (min (cadar rect) (caddr rect)))
(maxy (max (cadar rect) (caddr rect))))
;; Check along the minx column and miny row
(and (--every (inside-p minx it) (-iota (- maxy miny) miny))
(--every (inside-p it miny) (-iota (- maxx minx) minx)))))
;; find corners that lie on the leftmost coordinate; the domain must
;; be to their right it appears that there are only two such corners;
;; take the first one, and the outgoing direction; it is going down
;; and it must come from the right, so it should be (-1 0) . (0 1)
(setq sorted-reasonable-rects (--sort (> (area it) (area other)) reasonable-rects))
#+end_src
Grab some popcorn, this will take a while
#+begin_src emacs-lisp
(let ((num 0))
(setq largest-good-rect (--first (progn
(message (format "%d" (setq num (1+ num))))
(whole-rect-inside-p it))
sorted-reasonable-rects)))
#+end_src
#+RESULTS:
| (5639 68743) | 94532 | 50249 |
(area largest-good-rect)
1644094530
1644057540 ; it does not work.
*
(setq orientation (-last-item (car (--filter (= (caar it) leftmost) data-corners))))
;; We therefore know what corners are convex and what corners are concave
*
** This is old stuff
#+begin_src emacs-lisp :results none
(defun corner-normal (corner)
(let* ((cor (cdr corner))
(a (caar cor))

Loading…
Cancel
Save