mht.wtf

A blog about computer science, programming, and whatnot.

Advent of Common Lisp, Day 1-4

December 4, 2018 back to posts

The only exposure that I have to Common Lisp is that I wrote about 1000 lines of it about 4 years ago. Since I don’t have any excuse to write CL day-to-day, the days since I last typed defun seems to have added up. Luckily, the Advent of Code is upon us, which is a great way of learning a new language or brushing dust of old skills of a language you once knew; I’m taking the opportunity to finally write me some Common Lisp.

Common Lisp, Emacs, Slime, and QuickLisp

People seem to say that the way of writing CL is in Emacs using Slime; I am a long going vim addict, but I have spend the last few months in Spacemacs, in order to see what I’ve been missing out on, so being pressured into using Emacs isn’t all that bad.

I’m still not sure exactly what Slime is, but it seems to be something that allows me to write code in emacs, and send it to a Lisp process, which sounds useful enough. Oh, and it also has a debugger which, though a little difficult to use, looks promising. Slime is installed using package-install, like most other things in the emacs world.

Installing QuickLisp

QuickLisp is a library manager for Common Lisp, and it comes in handy when we want to do something that the standard library doesn’t offer but that we don’t want to write ourselves. Installing quicklisp is rather easy, and the process is pretty much described on its website. We download a file quicklisp.lisp, load it with sbcl --load <path-to-file>, and that’s it. Now all we must do is evaluate (load "~/quicklisp/setup.lisp") in Lisp, and we’re ready to go.

Reading Input

We will probably read input from a file every day, so having a function that returns a list of strings, one for each line, makes sense. uiop is a library that comes with asdf and contains the function uiop:read-file-lines which does exactly this. This is the function we will be using, if nothing else is mentioned.

Day 1

Part 1

The first challenge was simple enough: sum a list of numbers. This is straight forward in any Lisp, provided you remember whether the function is called fold or reduce:

