aoc18/day4.lisp -rw-r--r-- 3.2 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
90
91
92
93
94
95
96
97
98
99
(in-package :aoc18)

(defun parse-date (in)
  (cl-ppcre:register-groups-bind ((#'parse-integer year month day hour minute)) ("(.*)-0*(.*)-0*(.*) 0?(.*):0?(.*)" in)
    (+ (* year (* 366 31 1440)) (* month (* 31 1440)) (* day 1440) (* hour 60) minute)))

(defstruct log-entry
  (date nil)
  (event nil))

(defun parse-log-entry (in)
  (cl-ppcre:register-groups-bind ((#'parse-date date) event) ("\\[(.*)\\] (.*)" in)
    (make-log-entry :date date :event event)))

(defun new-guard-p (log)
  (cl-ppcre:register-groups-bind ((#'parse-integer id)) ("Guard #(.*) begins shift" (log-entry-event log))
    id))

(defun collect-guards-times (input)
  (let ((gtimes (make-hash-table))
	(current-guard nil)
	(current-start nil))
    (loop for log in input do
	 (cond
	   ((new-guard-p log) (setf current-guard (new-guard-p log)
				    current-start nil))
	   ((not current-start) (setf current-start (log-entry-date log)))
	   (t (let ((diff (- (log-entry-date log) current-start))
		    (l (gethash current-guard gtimes '())))
		(setf (gethash current-guard gtimes) (cons (list diff current-start (log-entry-date log)) l)
		      current-start nil)))))
    gtimes))

(defun total-guard-time (intervals)
  (apply #'+ (mapcar #'car intervals)))

(defun find-best-guard (h)
  (let ((best-id 0)
	(best-total 0)
	(best-intervals 0))
    (loop for id being the hash-keys of h using (hash-value interval) do
	 (when (> (total-guard-time interval) best-total)
	   (setf best-total (total-guard-time interval)
		 best-id id
		 best-intervals interval)))
    (list best-id (mapcar #'cdr best-intervals))))

(defun sleep-minutes (intervals)
    (let ((table (make-array 60 :initial-element 0 :element-type 'fixnum)))
      (loop for interval in intervals do
	   (loop for i from (nth 0 interval) below (nth 1 interval) do
		(incf (aref table (mod i 60)))))
      table))

(defun most-asleep-minute-from-table (table)
    (let ((best-min 0)
	  (best-min-val))
      (loop for i from 0 below 60 do
	   (when (> (aref table i) (aref table best-min))
	     (setf best-min i
		   best-min-val (aref table i))))
      best-min))

(defun most-asleep-minute (intervals)
  (most-asleep-minute-from-table (sleep-minutes intervals)))

(defun solve-day4-part1 (input)
  (let* ((times (collect-guards-times input))
	 (best (find-best-guard times))
	 (best-intervals (nth 1 best))
	 (best-min (most-asleep-minute best-intervals)))
    (* (car best) best-min)))

(test day4-part1-test-input
  (is (= 240 (solve-day4-part1 (mapcar #'parse-log-entry (read-lines "day4.test.input"))))))

(test day4-part1
  (is (= 39422 (solve-day4-part1
		(sort (mapcar #'parse-log-entry (read-lines "day4.input")) #'< :key #'log-entry-date)))))

(defun solve-day4-part2 (input)
  (let ((best-min 0)
	(best-id 0)
	(best-val 0))
    (loop for id being the hash-key of (collect-guards-times input) using (hash-value int) do
	 (let* ((intervals (mapcar #'cdr int))
		(table (sleep-minutes intervals))
		(min (most-asleep-minute-from-table table))
		(val (aref table min)))
	   (when (> val best-val)
	     (setf best-min min
		   best-id id
		   best-val val))))
    (* best-min best-id)))

(test day4-part2
  (is (= 65474 (solve-day4-part2
		(sort (mapcar #'parse-log-entry (read-lines "day4.input")) #'< :key #'log-entry-date)))))