Not only is "ask" not a noun, but "leverage" is not and has never been a verb.
The Shining Force games (the first two were Genesis/Megadrive) did this as well - your inactive party members showed up in a tavern-like space in the basement of your home castle. (Unless they were currently dead, in which case they appeared as purple flames.)
Another vote for Lovers in a Dangerous Spacetime.
If you like electronic dance music, Just Shapes and Beats.
If you liked Eye of the Beholder and wish there were a co-op Minecraft-visuals version, it's Barony.
I usually spell this as !!:gs/foo/bar/ (in bash). Is there a functional difference?
! command history can also take line and word selectors. I type something like !-2:2 surprisingly often.
Applied topology! Instead of using the standard even-odd raycasting trick for winding number (which I didn't remember), I constructed an explicit inward-pointing normal at each edge of the large polygon. This way you can test directly whether edges that lie on the boundary of your candidate rectangle have the right orientation. The code isn't pretty (edge-exterior-to-rect? is particularly awful), and I'm sure it could be made faster, but this worked almost the first time.
(ql:quickload :str)
(defun parse-line (line)
(map 'vector #'parse-integer (str:split "," line)))
(defun read-inputs (filename)
(let ((lines (uiop:read-file-lines filename)))
(make-array (list (length lines) 2)
:initial-contents (mapcar #'parse-line lines))))
(defun area (corners v w)
"Yield the area of the rectangle between two diagonally opposite corners identified by index."
(* (1+ (abs (- (aref corners v 0) (aref corners w 0))))
(1+ (abs (- (aref corners v 1) (aref corners w 1))))))
(defun main-1 (filename)
(let* ((red-tiles (read-inputs filename))
(ntiles (car (array-dimensions red-tiles))))
(loop for v from 0 to (1- ntiles)
maximize (loop for w from 0 to (1- v)
maximize (area red-tiles v w)))))
;;; A rectangle is enclosed by the region if and only if both of the following are true:
;;; 1. No edge of the region passes through the interior of the rectangle;
;;; 2. When an edge of the region runs along an edge of the rectangle, the interior of
;;; the region and the interior of the rectangle lie on the same side.
;;; So our first problem is to find the interior side of each edge of the region.
(defun edges-with-interior (corners)
;; Anchor: a vertical edge with minimum x coordinate has the interior on the +x side
(let* ((n (car (array-dimensions corners)))
(min-x (loop for i from 0 to (1- n) minimize (aref corners i 0)))
(arg-min-x (loop for i from 0 to (1- n)
when (= (aref corners i 0) min-x)
return i))
;; Mapping from edge direction unit vector to inward-pointing normal to edge
;; Initial inward normal is known to be #(1 0); sense of the rotation from edge
;; direction depends on direction of initial edge
(edge-interior-dir
(if (> (aref corners (1+ arg-min-x) 1) (aref corners arg-min-x 1)) ; +y
'((#(0 1) . #(1 0)) (#(1 0) . #(0 -1)) (#(0 -1) . #(-1 0)) (#(-1 0) . #(0 1)))
'((#(0 -1) . #(1 0)) (#(1 0) . #(0 1)) (#(0 1) . #(-1 0)) (#(-1 0) . #(0 -1)))))
(interior-labeled-edges
(loop for i from arg-min-x to (+ arg-min-x n -1)
collect (let* ((j (mod i n))
(jj (mod (1+ i) n))
(unit-edge
(vector (signum (- (aref corners jj 0) (aref corners j 0)))
(signum (- (aref corners jj 1) (aref corners j 1)))))
(unit-interior-normal
(cdr (assoc unit-edge edge-interior-dir :test #'equalp))))
(vector (aref corners j 0) (aref corners j 1)
(aref corners jj 0) (aref corners jj 1)
(aref unit-interior-normal 0) (aref unit-interior-normal 1))))))
(make-array (list n 6) :initial-contents interior-labeled-edges)))
(defun edge-exterior-to-rect? (corners edges-with-interior i v w)
(let ((rxmin (min (aref corners v 0) (aref corners w 0)))
(rxmax (max (aref corners v 0) (aref corners w 0)))
(rymin (min (aref corners v 1) (aref corners w 1)))
(rymax (max (aref corners v 1) (aref corners w 1)))
(exmin (min (aref edges-with-interior i 0) (aref edges-with-interior i 2)))
(exmax (max (aref edges-with-interior i 0) (aref edges-with-interior i 2)))
(eymin (min (aref edges-with-interior i 1) (aref edges-with-interior i 3)))
(eymax (max (aref edges-with-interior i 1) (aref edges-with-interior i 3)))
(ixdir (aref edges-with-interior i 4))
(iydir (aref edges-with-interior i 5)))
(or (and (< exmin rxmin) (<= exmax rxmin)) ; edge is left of rectangle
(and (>= exmin rxmax) (> exmax rxmax)) ; edge is right of rectangle
(and (< eymin rymin) (<= eymax rymin)) ; edge is above rectangle
(and (>= eymin rymax) (> eymax rymax)) ; edge is below rectangle
(and (= exmin exmax rxmin) (= ixdir 1) (= iydir 0)) ; edge lies on left side pointing in
(and (= exmin exmax rxmax) (= ixdir -1) (= iydir 0)) ; edge lies on right side pointing in
(and (= eymin eymax rymin) (= ixdir 0) (= iydir 1)) ; edge lies on top side pointing in
(and (= eymin eymax rymax) (= ixdir 0) (= iydir -1))))) ; edge lies on bottom side pointing in
(defun enclosed? (corners edges-with-interior v w)
(loop for i from 0 to (1- (car (array-dimensions edges-with-interior)))
unless (edge-exterior-to-rect? corners edges-with-interior i v w)
return nil
finally (return t)))
(defun main-2 (filename)
(let* ((red-tiles (read-inputs filename))
(ntiles (car (array-dimensions red-tiles)))
(edges-with-interior (edges-with-interior red-tiles)))
(loop for v from 0 to (1- ntiles)
maximize (loop for w from 0 to (1- v)
maximize (if (enclosed? red-tiles edges-with-interior v w)
(area red-tiles v w)
0)))))
Another factor of 10 in problem size would have required more efficient data structures and the "correct" algorithm. But as it is, we can get by with sets-as-lists and just updating a hash table, if we're willing to wait a few seconds for the answer.
(ql:quickload :str)
(defun parse-line (line)
(coerce (mapcar #'parse-integer (str:split "," line)) 'vector))
(defun read-inputs (filename)
(let ((input-lines (uiop:read-file-lines filename)))
(make-array (list (length input-lines) 3)
:initial-contents (mapcar #'parse-line input-lines))))
(defun distance (points p q)
(flet ((square (x) (* x x)))
(sqrt (+ (square (- (aref points p 0) (aref points q 0)))
(square (- (aref points p 1) (aref points q 1)))
(square (- (aref points p 2) (aref points q 2)))))))
(defun all-labeled-edges (points)
(loop for j from 0 to (1- (car (array-dimensions points)))
nconcing (loop for i from 0 to (1- j)
collect (list (distance points i j) i j))))
(defun short-labeled-edges (points nedges)
(subseq (sort (all-labeled-edges points) #'< :key #'first) 0 nedges))
(defun adjacency-map (labeled-edges)
(let ((result (make-hash-table)))
(loop for (nil v w) in labeled-edges
do (setf (gethash v result) (cons w (gethash v result)))
(setf (gethash w result) (cons v (gethash w result))))
result))
(defun components (n adjacency-map)
(let ((remaining (loop for i from 0 to (1- n) collect i))
(result nil))
(loop for v = (car remaining)
until (null v)
do (let ((this-component nil)
(next-component (list v)))
(loop until (subsetp next-component this-component)
do (progn
(setf this-component next-component)
(setf next-component
(reduce #'union
(cons this-component
(mapcar #'(lambda (w) (gethash w adjacency-map))
this-component))))))
(setf result (cons this-component result))
(loop for w in this-component
do (setf remaining (delete w remaining)))))
result))
(defun main-1 (filename)
(let* ((points (read-inputs filename))
(adjacency (adjacency-map (short-labeled-edges points 1000)))
(components (components (car (array-dimensions points)) adjacency))
(lengths (sort (mapcar #'length components) #'>)))
(* (car lengths) (cadr lengths) (caddr lengths))))
(defun fusing-edge (n labeled-edges)
(let ((sorted-edges (sort labeled-edges #'< :key #'first))
(components (make-hash-table)))
(loop for i from 0 to (1- n)
do (setf (gethash i components) (list i)))
(loop for (nil v w) in sorted-edges
do (let ((new-component (union (gethash v components) (gethash w components))))
(cond ((= (length new-component) n)
(return (list v w)))
((not (subsetp new-component (gethash v components)))
(loop for x in new-component
do (setf (gethash x components) new-component))))))))
(defun main-2 (filename)
(let* ((points (read-inputs filename))
(n (car (array-dimensions points))))
(destructuring-bind (v w) (fusing-edge n (all-labeled-edges points))
(* (aref points v 0) (aref points w 0)))))
My choice of representation for part 1 ended up being fortunate, as all I needed to change for part 2 was three setf in propagate that became incf. This was also another good use case for multiple return values, as it's the beam vector you want to reduce on, but for part 1 the split count needs to come along for the ride.
(defun parse-line (line)
(let ((result (make-array (length line) :initial-element 0)))
(loop for i from 0 to (1- (length line))
if (member (char line i) '(#\^ #\S))
do (setf (aref result i) 1))
result))
(defun read-inputs (filename)
(let ((input-lines (uiop:read-file-lines filename)))
(mapcar #'parse-line input-lines)))
(defun propagate (in-beams splitters)
(let ((out-beams (make-array (length in-beams) :initial-element 0))
(splits 0))
(loop for i from 0 to (1- (length in-beams))
if (not (zerop (aref in-beams i)))
do (if (not (zerop (aref splitters i)))
(progn (incf (aref out-beams (1- i)) (aref in-beams i))
(incf (aref out-beams (1+ i)) (aref in-beams i))
(incf splits))
(incf (aref out-beams i) (aref in-beams i))))
(values out-beams splits)))
(defun propagate-all (initial-beam-vector splitter-map)
(let* ((total-splits 0)
(final-beam-vector
(reduce #'(lambda (in-beams splitters)
(multiple-value-bind (out-beams this-splits)
(propagate in-beams splitters)
(incf total-splits this-splits)
out-beams))
splitter-map :initial-value initial-beam-vector)))
(values final-beam-vector total-splits)))
(defun main-1 (filename)
(let ((grid (read-inputs filename)))
(multiple-value-bind (final-beam-vector total-splits)
(propagate-all (car grid) (cdr grid))
total-splits)))
(defun main-2 (filename)
(let ((grid (read-inputs filename)))
(multiple-value-bind (final-beam-vector total-splits)
(propagate-all (car grid) (cdr grid))
(reduce #'+ (coerce final-beam-vector 'list)))))
Ironically for Lisp, a good chunk of the work here is type conversion, because strings, vectors, multidimensional arrays, characters, and numbers don't have implicit conversions between them; you have to specify what you want explicitly. I also found it easier to manually transpose the character array for part 2 rather than traverse in column-major order, because that makes the relationship between input and output data structure more transparent.
(ql:quickload :str)
(ql:quickload :array-operations)
(defun parse-line-1 (line)
(let ((broken-line (str:split " " (str:collapse-whitespaces (str:trim line)))))
(mapcar #'(lambda (s)
(cond ((equal s "+") #'+)
((equal s "*") #'*)
(t (parse-integer s))))
broken-line)))
(defun read-inputs-1 (filename)
(let* ((input-lines (uiop:read-file-lines filename)))
(mapcar #'parse-line-1 input-lines)))
(defun main-1 (filename)
(let* ((problems (read-inputs-1 filename))
(arguments (apply #'mapcar #'list (butlast problems))))
(reduce #'+ (mapcar #'apply (car (last problems)) arguments))))
(defun parse-operands-2 (lines)
(let* ((initial-rows (length lines))
(initial-cols (length (car lines)))
(flat-chars (make-array (list (* initial-rows initial-cols))
:initial-contents (apply #'concatenate 'string lines)))
(box-chars (make-array (list initial-rows initial-cols) :displaced-to flat-chars))
(transposed-chars (aops:each-index (i j) (aref box-chars j i))))
(loop for cv across (aops:split transposed-chars 1)
for s = (str:trim (coerce cv 'string))
collect (if (zerop (length s)) nil (parse-integer s)))))
(defun list-split (xs sep &optional (predicate #'equal))
(let ((current nil)
(result nil))
(loop for x in xs
do (if (funcall predicate x sep)
(progn
(setf result (cons (reverse current) result))
(setf current nil))
(setf current (cons x current)))
finally (setf result (cons (reverse current) result)))
(reverse result)))
(defun main-2 (filename)
(let* ((lines (uiop:read-file-lines filename))
(operators (parse-line-1 (car (last lines))))
(operands (parse-operands-2 (butlast lines))))
(loop for rator in operators
for rands in (list-split operands nil)
sum (apply rator rands))))
Nothing interesting here. I was tripped up momentarily by the fact that Common Lisp sort, while it's a destructive operation, does not leave its input argument equal to its result! Typically you see either "nondestructive, returns a value" (Python sorted()) or "destructive, leaves the object in the final state" (Python list.sort()). Old school Lisp sort returns the sorted list and the input structure is not guaranteed to be meaningful afterward. Hope you weren't using that pair for anything; it now points to hell.
(ql:quickload :str)
(defun read-inputs (filename)
(let* ((input-lines (uiop:read-file-lines filename))
(range-lines (remove-if-not #'(lambda (s) (find #\- s)) input-lines))
(id-lines (remove-if #'(lambda (s) (or (zerop (length s)) (find #\- s))) input-lines)))
(flet ((parse-range (line) (mapcar #'parse-integer (str:split "-" line))))
(cons (mapcar #'parse-range range-lines)
(mapcar #'parse-integer id-lines)))))
(defun fresh? (fresh-ranges id)
"Return the first fresh range containing id, or nil if there is no such range.
Assumes the fresh ranges are sorted to enable early exit."
(loop for fresh-range in fresh-ranges
when (<= (car fresh-range) id (cadr fresh-range))
return fresh-range
when (> (car fresh-range) id)
return nil
finally (return nil)))
(defun range< (range1 range2)
(destructuring-bind (a1 b1) range1
(destructuring-bind (a2 b2) range2
(or (< a1 a2)
(and (= a1 a2) (< b1 b2))))))
(defun main-1 (filename)
(destructuring-bind (fresh-ranges . ids) (read-inputs filename)
(let ((sorted-fresh-ranges (sort fresh-ranges #'range<)))
(loop for id in ids
sum (if (fresh? sorted-fresh-ranges id) 1 0)))))
(defun consolidate (fresh-ranges)
"Remove redundancy in a sorted list of fresh ranges: emit non-overlapping ranges."
(let ((result nil)
(current-range (car fresh-ranges)))
(loop for fresh-range in (cdr fresh-ranges)
do (if (<= (car fresh-range) (cadr current-range))
(setf current-range (list (car current-range)
(max (cadr current-range) (cadr fresh-range))))
(progn
(setf result (cons current-range result))
(setf current-range fresh-range)))
finally (setf result (cons current-range result)))
result))
(defun main-2 (filename)
(destructuring-bind (fresh-ranges . ids) (read-inputs filename)
(let ((sorted-fresh-ranges (sort fresh-ranges #'range<)))
(reduce #'+
(mapcar #'(lambda (range) (1+ (- (cadr range) (car range))))
(consolidate sorted-fresh-ranges))))))
This is the first day I've wished I were working in J, like last year, instead of Lisp. Common Lisp arrays show the age of the language design. They're basically C arrays with less convenient syntax; if you want higher-order array iteration you have to write it yourself or use a package that provides it. This solution is also less efficient than it could be for part 2, because I recompute the full neighbors array on each iteration rather than updating it incrementally.
(defun read-inputs (filename)
(let* ((input-lines (uiop:read-file-lines filename))
(rows (length input-lines))
(cols (length (car input-lines)))
(result (make-array (list rows cols) :initial-element 0)))
(loop for line in input-lines
for y from 0 to (1- rows)
do (loop for x from 0 to (1- cols)
if (eql (char line x) #\@)
do (setf (aref result y x) 1)))
result))
(defun neighbors (grid)
(let* ((dimensions (array-dimensions grid))
(rows (car dimensions))
(cols (cadr dimensions))
(result (make-array dimensions :initial-element 0)))
(flet ((neighbors-at (y x)
(loop for dy from -1 to 1
sum (loop for dx from -1 to 1
sum (let ((yy (+ y dy))
(xx (+ x dx)))
(if (and (>= yy 0)
(< yy rows)
(>= xx 0)
(< xx cols)
(not (and (= dx 0) (= dy 0)))
(> (aref grid yy xx) 0))
1
0))))))
(loop for y from 0 to (1- rows)
do (loop for x from 0 to (1- cols)
do (setf (aref result y x) (neighbors-at y x))))
result)))
(defun main-1 (filename)
(let* ((grid (read-inputs filename))
(dimensions (array-dimensions grid))
(neighbors-grid (neighbors grid)))
(loop for y from 0 to (1- (car dimensions))
sum (loop for x from 0 to (1- (cadr dimensions))
sum (if (and (> (aref grid y x) 0)
(< (aref neighbors-grid y x) 4))
1
0)))))
(defun remove-accessible (grid)
(let* ((dimensions (array-dimensions grid))
(neighbors-grid (neighbors grid))
(removed 0))
(loop for y from 0 to (1- (car dimensions))
do (loop for x from 0 to (1- (cadr dimensions))
do (if (and (> (aref grid y x) 0)
(< (aref neighbors-grid y x) 4))
(progn
(setf (aref grid y x) 0)
(incf removed)))))
removed))
(defun main-2 (filename)
(let ((grid (read-inputs filename))
(removed 0))
(loop for this-removed = (remove-accessible grid)
until (zerop this-removed)
do (incf removed this-removed))
removed))
This problem was quite straightforward; I think it probably could have been day 1. The only interesting thing here is the use of values and multiple-value-bind, which are the standard way in Common Lisp to give a function a primary return value but also one or more advisory return values. This lets you return a rich data structure for consumers who want it, but consumers who don't want it don't need to parse that entire data structure to get the primary return value.
(defun parse-line (line)
(let ((digits (loop for i from 0 to (1- (length line))
collect (parse-integer line :start i :end (1+ i)))))
(make-array (list (length digits)) :initial-contents digits)))
(defun read-inputs (filename)
(let* ((input-lines (uiop:read-file-lines filename)))
(mapcar #'parse-line input-lines)))
(defun arg-max (v &key start end)
"Yield the index and the greatest element of vector v, between indices start (inclusive) and
end (exclusive) if they are supplied. Returns the earliest instance of the maximum."
(let* ((start (max 0 (or start 0)))
(end (min (length v) (or end (length v))))
(arg-max start)
(val-max (aref v start)))
(loop for i from start to (1- end)
if (> (aref v i) val-max)
do (progn (setf arg-max i)
(setf val-max (aref v i)))
finally (return (values arg-max val-max)))))
(defun bank-max-joltage (digits bank)
(let ((search-start 0)
(result 0))
(loop for d from 0 to (1- digits)
do (multiple-value-bind (digit-pos digit)
(arg-max bank :start search-start :end (+ (length bank) (- digits) (1+ d)))
(setf search-start (1+ digit-pos))
(setf result (+ (* 10 result) digit))))
result))
(defun main-1 (filename)
(reduce #'+ (mapcar #'(lambda (bank) (bank-max-joltage 2 bank))
(read-inputs filename))))
(defun main-2 (filename)
(reduce #'+ (mapcar #'(lambda (bank) (bank-max-joltage 12 bank))
(read-inputs filename))))
An ID is invalid if and only if it is divisible by a number of the form 1001001001, where the 1's are separated by the same number of 0's and the block length times the number of blocks equals the digit length of the ID. Given that, the problem reduces to summing the members of some arithmetic progressions; we never have to iterate over the members of a range at all.
(ql:quickload :str)
(defun parse-range (range)
(mapcar #'parse-integer (str:split "-" range)))
(defun parse-line (line)
(mapcar #'parse-range (str:split "," line)))
(defun read-inputs (filename)
(let ((input-lines (uiop:read-file-lines filename)))
(parse-line (car input-lines))))
(defun split-range (start end)
"Split the range (start end) into a list of ranges whose bounds have same number of digits."
(let ((start-digits (1+ (floor (log start 10))))
(end-digits (1+ (floor (log end 10)))))
(if (< start-digits end-digits)
(cons (list start (1- (expt 10 start-digits)))
(split-range (expt 10 start-digits) end))
(list (list start end)))))
(defun sum-multiples-in-range (d start end)
"Add up the sum of all multiples n of d satisfying start <= n <= end."
(multiple-value-bind (q0 r0) (floor start d)
;; q1, q2 are coefficients of the least and greatest multiple of d potentially in range
(let ((q1 (if (zerop r0) q0 (1+ q0)))
(q2 (floor end d)))
(if (> q1 q2)
0
(flet ((arith-up-to (n) (floor (* n (1+ n)) 2)))
(* d (- (arith-up-to q2) (arith-up-to (1- q1)))))))))
(defun sum-invalid-in-range (range repeat-count)
"Add up the sum of all IDs in range start <= n <= end which are invalid due to having
exactly repeat-count repeats."
(loop for homogeneous-range in (apply #'split-range range)
sum (destructuring-bind (hstart hend) homogeneous-range
(let ((digits (1+ (floor (log hstart 10)))))
(if (not (zerop (mod digits repeat-count)))
0
(let ((divisor
(loop for k from 0 to (1- digits) by (floor digits repeat-count)
sum (expt 10 k))))
(sum-multiples-in-range divisor hstart hend)))))))
(defun main-1 (filename)
(reduce #'+ (mapcar #'(lambda (range) (sum-invalid-in-range range 2))
(read-inputs filename))))
(defun sum-all-invalids-in-range (range)
"Add up the sum of _all_ invalid IDs (with any available repeat count) in range."
;; Composite repeat counts will be overcounted. Because the maximum digit length of
;; inputs is limited, we can cheat and just use an explicit constant for weights.
(let ((repeat-weights '((2 1) (3 1) (5 1) (6 -1) (7 1) (10 -1))))
(loop for repeat-weight in repeat-weights
sum (destructuring-bind (repeat-count weight) repeat-weight
(* weight (sum-invalid-in-range range repeat-count))))))
(defun main-2 (filename)
(reduce #'+ (mapcar #'sum-all-invalids-in-range (read-inputs filename))))