(defparameter *input-1* (mapcar #'parse-integer (uiop:read-file-lines "1.input")))
(defun day-1/1 (numbers)
  (reduce #'+ numbers))

Part 2

The second part is slightly worse: we are asked to keep track of all partial sums through the list and see what sum we get twice first. In addition, if no collisions are found throughout the first iteration of the list, we should restart, while keeping the accumulated sum.

I first attempted using the loop macro:

(defun day-1/2-loop (numbers)
  (loop for n in (cons 0 numbers)
        summing n into freq
        when (find n seen)
          return freq
        append (list freq) into seen))

One quirk with this attempt is that append seemingly want a list as its first argument, and not the element you are appending — we’re really just joining two lists — so we construct the first list explicitly. A worse thing about this is that this function only runs through the list once. After spending 15 minutes looking at tutorials, cookbooks, and other documentation, looking for a way to just repeat the for loop if we exhaust the list, I guessed that it’s not possible using loop, so I rewrote it using a much worse looking recursive function:

(defun day-1/2-list (numbers)
  (labels ((inner (numbers current freq seen)
                 (if (current)
                     (if (find freq seen)
                         freq
                         (inner numbers 
                                (cdr current) 
                                (+ freq (car current)) 
                                (cons freq seen)))
                     (inner numbers numbers freq seen))))
  (inner numbers numbers 0 nil)))

Since we’re checking through the seen list in each call, this is has squared complexity. Looking at the runtime, it shows:

(time (day-1/2-list *input-1*))
Evaluation took:
  54.224 seconds of real time
  54.176661 seconds of total run time (54.173330 user, 0.003331 system)
  99.91% CPU
  157,466,185,510 processor cycles
  2,162,688 bytes consed
  
219

One option of improving this is to use a hash table instead of a list for seen:

(defun day-1/2-ht (numbers)
  (let ((seen (make-hash-table)))
    (labels ((inner (numbers current freq)
                    (if current
                        (if (gethash freq seen)
                            freq
                            (progn (setf (gethash freq seen) t)
                                (inner numbers (cdr current) (+ freq (car current)))))
                        (inner numbers numbers freq))))
      (inner numbers numbers 0))))

As one would expect the running time is much better now:

(time (day-1/2-ht *input-1*))
Evaluation took:
  0.026 seconds of real time
  0.025140 seconds of total run time (0.025136 user, 0.000004 system)
  [ Run times consist of 0.007 seconds GC time, and 0.019 seconds non-GC time. ]
  96.15% CPU
  73,008,592 processor cycles
  20,931,664 bytes consed
  
219

Day 2

Part 1

The task of the second day amounts to checking whether a string contains exactly two or exactly three of any character. Since we’ve seen that list processing in Lisp can be quite slow, I want to go for a more traditional solution:

  1. Turn the String into an Array.
  2. Sort the Array.
  3. Loop through and count the length of equal character runs.

As it turns out, Strings in Common Lisp are already Arrays: off to a good start. Next we want to sort it. Running (describe #'sort) tells me the following:

* (describe #'sort)
#<FUNCTION SORT>
  [compiled function]


Lambda-list: (SEQUENCE SB-IMPL::PREDICATE &REST SB-IMPL::ARGS &KEY
              SB-IMPL::KEY)
Dynamic-extent arguments: positional=(1), keyword=(:KEY)
Declared type: (FUNCTION
                (SEQUENCE (OR FUNCTION SYMBOL) &REST T &KEY
                 (:KEY (OR FUNCTION SYMBOL)))
                (VALUES SEQUENCE &OPTIONAL))
Documentation:
  Destructively sort SEQUENCE. PREDICATE should return non-NIL if
     ARG1 is to precede ARG2.
Inline proclamation: MAYBE-INLINE (inline expansion available)
Known attributes: call
Source file: SYS:SRC;CODE;SORT.LISP

There are a few things to note here. First off, we need to pass a predicate, since sort doesn’t know the types of the values that we want to sort, so we need to find a character comparing function. In addition, sort destructively sorts the sequence; this should be fine (even preferable), but we need to take that into account. Browsing lispcookbook we find an example using a function char=, so we guess there is a function char<.

* (sort "hello world" #'char<)
" dehllloorw"

Great! Now that we have a sorted Array of the characters we loop through the Array and increment a counter if there is exactly two or three equal characters. Something like this should work:

(defun count-runs-2-3 (string)
  (let ((arr (sort string #'char<))
        (2-count 0)
        (3-count 0)
        (prev-char #\NULL)
        (curr-count 0))
    (loop for c across arr
          if (char= prev-char c) do (incf curr-count)
          else do (progn
                    (case curr-count
                      (2 (incf 2-count))
                      (3 (incf 3-count))
                      (otherwise))
                    (setf prev-char c)
                    (setf curr-count 1)))
    (case curr-count    ; Don't forget adding the last run
      (2 (incf 2-count))
      (3 (incf 3-count))
      (otherwise))
    (list 2-count 3-count)))

Now we can loop through each line in the input file and sum to two counters, one for 2 runs, and one for 3 runs. However, if there are multiple runs, they should only count as one. While this could have been done in count-runs-2-3, we might as well make 1-if-pos, and handle it in the summing.

(defun 1-if-pos (x) (if (< 0 x) 1 0))

(defun day-2/1 (input)
  (loop for line in input
        for tuple = (count-runs-2-3 line)
        summing (1-if-pos (first tuple)) into 2-sum
        summing (1-if-pos (second tuple)) into 3-sum
        finally (return (* 2-sum 3-sum))))

This solves part 1.

Part 2

In the second part we are asked to find a pair of strings in the input that differs by exactly one character. By this time I realize that the destructive sorting has messed up my input variables:

*test-input-2*
("abcdef" "aabbbc" "abbcde" "abcccd" "aabcdd" "abcdee" "aaabbb")

Oops! Instead of fixing this (eg. by cloning the strings before sorting, or find out whether sort offers an option to be non-destructive) I’ll just leave it as is, and read the input file again.

In any case, there’s a few different ways we can do part 2. The simplest is just to check all pairs, calculate the difference, and output the pair if the difference is two.

First we need to find all pairs of elements in a list. Again, after looking at loop for a while I couldn’t find anything useful (discoverability is hard!), so I decided to roll my own:

(defun all-pairs (list)
  (if list
      (let ((head (car list))
            (rest (cdr list)))
        (append (mapcar (lambda (e) (list head e)) rest)
                (all-pairs rest)))))

Now, this isn’t quite correct: (all-pairs '(1)) returns NIL, but with exception of this case the function seems to do the trick. Next we need to count the number of different chars in a pair. Again we’re doing the simplest thing possible:

(defun count-difference (first second)
  (loop for i from 0 below (length first)
        for a = (char first i)
        for b = (char second i)
        counting (not (char= a b)) into diffs
        finally (return diffs)))

Now we can find the two strings that differ in exactly one position. However, the task asks us to find the portion of the two strings that are the same, and not the two strings themselves, so we need yet another function:

(defun remove-equals (first second)
  (with-output-to-string (out)
    (loop for i from 0 below (length first)
          for a = (char first i)
          for b = (char second i)
          when (char= a b) do (write-char a out))))

Now the final function for today’s task is done:

(defun day-2/2 (input)
  (loop for (a b) in (all-pairs input)
        when (eq (count-difference a b) 1)
        do (return (remove-equals a b))))

I figured that since we have consequently done the simplest, and probably the least efficient things, running the function on the input would take some time:

(time (day-2/2 *input-2*))
Evaluation took:
  0.012 seconds of real time
  0.011565 seconds of total run time (0.008236 user, 0.003329 system)
  100.00% CPU
  33,790,325 processor cycles
  1,998,496 bytes consed
  
"mbruvapghxlzycbhmfqjonsie"

… but apparently not. One simple optimization we could have done is early return from ‘count-difference’, since we only care if the difference is 1 or not. Had the strings been very long this could have been significantly faster; our strings are only 25 chars long, so for our input it doesn’t matter much, at least not wall clock wise:

(time (day-2/2-opt *input-2*))
Evaluation took:
  0.007 seconds of real time
  0.006663 seconds of total run time (0.000033 user, 0.006630 system)
  100.00% CPU
  19,506,926 processor cycles
  1,998,496 bytes consed
  
"mbruvapghxlzycbhmfqjonsie"

~5ms less in real time, but only 66% of the CPU cycles.

Day 3

Part 1

Day three is here, and the first task of today is to parse lines of the format #<id> @ <x>,<y>: <w>x<h>, like #1 @ 1,3: 4x4. This sounds like a regex job! Which means we must figure out how to regex in Common Lisp.

The Cookbook informs us that there is not support for regex in the standard library, but that packages, like cl-ppcre exist. Let’s try

* (ql:quickload "cl-ppcre")
To load "cl-ppcre":
  Load 1 ASDF system:
    asdf
  Install 1 Quicklisp release:
    cl-ppcre
; Fetching #<URL "http://beta.quicklisp.org/archive/cl-ppcre/2018-08-31/cl-ppcre-20180831-git.tgz">
; 151.37KB
==================================================
155,003 bytes in 0.00 seconds (151370.13KB/sec)
; Loading "cl-ppcre"
[package cl-ppcre]................................
..........................
("cl-ppcre")

Fancy!

Ideally we would be able to write our regex with group names, match each line, and retrieve the groups by name. Identifying groups by index is also fine. Looking through the docs it seems like *allow-named-registers* is somewhat important here, so we set it to t and try ppcre:scan:

(ppcre:scan "(?<num>[0-9]+)" "number is 1234 lol")

10
14
#(10)
#(14)

It seems to work fine — we’re presumably getting out start and end index of our match — but our name num is nowhere to be seen in the return values. We are maybe meant to use something else than scan, but this seems strange, since the docs for *allow-named-registers* mostly used scan. Looking further in the docs, and with a little inspiration from the cookbook we end up with

* (ppcre:register-groups-bind (a b)
	 ("([0-9]+).*(lol)" "number is 1234 lolxD")
   (list a b))
("1234" "lol")

We didn’t get to set the name in the regex itself, but this seems alright. Now we can write our regex:

* (defun day-3/match-line (line)
  (ppcre:register-groups-bind (id x y w h)
                              ("#(\\d+) @ (\\d+),(\\d+): (\\d+)x(\\d+)" line)
                              (list id x y w h)))

* (day-3/match-line "#1 @ 1,3: 4x4")
("1" "1" "3" "4" "4")

Good! Now we’re able to parse the input

The actual first task of the day is to find the number of overlapping tiles of the squares defined by the lines we just parsed. The one solution that first comes to mind is to have a hash map mapping coordinates to number of squares touching them.

Now the plan is to parse the line into something that is easier to work with, loop through all points in the rectangle, and insert them into a hash map. Perhaps something like this:

(defstruct rect x y w h)
(defstruct point x y)

(defun day-3/insert-coordinates (rect hashmap)
  (loop for y from (rect-y rect) below (+ (rect-y rect) (rect-h rect))
        do (loop for x from (rect-x rect) below (+ (rect-x rect) (rect-w rect))
                 do (incf (gethash (make-point :x x :y y) hashmap)))))

(defun day-3/1 (input)
  (let ((hashmap (make-hash-table)))
    (day-3/insert-coordinates (make-rect :x 0 :y 0 :w 3 :h 3) hashmap)
		;; For now we print out the map so we can see if we succeeded or not
    (loop for key being the hash-keys of hashmap
          do (format t "~S -> ~S" key (gethash key hashmap)))))

… but day-3/insert-coordinates isn’t quite right, since we cannot incf a value when it is not present in the map. For this we try to write a new function:

(defun inc-or-1 (key hashmap)
  (let ((entry (gethash key hashmap)))
    (if entry
        (incf entry)
      (setf entry 1))))

The idea is that by having the let we 1) have less code, and 2) might not need to lookup into the hash table twice. However, this doesn’t work:

* (defparameter my-map (make-hash-table))
MY-MAP
* (inc-or-1 123 my-map)
1
* (inc-or-1 123 my-map)
1
* (inc-or-1 123 my-map)
1

Apparently, we are required to use (setf (gethash key table) value), and cannot go through the let. Okay.

(defun inc-or-1 (key hashmap)
  (if (gethash key hashmap)
      (incf (gethash key hashmap))
    (setf (gethash key hashmap) 1)))

(inc-or-1 123 my-map)
1
* (inc-or-1 123 my-map)
2
* (inc-or-1 123 my-map)
3
* 

Good. Updating day-3/insert-coordinates to use inc-or-1 rather than setf directly causes us to print out the coordinates correctly. Now it’s just a matter of changing the print loop in day-3/1 to two loops: first parse and insert all input lines, then count the number of points which count is more than 1.

(defun day-3/1 (input)
  (let ((hashmap (make-hash-table)))
    (loop for line in input
          do (day-3/insert-coordinates (day-3/match-line line) hashmap))
    (loop for key being the hash-keys of hashmap
          counting (< 1 (gethash key hashmap)) into collisions
          finally (return collisions))))

Reading the test input we’re given into *test-input-3* and running gives us:

* (day-3/1 *test-input-3*)
The value
  "3"
is not of type
	NUMBER
when binding SB-KERNEL::X
  [Condition of type TYPE-ERROR]

Ooops! We can change one line in day-3/match-line to

  (ppcre:register-groups-bind ((#'parse-integer id x y w h))

which apparently works. This is pretty much macro magic if you ask me. However, our solution still doesn’t work:

* (day-3/1 *test-input-3*)
0

There is a few things that could have gone wrong. Input parsing, count incrementing (though we somewhat checked this), count printing, or messing up indices. After a quick format debugging session, I see what’s wrong: when printing out the keys in the hashmap, there are multiple “equal” keys being shown! We must tell the hashmap how to compare keys! … or, maybe it’s hashing to different values?

Now, make-hash-table do take a :test argument. However, according to this site, this is only allowed to be either #'eq, #'eql, or #'equal, neither of which helps. Luckily, LispWorks helps us out by saying that it can in fact also be #'equalp, and this fixes our bug.

(day-3/1 *test-input-3*)
4

Which means that we have finally solved part 1!

Part 2

We spent quite a bit of time on part 1. Luckily, when we have this setup, part 2 does not take that long. We are asked to find the line in the input that does not overlap with any other line. This property only holds for a single line. We can do this in the following way: have a set of all lines that have not overlapped with any other yet. When we are adding counts into the hashmap, we detect overlaps (if the point is already there). Then we can remove the current line from the set of non-overlapping lines. When we are done only one line should remain.

This doesn’t quite work though, since the first rectangle somewhere doesn’t know that some other rectangle overlapped with it. In order to fix this we map point to id in the hashmap, so that when a rectangle finds another rectangle that it overlaps with, it has both ids, and can remove both from the list of non-overlapping ids. Now all consecutive lines that overlap with this line will also attempt to remove the line from the unique set, but this is fine.

(defun day-3/2 (input)
  (let ((map (make-hash-table :test #'equalp))
        (unique (make-hash-table)))
    (loop for line in input
          do (let ((rect (day-3/match-line line)))
               (setf (gethash (rect-id rect) unique) t)
               (loop for y from (rect-y rect)
                           below (+ (rect-y rect) (rect-h rect))
                     do (loop for x from (rect-x rect) 
                                    below (+ (rect-x rect) (rect-w rect))
                              do (let ((p (make-point :x x :y y)))
                                   (if (gethash p map)
                                       (progn (remhash (gethash p map) unique)
                                              (remhash (rect-id rect) unique))
                                       (setf (gethash p map) (rect-id rect)))))))
          finally (return (loop for key being the hash-keys of unique return key)))))

Figuring out that I had to finally (return (loop took me 15 minutes of (format debugging, but this solves it.

Day 4

Day four is upon us, and we continue.

Part 1

Today’s first part is a little convoluted, but there are a few things that come to mind when we want to clean up the data.

  1. Read in the input such that for each guard we have a list of intervals in which they sleep
  2. Make a length 60 array – one for each minute — for each guard, and count the “number of sleeps” they have in that time.

We start off with input reading. One option is to go full regex, as we did yesterday, but we might do just fine without it: the time part of each line always has the same length, so we can index directly into the string on the positions we want, in order to identify which variant of message it is, and extract the data; the only exception begin the guard ID, where we must scan until we find a space, but also here is the starting position known ahead of time.

We can start out by writing a couple of predicates and accessor functions:

(defun guard-line-p (line) (eq (char line 19) #\G))
(defun sleep-line-p (line) (eq (char line 19) #\f))
(defun wake-line-p (line) (eq (char line 19) #\w))
(defun line-mm (line) (parse-integer (subseq line 15 17)))
(defun line-id (line)
  (let ((end (position #\SPACE (subseq line 26))))
    (parse-integer (subseq line 26 (+ 26 end)))))

Now we want to loop through the lines, take out the data we need, and insert it into a hash map that maps guard IDs to a list of intervals when they sleep. This is slightly awkward since we must keep track of when the guard began sleeping until the next iteration when we get the wake-up time. A better structure would be to directly advance the line iterator, while still in the body of the loop, like this pseudo-code (notice how I’m already moving away from lisp syntax):

lines = input.lines()
while line = lines.next() {
  if guard_line(line) { ... }
  else if sleep_line(line) {
    next = lines.next()
    start = line_mm(line)
    end	= line_mm(line)
    ...
 	}
}

Not knowing how one would do something like this in CL, I settled for the traditional state-keeping approach. Here we just print out all values of the hashmap at the end.

(defun day-4/1 (input)
  (let ((guard-sleeps (make-hash-table))
        (sleep-start)
        (current-guard))
    (loop for line in input
          when (guard-line-p line) do (setf current-guard (line-id line))
          when (sleep-line-p line) do (setf sleep-start (line-mm line))
          when (wake-line-p line) do
          (let ((interval (make-interval :from sleep-start :to (line-mm line))))
            (if (gethash current-guard guard-sleeps)
                (push interval (gethash current-guard guard-sleeps))
                (setf (gethash current-guard guard-sleeps) (list interval)))))
    (loop for key being the hash-keys of guard-sleeps
          do (format t "~S -> ~S~%" key (gethash key guard-sleeps)))))

Next we make an array for each guard, and count the number of times the guard has slept through each of the 60 minutes.

(defun day-4/1 (input)
  (let ((guard-arrays (make-hash-table))
				...
    (loop ...
    (loop for guard-id being the hash-keys of guard-sleeps
          do (let ((arr (make-array 60)))
               (loop for interval in (gethash guard-id guard-sleeps)
                     do (loop for i from (interval-from interval) below (interval-to interval)
                          do (incf (aref arr i))))
               (setf (gethash guard-id guard-arrays) arr)))
    (loop for k being the hash-keys of guard-arrays
          do (format t "~S ~S~%" k (gethash k guard-arrays)))))

10 #(0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 0 1 1 1 1 1 1 1
     1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)
99 #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
     1 1 1 2 2 2 2 2 3 2 2 2 2 1 1 1 1 1 0 0 0 0 0)

Based on the table given in the problem description, this looks very plausible. Next up is solving the actual task: we wanted to find the guard that was most asleep, find the minute they spent the most asleep, and multiply that minute with the guards ID.

As a side note, while trying to write this out I ran into some weird problems, and the debugger didn’t help me much due to variables being optimized away. Evaluating

(declaim (optimize (speed 0) (safety 3) (debug 3)))

helped out a lot. In any case, I eventually arrived at something that succeeded with the test input. I’m not too happy with this function: it is pretty messy, but it works. One thing one could do is split the three steps up into three functions, but when things are supposed to happen sequentially I try to avoid splitting the steps up into functions, at least if the only rationale is that one function is “too long” to not be split.

(defun day-4/1 (input)
  (let ((guard-sleeps (make-hash-table))
        (guard-arrays (make-hash-table))
        (sleep-start)
        (current-guard))
    (loop for line in input
          when (guard-line-p line) do (setf current-guard (line-id line))
          when (sleep-line-p line) do (setf sleep-start (line-mm line))
          when (wake-line-p line) do
          (let ((interval (make-interval :from sleep-start :to (line-mm line))))
            (if (gethash current-guard guard-sleeps)
                (push interval (gethash current-guard guard-sleeps))
                (setf (gethash current-guard guard-sleeps) (list interval)))))
    (loop for guard-id being the hash-keys of guard-sleeps
          do (let ((arr (make-array 60)))
               (loop for interval in (gethash guard-id guard-sleeps)
                     do (loop for i from (interval-from interval) below (interval-to interval)
                          do (incf (aref arr i))))
               (setf (gethash guard-id guard-arrays) arr)))
    (let* ((sums (loop for k being the hash-keys of guard-arrays
                      collect (list (reduce #'+ (gethash k guard-arrays)) k)))
           (laziest (second (first (sort sums #'> :key #'car))))
           (arr (gethash laziest guard-arrays))
           (max-freq (reduce #'max arr)))
      (* laziest (position max-freq arr)))))

This, however, didn’t run with the real data; whoever made the input decided to put in one little gotcha, and shuffle all lines. Luckily this is pretty straight forward to fix with a (sort input #'string<). After this, part 1 was solved.

However, the story doesn’t end there. After trying to run it a second time, we get this:

The value
  NIL
is not of type
  REAL
when binding I
  [Condition of type TYPE-ERROR]

Looking at the debugger we’re in a weird situation where we are looping through the keys of guard-sleeps, but the key guard-id is nil. Pressing RET while the cursor is over GUARD-SLEEPS in the backtrace shows us this:

#<HASH-TABLE {1008752283}>
--------------------
Count: 21
Size: 32
Test: EQL
Rehash size: 1.5
Rehash threshold: 1.0
[clear hashtable]
Contents: 
241 = (#S(INTERVAL :FROM 47 :TO 57) #S(INTERVAL :FROM 6 :TO 44) #S(INTERVAL :FROM 40 :TO 50) #S(INTERVAL :FROM 22 :TO 46) #S(INTERVAL :FROM 1 :TO 12) #S(INTERVAL :FROM 46 :TO 52) #S(INTERVAL :FROM 19 :TO 42) #S(INTERVAL :FROM 50 :TO 58) #S(INTERVAL :FROM 56 :TO 57) #S(INTERVAL :FROM 48 :TO 49) #S(INTERVAL :FROM 29 :TO 41) #S(INTERVAL :FROM 41 :TO 49) #S(INTERVAL :FROM 12 :TO 19) #S(INTERVAL :FROM 47 :TO 51) #S(INTERVAL :FROM 31 :TO 42) #S(INTERVAL :FROM 18 :TO 24) #S(INTERVAL :FROM 33 :TO 52) ..) [remove entry]
1213 = (#S(INTERVAL :FROM 53 :TO 57) #S(INTERVAL :FROM 48 :TO 50) #S(INTERVAL :FROM 6 :TO 49) #S(INTERVAL :FROM 46 :TO 57) #S(INTERVAL :FROM 2 :TO 35) #S(INTERVAL :FROM 33 :TO 49) #S(INTERVAL :FROM 18 :TO 56) #S(INTERVAL :FROM 46 :TO 52) #S(INTERVAL :FROM 0 :TO 26) #S(INTERVAL :FROM 21 :TO 42) #S(INTERVAL :FROM 40 :TO 46) #S(INTERVAL :FROM 23 :TO 45) #S(INTERVAL :FROM 17 :TO 55) #S(INTERVAL :FROM 26 :TO 39) #S(INTERVAL :FROM 12 :TO 19)) [remove entry]
2903 = (#S(INTERVAL :FROM 4 :TO 48) #S(INTERVAL :FROM 39 :TO 42) #S(INTERVAL :FROM 34 :TO 40) #S(INTERVAL :FROM 49 :TO 56) #S(INTERVAL :FROM 30 :TO 41) #S(INTERVAL :FROM 54 :TO 58) #S(INTERVAL :FROM 24 :TO 53) #S(INTERVAL :FROM 32 :TO 46) #S(INTERVAL :FROM 56 :TO 59) #S(INTERVAL :FROM 26 :TO 42) #S(INTERVAL :FROM 35 :TO 52) #S(INTERVAL :FROM 27 :TO 47)) [remove entry]
1283 = (#S(INTERVAL :FROM 22 :TO 42) #S(INTERVAL :FROM 56 :TO 59) #S(INTERVAL :FROM 6 :TO 49) #S(INTERVAL :FROM 32 :TO 42) #S(INTERVAL :FROM 9 :TO 21) #S(INTERVAL :FROM 17 :TO 46) #S(INTERVAL :FROM 45 :TO 47) #S(INTERVAL :FROM 13 :TO 55) #S(INTERVAL :FROM 57 :TO 59) #S(INTERVAL :FROM 40 :TO 48) #S(INTERVAL :FROM 26 :TO 52) #S(INTERVAL :FROM 2 :TO 17) #S(INTERVAL :FROM 53 :TO 55) #S(INTERVAL :FROM 19 :TO 47) #S(INTERVAL :FROM 41 :TO 46) #S(INTERVAL :FROM 24 :TO 29) #S(INTERVAL :FROM 22 :TO 52) ..) [remove entry]
829 = (#S(INTERVAL :FROM 40 :TO 50) #S(INTERVAL :FROM 11 :TO 24) #S(INTERVAL :FROM 29 :TO 32) #S(INTERVAL :FROM 37 :TO 45) #S(INTERVAL :FROM 31 :TO 32) #S(INTERVAL :FROM 32 :TO 52) #S(INTERVAL :FROM 20 :TO 39) #S(INTERVAL :FROM 57 :TO 59) #S(INTERVAL :FROM 10 :TO 26) #S(INTERVAL :FROM 4 :TO 39) #S(INTERVAL :FROM 8 :TO 18)) [remove entry]
3347 = (#S(INTERVAL :FROM 36 :TO 46) #S(INTERVAL :FROM 14 :TO 25) #S(INTERVAL :FROM 7 :TO 48) #S(INTERVAL :FROM 18 :TO 56) #S(INTERVAL :FROM 7 :TO 14) #S(INTERVAL :FROM 48 :TO 57) #S(INTERVAL :FROM 9 :TO 53) #S(INTERVAL :FROM 41 :TO 57) #S(INTERVAL :FROM 39 :TO 47) #S(INTERVAL :FROM 33 :TO 34) #S(INTERVAL :FROM 52 :TO 59) #S(INTERVAL :FROM 30 :TO 46) #S(INTERVAL :FROM 41 :TO 46) #S(INTERVAL :FROM 13 :TO 26) #S(INTERVAL :FROM 54 :TO 55) #S(INTERVAL :FROM 23 :TO 48) #S(INTERVAL :FROM 57 :TO 59) ..) [remove entry]
1319 = (#S(INTERVAL :FROM 50 :TO 59) #S(INTERVAL :FROM 2 :TO 37) #S(INTERVAL :FROM 37 :TO 45) #S(INTERVAL :FROM 46 :TO 58) #S(INTERVAL :FROM 0 :TO 31) #S(INTERVAL :FROM 33 :TO 50) #S(INTERVAL :FROM 29 :TO 45) #S(INTERVAL :FROM 1 :TO 42) #S(INTERVAL :FROM 25 :TO 29) #S(INTERVAL :FROM 24 :TO 42) #S(INTERVAL :FROM 50 :TO 55) #S(INTERVAL :FROM 18 :TO 27) #S(INTERVAL :FROM 19 :TO 57) #S(INTERVAL :FROM 29 :TO 35) #S(INTERVAL :FROM 8 :TO 53)) [remove entry]
439 = (#S(INTERVAL :FROM 19 :TO 55) #S(INTERVAL :FROM 33 :TO 39) #S(INTERVAL :FROM 41 :TO 51) #S(INTERVAL :FROM 37 :TO 50) #S(INTERVAL :FROM 9 :TO 53) #S(INTERVAL :FROM 31 :TO 38) #S(INTERVAL :FROM 38 :TO 59) #S(INTERVAL :FROM 14 :TO 25) #S(INTERVAL :FROM 51 :TO 59) #S(INTERVAL :FROM 19 :TO 24) #S(INTERVAL :FROM 5 :TO 32) #S(INTERVAL :FROM 52 :TO 54) #S(INTERVAL :FROM 1 :TO 41) #S(INTERVAL :FROM 51 :TO 56) #S(INTERVAL :FROM 7 :TO 33) #S(INTERVAL :FROM 6 :TO 30) #S(INTERVAL :FROM 24 :TO 57) ..) [remove entry]
2213 = (#S(INTERVAL :FROM 52 :TO 58) #S(INTERVAL :FROM 38 :TO 48) #S(INTERVAL :FROM 54 :TO 57) #S(INTERVAL :FROM 27 :TO 53) #S(INTERVAL :FROM 46 :TO 57) #S(INTERVAL :FROM 30 :TO 43) #S(INTERVAL :FROM 57 :TO 58) #S(INTERVAL :FROM 36 :TO 46) #S(INTERVAL :FROM 6 :TO 29) #S(INTERVAL :FROM 33 :TO 55) #S(INTERVAL :FROM 23 :TO 26)) [remove entry]
3319 = (#S(INTERVAL :FROM 50 :TO 57) #S(INTERVAL :FROM 41 :TO 43) #S(INTERVAL :FROM 10 :TO 36) #S(INTERVAL :FROM 7 :TO 53) #S(INTERVAL :FROM 4 :TO 42) #S(INTERVAL :FROM 35 :TO 58) #S(INTERVAL :FROM 57 :TO 58) #S(INTERVAL :FROM 51 :TO 54) #S(INTERVAL :FROM 3 :TO 19) #S(INTERVAL :FROM 54 :TO 57) #S(INTERVAL :FROM 7 :TO 34) #S(INTERVAL :FROM 56 :TO 59) #S(INTERVAL :FROM 21 :TO 53) #S(INTERVAL :FROM 32 :TO 38) #S(INTERVAL :FROM 42 :TO 46) #S(INTERVAL :FROM 21 :TO 35) #S(INTERVAL :FROM 11 :TO 15) ..) [remove entry]
2539 = (#S(INTERVAL :FROM 42 :TO 51) #S(INTERVAL :FROM 10 :TO 27) #S(INTERVAL :FROM 45 :TO 55) #S(INTERVAL :FROM 33 :TO 35) #S(INTERVAL :FROM 44 :TO 56) #S(INTERVAL :FROM 12 :TO 36) #S(INTERVAL :FROM 43 :TO 57) #S(INTERVAL :FROM 23 :TO 34) #S(INTERVAL :FROM 57 :TO 58) #S(INTERVAL :FROM 15 :TO 39) #S(INTERVAL :FROM 52 :TO 54) #S(INTERVAL :FROM 32 :TO 36) #S(INTERVAL :FROM 7 :TO 22)) [remove entry]
631 = (#S(INTERVAL :FROM 44 :TO 58) #S(INTERVAL :FROM 3 :TO 27) #S(INTERVAL :FROM 51 :TO 56) #S(INTERVAL :FROM 23 :TO 47) #S(INTERVAL :FROM 6 :TO 17) #S(INTERVAL :FROM 50 :TO 56) #S(INTERVAL :FROM 15 :TO 46) #S(INTERVAL :FROM 55 :TO 56) #S(INTERVAL :FROM 1 :TO 49) #S(INTERVAL :FROM 23 :TO 57) #S(INTERVAL :FROM 44 :TO 48) #S(INTERVAL :FROM 3 :TO 29) #S(INTERVAL :FROM 33 :TO 45) #S(INTERVAL :FROM 11 :TO 21)) [remove entry]
2129 = (#S(INTERVAL :FROM 51 :TO 57) #S(INTERVAL :FROM 36 :TO 46) #S(INTERVAL :FROM 42 :TO 43) #S(INTERVAL :FROM 43 :TO 51) #S(INTERVAL :FROM 15 :TO 38) #S(INTERVAL :FROM 54 :TO 59) #S(INTERVAL :FROM 41 :TO 43) #S(INTERVAL :FROM 54 :TO 59) #S(INTERVAL :FROM 6 :TO 47) #S(INTERVAL :FROM 48 :TO 57) #S(INTERVAL :FROM 32 :TO 56) #S(INTERVAL :FROM 38 :TO 54)) [remove entry]
1889 = (#S(INTERVAL :FROM 57 :TO 59) #S(INTERVAL :FROM 30 :TO 35) #S(INTERVAL :FROM 31 :TO 42) #S(INTERVAL :FROM 31 :TO 41) #S(INTERVAL :FROM 39 :TO 40) #S(INTERVAL :FROM 28 :TO 33) #S(INTERVAL :FROM 56 :TO 57) #S(INTERVAL :FROM 29 :TO 34) #S(INTERVAL :FROM 27 :TO 42) #S(INTERVAL :FROM 24 :TO 32) #S(INTERVAL :FROM 57 :TO 59) #S(INTERVAL :FROM 44 :TO 51) #S(INTERVAL :FROM 31 :TO 36) #S(INTERVAL :FROM 22 :TO 36) #S(INTERVAL :FROM 11 :TO 15) #S(INTERVAL :FROM 2 :TO 47) #S(INTERVAL :FROM 27 :TO 50) ..) [remove entry]
2137 = (#S(INTERVAL :FROM 49 :TO 59) #S(INTERVAL :FROM 43 :TO 53) #S(INTERVAL :FROM 4 :TO 47) #S(INTERVAL :FROM 55 :TO 56) #S(INTERVAL :FROM 35 :TO 52) #S(INTERVAL :FROM 50 :TO 55) #S(INTERVAL :FROM 46 :TO 47) #S(INTERVAL :FROM 52 :TO 58) #S(INTERVAL :FROM 23 :TO 26) #S(INTERVAL :FROM 45 :TO 57)) [remove entry]
2251 = (#S(INTERVAL :FROM 22 :TO 38) #S(INTERVAL :FROM 17 :TO 31) #S(INTERVAL :FROM 27 :TO 54) #S(INTERVAL :FROM 8 :TO 22) #S(INTERVAL :FROM 49 :TO 56) #S(INTERVAL :FROM 7 :TO 14) #S(INTERVAL :FROM 12 :TO 35) #S(INTERVAL :FROM 56 :TO 58) #S(INTERVAL :FROM 25 :TO 32) #S(INTERVAL :FROM 3 :TO 20) #S(INTERVAL :FROM 55 :TO 59) #S(INTERVAL :FROM 14 :TO 40) #S(INTERVAL :FROM 52 :TO 55) #S(INTERVAL :FROM 8 :TO 56) #S(INTERVAL :FROM 21 :TO 37)) [remove entry]
2389 = (#S(INTERVAL :FROM 57 :TO 58) #S(INTERVAL :FROM 28 :TO 49) #S(INTERVAL :FROM 5 :TO 22) #S(INTERVAL :FROM 57 :TO 59) #S(INTERVAL :FROM 52 :TO 53) #S(INTERVAL :FROM 13 :TO 20) #S(INTERVAL :FROM 28 :TO 58) #S(INTERVAL :FROM 11 :TO 14) #S(INTERVAL :FROM 42 :TO 54) #S(INTERVAL :FROM 53 :TO 55) #S(INTERVAL :FROM 9 :TO 33) #S(INTERVAL :FROM 51 :TO 55) #S(INTERVAL :FROM 37 :TO 39) #S(INTERVAL :FROM 56 :TO 59) #S(INTERVAL :FROM 15 :TO 48) #S(INTERVAL :FROM 53 :TO 55) #S(INTERVAL :FROM 52 :TO 59) ..) [remove entry]
1777 = (#S(INTERVAL :FROM 46 :TO 51) #S(INTERVAL :FROM 9 :TO 37) #S(INTERVAL :FROM 52 :TO 59) #S(INTERVAL :FROM 36 :TO 39) #S(INTERVAL :FROM 47 :TO 56) #S(INTERVAL :FROM 24 :TO 34) #S(INTERVAL :FROM 48 :TO 52) #S(INTERVAL :FROM 6 :TO 38) #S(INTERVAL :FROM 1 :TO 49) #S(INTERVAL :FROM 53 :TO 58) #S(INTERVAL :FROM 34 :TO 45) #S(INTERVAL :FROM 28 :TO 30) #S(INTERVAL :FROM 10 :TO 58) #S(INTERVAL :FROM 10 :TO 49) #S(INTERVAL :FROM 40 :TO 52) #S(INTERVAL :FROM 15 :TO 35) #S(INTERVAL :FROM 31 :TO 57) ..) [remove entry]
3371 = (#S(INTERVAL :FROM 38 :TO 50) #S(INTERVAL :FROM 8 :TO 15) #S(INTERVAL :FROM 53 :TO 54) #S(INTERVAL :FROM 11 :TO 29) #S(INTERVAL :FROM 27 :TO 53) #S(INTERVAL :FROM 33 :TO 48) #S(INTERVAL :FROM 33 :TO 49) #S(INTERVAL :FROM 39 :TO 52) #S(INTERVAL :FROM 34 :TO 36) #S(INTERVAL :FROM 0 :TO 22) #S(INTERVAL :FROM 51 :TO 57) #S(INTERVAL :FROM 52 :TO 54) #S(INTERVAL :FROM 6 :TO 49) #S(INTERVAL :FROM 38 :TO 57) #S(INTERVAL :FROM 27 :TO 43) #S(INTERVAL :FROM 37 :TO 53) #S(INTERVAL :FROM 0 :TO 28) ..) [remove entry]
103 = (#S(INTERVAL :FROM 56 :TO 59) #S(INTERVAL :FROM 1 :TO 30) #S(INTERVAL :FROM 38 :TO 41) #S(INTERVAL :FROM 31 :TO 41) #S(INTERVAL :FROM 48 :TO 55) #S(INTERVAL :FROM 23 :TO 36) #S(INTERVAL :FROM 38 :TO 49) #S(INTERVAL :FROM 12 :TO 25) #S(INTERVAL :FROM 26 :TO 49) #S(INTERVAL :FROM 17 :TO 23) #S(INTERVAL :FROM 13 :TO 56) #S(INTERVAL :FROM 39 :TO 56) #S(INTERVAL :FROM 24 :TO 36) #S(INTERVAL :FROM 26 :TO 55) #S(INTERVAL :FROM 31 :TO 37) #S(INTERVAL :FROM 57 :TO 58) #S(INTERVAL :FROM 15 :TO 50) ..) [remove entry]
NIL = (#S(INTERVAL :FROM NIL :TO 57)) [remove entry]

We see that the last entry has key nil, and the interval it maps to has :from nil. Strange! Looking closer at the Slime debugging window we do find the problem though: in the value of input. We have already seen that sort destructively sort the given list. In addition, we do know that lists in Lisp are linked, so sorting a list means shuffling around pointers. Aha! If a list is just a pointer to its first element and we sort the list, that means that the reference we have to the list, the pointer to an element that used to be first, is no longer first, and all elements that were put in front of it is no longer reachable! The following illustrates:

* (defparameter bing '(9 6 3 5 7 1 8 2 3 5))
* (format t "~S~%" bing)
(9 6 3 5 7 1 8 2 3 5)
* (defparameter bong (sort bing #'<))

* (format t "~S~%" bing)
(6 7 8 9)
* (format t "~S~%" bong)
(1 2 3 3 5 5 6 7 8 9) ; so much for attempting to type in 1 through 9 shuffled

The solution is rather simple: instead of sorting inside day-4/1 we just sort when we set value, in defparameter.

Part 2

Part two asks us for a tiny modification to our function: instead of selecting the guard that sleeps the most, we want the guard who has slept the most times on any minute. So instead of maximizing by summing, we will maximize by maxing (At this point I’m tempted to refactor out most of the logic, but at the same time, this is a write once, run once situation):

(defun day-4/2 (input)
  (let ((guard-sleeps (make-hash-table))
        (guard-arrays (make-hash-table))
        (sleep-start)
        (current-guard))
    (loop for line in input
          when (guard-line-p line) do (setf current-guard (line-id line))
          when (sleep-line-p line) do (setf sleep-start (line-mm line))
          when (wake-line-p line) do
          (let ((interval (make-interval :from sleep-start :to (line-mm line))))
            (if (gethash current-guard guard-sleeps)
                (push interval (gethash current-guard guard-sleeps))
                (setf (gethash current-guard guard-sleeps) (list interval)))))
    (loop for guard-id being the hash-keys of guard-sleeps
          do (let ((arr (make-array 60)))
               (loop for interval in (gethash guard-id guard-sleeps)
                     do (loop for i from (interval-from interval) below (interval-to interval)
                          do (incf (aref arr i))))
               (setf (gethash guard-id guard-arrays) arr)))
    (let* ((sums (loop for k being the hash-keys of guard-arrays
                      collect (list (reduce #'max (gethash k guard-arrays)) k))) ;; HERE!!
           (laziest (second (first (sort sums #'> :key #'car))))
           (arr (gethash laziest guard-arrays))
           (max-freq (reduce #'max arr)))
      (* laziest (position max-freq arr)))))

The only thing we changed was changing a #'+ to a #'max. Hooray! Code reuse!

Thoughts so far

Common Lisp is a bit of a weird language for me. Certain things I figured would be easy, like making tuples, seems to force you to use (list ..), which presumably allocates. In addition, the dynamic nature of the language is something I’m still getting used to, begin a big fan of statically typed languages. Despite being foreign, I think that most of what I have wanted to do has been expressible in CL, and this is, after all, the main point of a programming language.

Lastly, the Slime experience is something I look forward to getting to know better. Being able to interactively looking through the state of the stack, including all local variables, at once when you get an error is simply not something I’m used to; this is the reason I included the hash table output above, despite not actually using it to find the source of the bug. It was just really cool!

Thank you for reading.

Creative Commons Licence
This work is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License