aoc18/day10.lisp -rw-r--r-- 2.9 KiB View raw
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(in-package :aoc18)

(defstruct light
  (pos nil)
  (speed nil))

(defun parse-light-cords (line)
  (cl-ppcre:register-groups-bind
      ((#'parse-integer x y dx dy))
      ("position=<(.*), (.*)> velocity=<(.*), (.*)>" line)
    (make-light :pos (make-cord :x x :y y)
		:speed (make-cord :x dx :y dy))))

(defun read-day10-input (path)
  (mapcar #'parse-light-cords (read-lines path)))

(defun find-bounding-box (lights)
  (let* ((positions (mapcar #'light-pos lights))
	 (xcords (sort (mapcar #'cord-x positions) #'<))
	 (ycords (sort (mapcar #'cord-y positions) #'<))
	 (xmin (car xcords))
	 (xmax (car (last xcords)))
	 (ymin (car ycords))
	 (ymax (car (last ycords))))
    (values xmin xmax ymin ymax)))

(defun lights-size (lights)
  (multiple-value-bind (xmin xmax ymin ymax) (find-bounding-box lights)
    (* (- xmax xmin)
       (- ymax ymin))))

(defun draw-lights-to-arr (lights)
  (multiple-value-bind (xmin xmax ymin ymax) (find-bounding-box lights)
    (let* ((w (1+ (+ (abs xmin) (abs xmax))))
	   (h (1+ (+ (abs ymin) (abs ymax))))
	   (xoff (abs xmin))
	   (yoff (abs ymin))
	   (cords (mapcar #'light-pos lights))
	   (cords-set (make-hash-table :test #'equalp))
	   (arr (make-array (list h w) :initial-element #\. :element-type 'standard-char)))
      (loop for pos in cords do
	   (setf (gethash pos cords-set) t))
      (loop for y from ymin to ymax do
	   (loop for x from xmin to xmax do
		(when (gethash (make-cord :x x :y y) cords-set)
		  (setf (aref arr (+ yoff y) (+ xoff x)) #\#))))
      arr)))

(defun draw-2d-arr (a &optional (w 0) (h 0))
  (loop for y from (- (array-dimension a 0) h) below (array-dimension a 0) do
       (loop for x from (- (array-dimension a 1) w) below (array-dimension a 1) do
	    (format t "~a" (aref a y x)))
       (format t "~%")))

(defun move-light-cord (pos speed)
  (make-cord :x (+ (cord-x pos) (cord-x speed))
	     :y (+ (cord-y pos) (cord-y speed))))

(defun make-light-step (lights)
  (let* ((start-pos (mapcar #'light-pos lights))
	 (speed (mapcar #'light-speed lights))
	 (new-pos (mapcar #'move-light-cord start-pos speed)))
    (mapcar #'(lambda (p s) (make-light :pos p :speed s)) new-pos speed)))

(defun find-message-in-lights (lights steps)
  (let ((current lights))
    (loop for step from 0 below steps do
	 (setf current (make-light-step current))
	 (multiple-value-bind (xmin xmax ymin ymax) (find-bounding-box current)
	   (let ((w (- xmax xmin))
		 (h (- ymax ymin)))
	     (when (< h 10) ; letter height
	       (format t "step ~a~%" (1+ step))
	       (draw-2d-arr (draw-lights-to-arr current) (1+ w) (1+ h))
	       (return-from find-message-in-lights)))))))

(defun string->file (name content)
    (with-open-file (stream name
        :direction :output
        :if-exists :overwrite
        :if-does-not-exist :create)
    (format stream content)))

(defun day10-solve (input)
  (find-message-in-lights input 20000))

;; solution can be found using this expression:
;; (day10-solve (read-day10-input "day10.input"))