solved day 6 2018

.dir-locals.el

@@ -0,0 +1,4 @@
+;;; Directory Local Variables            -*- no-byte-compile: t -*-
+;;; For more information see (info "(emacs) Directory Variables")
+
+((lisp-mode . ((inferior-lisp-program . "sbcl"))))

README.org

@@ -39,6 +39,18 @@ A comprehensive HTTP client library.
 The library leverages the *cl-cookie* library for cookie management.
 
 
+**** 3d-vector
+
+see [[https://shinmera.github.io/3d-vectors/][github pages for 3d-vectors libraray]].
+
+offer 2, 3 and 4  component vectors
+
+- constructor : vec , e.g. (vec 1 2 3) --> vec3
+- operators : v+, v-, v*, v/
+- operators applied on first vector : nv+, nv-, nv*, nv/
+- manhattan : v1norm
+- euclides: v2norm
+
 ** Copyright
 
 Copyright (c) 2024 Peter Tillemans (pti@snamellit.com)

aoc.asd

@@ -12,6 +12,7 @@
                #:cl-cookie
                #:plump
                #:lquery
+	       #:3d-vectors
                #:array-operations
                #:lla)
   :components ((:module "src"

src/2018/day06.lisp

@@ -1,5 +1,5 @@
 (defpackage :aoc/2018/06
-  (:use :cl :aoc)
+  (:use :cl :aoc :alexandria)
   (:export
    #:vector-2d
    #:make-vector-2d
@@ -19,9 +19,6 @@
 (defvar input-data '())
 (setf input-data (map 'list #'parse-line (test-input 2018 6)))
 
-(defvar input-data '())
-(setf input-data (map 'list #'parse-line (test-input 2018 6)))
-
 (defstruct vector-2d
   (x 0 :type fixnum)
   (y 0 :type fixnum))
@@ -51,6 +48,9 @@
 (defvar sample-points (make-vectors sample-data))
 (setf sample-points (make-vectors sample-data))
 
+(defvar input-points)
+(setf input-points (make-vectors input-data))
+
 (defun top-left (vectors)
   (let ((x-min (apply #'min (map 'list #'vector-2d-x vectors) ))
         (y-min  (apply #'min (map 'list #'vector-2d-y vectors) )))
@@ -61,3 +61,80 @@
         (y-max  (apply #'max (map 'list #'vector-2d-y vectors) )))
     (make-vector-2d :x x-max :y y-max)))
 
+(defun add-distance (p1 points)
+  (mapcar (lambda (p) (list (manhattan-distance p1 p) p)) points))
+
+(defun closest-distance-points (p1 points)
+  (reduce
+   (lambda (a b)
+     (cond
+       ((< (first b) (first a)) b)
+       ((= (first b) (first a)) (append a (list b)))
+       (t a)))
+   (add-distance p1 points)))
+
+(defun calc-areas (points tl br)
+  (let ((area-table (make-hash-table)))
+    
+    (defun update-area-table (x y)
+      (let* ((p (make-vector-2d :x x :y y))
+	     (closest-points (rest (closest-distance-points p points))))
+	(if (= 1 (length closest-points))
+	    (incf (gethash (first closest-points) area-table 0)))))
+    
+    (loop for x from (vector-2d-x tl) to (vector-2d-x br)
+	  collect (loop for y from (vector-2d-y tl) to (vector-2d-y br)
+			do (update-area-table x y)))
+    area-table))
+
+
+(defun remove-closest (p1 points)
+  (let ((closest (rest (closest-distance-points p1 points))))
+    (reduce (lambda (acc x) (remove x acc)) closest :initial-value points)))
+
+(defun boundary-points (tl br)
+  (append
+   (loop for x from (vector-2d-x tl) to (vector-2d-x br)
+	 collect (make-vector-2d :x x :y (vector-2d-y tl)))
+   (loop for x from (vector-2d-x tl) to (vector-2d-x br)
+	 collect (make-vector-2d :x x :y (vector-2d-y br)))
+   (loop for y from (1+ (vector-2d-y tl)) to (1- (vector-2d-y br))
+	 collect (make-vector-2d :x (vector-2d-x tl) :y y))
+   (loop for x from (1+ (vector-2d-x tl)) to (1- (vector-2d-x br))
+	 collect (make-vector-2d :x x :y (vector-2d-y br)))))
+
+(defun closest-to-boundary (points tl br)
+  (remove-duplicates
+   (loop for p in (boundary-points tl br)
+	 for closest = (rest (closest-distance-points p points))
+	 if (= 1 (length closest))
+	   collect (first closest))))
+
+
+(defun closed-areas (points)
+  (let* ((tl (top-left points))
+	 (br (bottom-right points))
+	 (areas (calc-areas points tl br))
+	 (open-points (closest-to-boundary points tl br)))
+    (loop for pos being the hash-key in areas
+	  and area being the hash-value in areas
+	  if (not (member pos open-points))
+	    collect area)))
+
+(defun part1 (points)
+  (reduce #'max (closed-areas points)))
+
+(defun total-distance (p points)
+  (reduce (lambda (acc x) (+ acc (manhattan-distance p x))) points :initial-value 0))
+
+(defun safe-area (points max-distance)
+
+  (let ((tl (top-left points))
+	(br (bottom-right points)))
+    (loop for x from (vector-2d-x tl) to (vector-2d-x br)
+	  sum (loop for y from (vector-2d-y tl) to (vector-2d-y br)
+		    for p = (make-vector-2d :x x :y y)
+		    count (> max-distance (total-distance p points))))))
+
+(defun part2 (points &optional (max-distance 10000))
+  (safe-area points max-distance))

test/2018/day06-test.lisp

@@ -1,17 +1,23 @@
-(defpackage :aoc/2018/06
-  (:use :cl :aoc :aoc/tests :parachute))
+(defpackage :aoc/2018/06/tests
+  (:use :cl :aoc :aoc/tests :parachute :aoc/2018/06)
+  (:export
+   #:suite-2018-06
+   #:test-find-top-left
+   #:test-find-bottom-right
+   #:test-manhattan-distance
+   ))
 
 (in-package :aoc/2018/06/tests)
 
 (define-test suite-2018-06
   :parent suite-2018)
 
-(define-test+run find-top-left
+(define-test+run test-find-top-left
   :parent suite-2018-06
   (let ((result (top-left sample-points)))
     (true (equalp (make-vector-2d :x 1  :y 1) result))))
 
-(define-test+run find-bottom-right
+(define-test+run test-find-bottom-right
   :parent suite-2018-06
   (let ((result (bottom-right sample-points)))
     (true (equalp (make-vector-2d :x 8 :y 9) result))))

tests/main.lisp

@@ -1,6 +1,7 @@
 (defpackage aoc/tests
   (:use :cl :aoc :parachute
-   :aoc/2018/06 ))
+   :aoc/2018/06/tests )
+  (:export #:suite-2018))
 
 (in-package :aoc/tests)
 
@@ -9,12 +10,10 @@
 ;; top of test suite tree
 (define-test aoc-suite)
 
-
 ;; suite for every year
 (define-test suite-2018
   :parent aoc-suite)
 
-
 (define-test  "should (= 1 1) to be true"
   :parent aoc-suite
   (true (= 1 1)))