From 4d7762fdafc63dc36687e3d664e12faa7afb00af Mon Sep 17 00:00:00 2001 From: Peter Tillemans Date: Sat, 30 Nov 2024 15:48:59 +0100 Subject: [PATCH] solved day 6 2018 --- .dir-locals.el | 4 ++ README.org | 12 ++++++ aoc.asd | 1 + src/2018/day06.lisp | 85 +++++++++++++++++++++++++++++++++++++-- test/2018/day06-test.lisp | 14 +++++-- tests/main.lisp | 5 +-- 6 files changed, 110 insertions(+), 11 deletions(-) create mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..9f73a07 --- /dev/null +++ b/.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")))) diff --git a/README.org b/README.org index 1483a2a..07a94d2 100644 --- a/README.org +++ b/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) diff --git a/aoc.asd b/aoc.asd index 7ae8af8..4454f0e 100644 --- a/aoc.asd +++ b/aoc.asd @@ -12,6 +12,7 @@ #:cl-cookie #:plump #:lquery + #:3d-vectors #:array-operations #:lla) :components ((:module "src" diff --git a/src/2018/day06.lisp b/src/2018/day06.lisp index 75f4921..eb96e61 100644 --- a/src/2018/day06.lisp +++ b/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)) diff --git a/test/2018/day06-test.lisp b/test/2018/day06-test.lisp index fa52535..22ccd8b 100644 --- a/test/2018/day06-test.lisp +++ b/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)))) diff --git a/tests/main.lisp b/tests/main.lisp index c4b3a60..2324ece 100644 --- a/tests/main.lisp +++ b/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)))