This is an Org Mode file containing Emacs Lisp 🌀➿ (and for teaching/comparison purposes, some Python 🐍) code for the advent of code problems.
The code is introduced in snippets 💬, and the complete code is available together at the end of each day 📚.
🚀 NOTE: If viewing in Github, using the “outline” mode may be helpful! 👁 🪰🦉🐐🕮🔔
Python lists:
my_list = [1, 2, 3]
Emacs lists:
(setq my_list '(1 2 3))
See “Day 1” etc. in inputs.org for the raw inputs.
From Emacs Lisp Manual cl#Loop Basics:
The ‘cl-loop’ macro essentially creates a mini-language within Lisp that is specially tailored for describing loops. While this language is a little strange-looking by the standards of regular Lisp, it turns out to be very easy to learn and well-suited to its purpose.
Here’s a way to create two separate lists by taking every other element from the raw input
(setq list1 (cl-loop for x in raw-input by 'cddr collect x)
list2 (cl-loop for x in (cdr raw-input) by 'cddr collect x))
This uses- by 'cddr
to skip every other element. Syntax note: It uses the builtin function cddr
, and quotes '
it, because it’s a function, not a variable (different binding namespaces).
First loop starts from beginning, so it gets 1st, 3rd, 5th, etc. elements
Second loop starts from second element (using cdr
) so it gets 2nd, 4th, 6th, etc. elements
Compare to Python:
head = my_list[0]
tail = my_list[1:]
shorter_tail = my_list[2:]
(setq
head (car my_list)
tail (cdr my_list)
shorter_tail (cddr my_list))
Here’s how to sort the lists in ascending order:
(setq sorted1 (sort list1 '<)
sorted2 (sort list2 '<))
The sort function in Emacs Lisp takes:
- A list to sort
- A predicate function (in this case ‘<’ for ascending numeric sort)
This is similar to Python’s:
sorted1 = sorted(list1)
sorted2 = sorted(list2)
Note: Emacs Lisp’s sort modifies the original list. If you need to preserve the original, you should copy it first.
Here’s how to compute the sum of the absolute differences between corresponding elements:
(setq sum-of-diffs
(cl-loop for x in sorted1
for y in sorted2
sum (abs (- x y))))
This uses cl-loop with:
- Two parallel iterators (
for x
andfor y
) sum
accumulator that adds up each iteration’s valueabs
to get absolute value-
for subtraction
The equivalent Python would be:
sum_of_diffs = sum(abs(x - y) for x, y in zip(sorted1, sorted2))
;; For each number in list1, count how many times it appears in list2
;; Then multiply and sum
(setq similarity-score
(cl-loop for x in list1
sum (* x (cl-count x list2))))
The Python equivalent would be:
similarity_score = sum(x * list2.count(x) for x in list1)
(setq list1 (cl-loop for x in raw-input by 'cddr collect x)
list2 (cl-loop for x in (cdr raw-input) by 'cddr collect x))
(setq sorted1 (sort list1 '<)
sorted2 (sort list2 '<))
(setq sum-of-diffs
(cl-loop for x in sorted1
for y in sorted2
sum (abs (- x y))))
(setq similarity-score
(cl-loop for x in list1
sum (* x (cl-count x list2))))
(list sum-of-diffs similarity-score)
(defun valid-differences (nums)
(cl-loop for (a b) on nums by #'cdr
while b
for diff = (abs (- b a))
always (and (> diff 0) (<= diff 3))))
(defun strictly-monotonic (nums)
(or (cl-loop for (a b) on nums by #'cdr
while b
always (> b a))
(cl-loop for (a b) on nums by #'cdr
while b
always (< b a))))
(defun safe-report-p (nums)
(and (valid-differences nums)
(strictly-monotonic nums)))
(setq safe-count
(cl-count-if #'safe-report-p raw-input2))
This solution uses:
cl-loop
withby #'cdr
to iterate over pairs- Predicates combined with
and
cl-count-if
to count matches- Pattern matching with
(a b)
to destructure pairs - Short-circuiting with
always
The Python equivalent might look like:
def valid_differences(nums):
return all(0 < abs(b - a) <= 3 for a, b in zip(nums, nums[1:]))
def strictly_monotonic(nums):
return all(b > a for a, b in zip(nums, nums[1:])) or \
all(b < a for a, b in zip(nums, nums[1:]))
def safe_report(nums):
return valid_differences(nums) and strictly_monotonic(nums)
safe_count = sum(1 for nums in raw-input2 if safe_report(nums))
(defun safe-with-removal-p (nums)
(or (safe-report-p nums) ; First check if already safe
(cl-loop for i from 0 below (length nums)
;; Create new list without element at i
for test-nums = (append (cl-subseq nums 0 i)
(cl-subseq nums (1+ i)))
thereis (safe-report-p test-nums))))
(setq safe-count-with-removal
(cl-count-if #'safe-with-removal-p raw-input2))
From Emacs Common Lisp Lisp Emulation Manual cl#Iteration Clauses:
‘thereis CONDITION’ This clause stops the loop when the specified form is non-‘nil’; in this case, it returns that non-‘nil’ value. If all the values were ‘nil’, the loop returns ‘nil’.
- First checks if sequence is already safe
- If not, tries removing each number one at a time:
- Uses
cl-subseq
to slice the list before and after index append
to join the slicesthereis
to return true if any attempt succeeds
- Uses
The Python equivalent would be:
def safe_with_removal(nums):
if safe_report(nums):
return True
return any(safe_report(nums[:i] + nums[i+1:])
for i in range(len(nums)))
safe_count = sum(1 for nums in raw-input2
if safe_with_removal(nums))
Let’s test both parts together:
(list
(cl-count-if #'safe-report-p raw-input2) ; Part 1
(cl-count-if #'safe-with-removal-p raw-input2)) ; Part 2
(defun valid-differences (nums)
(cl-loop for (a b) on nums by #'cdr
while b
for diff = (abs (- b a))
always (and (> diff 0) (<= diff 3))))
(defun strictly-monotonic (nums)
(or (cl-loop for (a b) on nums by #'cdr
while b
always (> b a))
(cl-loop for (a b) on nums by #'cdr
while b
always (< b a))))
(defun safe-report-p (nums)
(and (valid-differences nums)
(strictly-monotonic nums)))
(defun safe-with-removal-p (nums)
(or (safe-report-p nums) ; First check if already safe
(cl-loop for i from 0 below (length nums)
;; Create new list without element at i
for test-nums = (append (cl-subseq nums 0 i)
(cl-subseq nums (1+ i)))
thereis (safe-report-p test-nums))))
(setq safe-count-with-removal
(cl-count-if #'safe-with-removal-p raw-input2))
(list
(cl-count-if #'safe-report-p raw-input2) ; Part 1
(cl-count-if #'safe-with-removal-p raw-input2)) ; Part 2
(setq raw-input3
(with-temp-buffer
(insert-file-contents "input3.txt")
(buffer-string)))
(defun find-mul-results (text)
(cl-loop with start = 0
while (string-match "mul(\\([0-9]+\\),\\([0-9]+\\))" text start)
do (setq start (match-end 0))
for x = (string-to-number (match-string 1 text))
for y = (string-to-number (match-string 2 text))
when (and (<= x 999) (>= x 1)
(<= y 999) (>= y 1))
sum (* x y)))
(find-mul-results raw-input3)
(defun find-mul-results-with-conditions (text)
(let ((enabled t)
(total 0)
(pos 0))
(while (string-match (rx ;; Regex syntax with s-expressions instead of text
(or (seq (group (or "do" "don't")) "()")
(seq "mul("
(group (repeat 1 3 digit))
","
(group (repeat 1 3 digit))
")")))
text pos)
(setq pos (match-end 0))
(if (match-string 1 text)
(setq enabled (string= (match-string 1 text) "do"))
(when enabled
(let ((x (string-to-number (match-string 2 text)))
(y (string-to-number (match-string 3 text))))
(when (and (<= x 999) (>= x 1)
(<= y 999) (>= y 1))
(setq total (+ total (* x y))))))))
total))
(find-mul-results-with-conditions raw-input3)
(setq raw-input4
(with-temp-buffer
(insert-file-contents "input4.txt")
(buffer-string)))
(defun parse-grid (text)
"Convert text into a list of strings (rows)"
(split-string text "\n" t))
(defun get-char (grid row col)
"Get character at position, or nil if out of bounds"
(when (and (>= row 0) (< row (length grid))
(>= col 0) (< col (length (car grid))))
(aref (nth row grid) col)))
(defun check-direction (grid row col drow dcol)
"Check if XMAS starts at position in given direction"
(let ((chars (list)))
(dotimes (i 4)
(push (get-char grid
(+ row (* i drow))
(+ col (* i dcol)))
chars))
(equal (nreverse chars) '(?X ?M ?A ?S))))
(defun count-xmas (grid)
"Count occurrences of XMAS in all directions"
(let ((rows (length grid))
(cols (length (car grid)))
(directions '((0 1) ; right
(1 0) ; down
(1 1) ; diagonal down-right
(-1 1) ; diagonal up-right
(1 -1) ; diagonal down-left
(-1 -1) ; diagonal up-left
(0 -1) ; left
(-1 0)))) ; up
(cl-loop for row from 0 below rows sum
(cl-loop for col from 0 below cols sum
(cl-loop for (drow dcol) in directions
count (check-direction grid row col drow dcol))))))
;; Parse and solve
(let ((grid (parse-grid raw-input4)))
(count-xmas grid))
(defun check-mas (grid row col pattern)
"Check if MAS (or SAM) pattern exists starting at position"
(let ((chars (list)))
(dotimes (i 3)
(push (get-char grid
(+ row (nth i (car pattern)))
(+ col (nth i (cdr pattern))))
chars))
(or (equal chars '(?M ?A ?S))
(equal chars '(?S ?A ?M)))))
(defun check-x-mas (grid row col)
"Check if X-MAS pattern exists at position"
(let ((patterns (list
;; First diagonal (top-left to bottom-right)
(cons '(0 1 2) '(0 1 2))
;; Second diagonal (top-right to bottom-left)
(cons '(0 1 2) '(2 1 0)))))
(when (and (check-mas grid row col (car patterns))
(check-mas grid row col (cadr patterns)))
1)))
(defun count-x-mas (grid)
"Count X-MAS patterns in grid"
(let ((rows (length grid))
(cols (length (car grid))))
(cl-loop for row from 0 below (- rows 2) sum
(cl-loop for col from 0 below (- cols 2) sum
(or (check-x-mas grid row col) 0)))))
;; Parse and solve
(let ((grid (parse-grid raw-input4)))
(count-x-mas grid))
(defun parse-input (input-text)
(let* ((parts (split-string input-text "\n\n"))
(rules-str (car parts))
(updates-str (cadr parts))
(rules (mapcar (lambda (line)
(mapcar #'string-to-number
(split-string line "|")))
(split-string rules-str "\n" t)))
(updates (mapcar (lambda (line)
(mapcar #'string-to-number
(split-string line "," t)))
(split-string updates-str "\n" t))))
(cons rules updates)))
(defun valid-order-p (update rules)
(let ((positions (make-hash-table)))
;; Record positions of each page in the update
(cl-loop for page in update
for pos from 0
do (puthash page pos positions))
;; Check each applicable rule
(cl-loop for (before after) in rules
when (and (gethash before positions)
(gethash after positions))
always (< (gethash before positions)
(gethash after positions)))))
(defun middle-number (list)
(nth (/ (length list) 2) list))
(defun solve-part1 (input-text)
(let* ((parsed (parse-input input-text))
(rules (car parsed))
(updates (cdr parsed)))
(cl-loop for update in updates
when (valid-order-p update rules)
sum (middle-number update))))
(setq raw-input5
(with-temp-buffer
(insert-file-contents "input5.txt")
(buffer-string)))
(solve-part1 raw-input5)
(defun build-graph (pages rules)
"Build adjacency list for pages based on rules."
(let ((graph (make-hash-table)))
;; Initialize empty adjacency lists
(dolist (page pages)
(puthash page nil graph))
;; Add edges from rules
(dolist (rule rules)
(let ((from (car rule))
(to (cadr rule)))
(when (and (member from pages)
(member to pages))
(push to (gethash from graph)))))
graph))
(defun topological-sort (pages rules)
"Sort pages according to rules using Kahn's algorithm."
(let* ((graph (build-graph pages rules))
(in-degree (make-hash-table))
result
queue)
;; Calculate in-degrees
(dolist (page pages)
(puthash page 0 in-degree))
(maphash (lambda (_from tos)
(dolist (to tos)
(puthash to (1+ (gethash to in-degree)) in-degree)))
graph)
;; Initialize queue with nodes having 0 in-degree
(dolist (page pages)
(when (zerop (gethash page in-degree))
(push page queue)))
;; Process queue
(while queue
(let ((page (pop queue)))
(push page result)
(dolist (neighbor (gethash page graph))
(puthash neighbor (1- (gethash neighbor in-degree)) in-degree)
(when (zerop (gethash neighbor in-degree))
(push neighbor queue)))))
(nreverse result)))
(defun solve-part2 (input-text)
(let* ((parsed (parse-input input-text))
(rules (car parsed))
(updates (cdr parsed)))
(cl-loop for update in updates
unless (valid-order-p update rules)
sum (middle-number (topological-sort update rules)))))
(solve-part2 raw-input5)
(defun parse-map (input)
"Convert string input into a 2D array and find starting position."
(let* ((lines (split-string input "\n" t))
(height (length lines))
(width (length (car lines)))
(map (make-vector height nil))
start-pos
start-dir)
;; Convert to array and find start position
(cl-loop for line in lines
for y from 0
do (aset map y (string-to-vector line))
(let ((x (cl-position ?^ (aref map y))))
(when x
(setq start-pos (cons x y)
start-dir '(0 . -1))))) ; Up is -1 in y direction
(list map start-pos start-dir width height)))
(defun turn-right (direction)
"Return new direction after turning right 90 degrees."
(cons (- (cdr direction)) (car direction)))
(defun in-bounds-p (pos width height)
"Check if position is within map boundaries."
(and (>= (car pos) 0) (< (car pos) width)
(>= (cdr pos) 0) (< (cdr pos) height)))
(defun next-position (pos direction)
"Calculate next position based on current position and direction."
(cons (+ (car pos) (car direction))
(+ (cdr pos) (cdr direction))))
(defun get-map-char (map pos)
"Get character at position in map."
(aref (aref map (cdr pos)) (car pos)))
(defun track-guard (input)
"Track guard's movement and return count of unique positions visited."
(let* ((parsed (parse-map input))
(map (nth 0 parsed))
(pos (nth 1 parsed))
(direction (nth 2 parsed))
(width (nth 3 parsed))
(height (nth 4 parsed))
(visited (make-hash-table :test 'equal)))
;; Mark starting position as visited
(puthash pos t visited)
;; Continue until guard leaves map
(let ((continue t))
(while continue
(let ((next-pos (next-position pos direction)))
(cond
;; Check if next move would be out of bounds
((not (in-bounds-p next-pos width height))
(setq continue nil))
;; Obstacle ahead: turn right
((char-equal (get-map-char map next-pos) ?#)
(setq direction (turn-right direction)))
;; Move forward
(t
(setq pos next-pos)
(puthash pos t visited))))))
;; Return count of unique positions
(hash-table-count visited)))
(setq raw-input6
(with-temp-buffer
(insert-file-contents "input6.txt")
(buffer-string)))
;; Test with example input
(track-guard raw-input6)
Note: pretty slow
(defun simulate-path (map pos direction width height new-obstacle)
"Simulate guard's path with a new obstacle, returns nil if not a loop, t if loop."
(cl-block nil
(let ((visited (make-hash-table :test 'equal))
(path-length 0)
(max-steps 10000))
;; Store (position . direction) pairs
(puthash (cons pos direction) 0 visited)
(while (and (< path-length max-steps)
(in-bounds-p pos width height))
(let ((next-pos (next-position pos direction)))
(cond
((or (equal next-pos new-obstacle)
(and (in-bounds-p next-pos width height)
(char-equal (get-map-char map next-pos) ?#)))
(setq direction (turn-right direction)))
(t
(setq pos next-pos
path-length (1+ path-length))
;; Check for same position AND direction
(when (gethash (cons pos direction) visited)
(cl-return t))
(puthash (cons pos direction) path-length visited)))))
(cl-return nil))))
(defun find-loop-positions (input)
"Find all positions where adding an obstacle creates a loop."
(let* ((parsed (parse-map input))
(map (nth 0 parsed))
(start-pos (nth 1 parsed))
(start-dir (nth 2 parsed))
(width (nth 3 parsed))
(height (nth 4 parsed))
(loop-positions 0))
;; Try each position
(dotimes (y height)
(dotimes (x width)
(let ((pos (cons x y)))
(when (and (not (equal pos start-pos)) ; Not start position
(char-equal (get-map-char map pos) ?.) ; Empty space
(simulate-path map start-pos start-dir width height pos))
(cl-incf loop-positions)))))
loop-positions))
;; Test with input
(find-loop-positions raw-input6)
(defun parse-equation (line)
"Parse a line into (test-value . numbers)."
(when (string-match "\\([0-9]+\\): \\(.*\\)" line)
(cons (string-to-number (match-string 1 line))
(mapcar #'string-to-number
(split-string (match-string 2 line))))))
(defun concatenate-numbers (a b)
"Concatenate two numbers (e.g., 12 || 345 = 12345)."
(string-to-number
(concat (number-to-string a)
(number-to-string b))))
(defun generate-operator-combinations (n)
"Generate all possible combinations of +, *, and || for n-1 positions."
(if (= n 1)
'(nil)
(let (result)
(dolist (rest (generate-operator-combinations (1- n)))
(push (cons '+ rest) result)
(push (cons '* rest) result)
(push (cons 'concatenate-numbers rest) result))
result)))
(defun evaluate-with-operators (numbers operators)
"Evaluate expression with given operators left-to-right."
(let ((result (car numbers)))
(cl-loop for num in (cdr numbers)
for op in operators
do (setq result
(cond
((eq op '+) (+ result num))
((eq op '*) (* result num))
(t (funcall op result num)))))
result))
(defun valid-equation-p (test-value numbers)
"Check if equation can be satisfied with any operator combination."
(when (> (length numbers) 1)
(cl-some (lambda (ops)
(= test-value
(evaluate-with-operators numbers ops)))
(generate-operator-combinations (length numbers)))))
(defun solve-calibration (input)
"Solve the calibration problem for given input with progress reporting."
(let* ((equations (mapcar #'parse-equation
(split-string input "\n" t)))
(total-lines (length equations))
(current-line 0)
(sum 0))
(message "Processing %d equations..." total-lines)
(dolist (eq equations)
(cl-incf current-line)
(when (zerop (mod current-line 100))
(message "Progress: %d%% (%d/%d)"
(round (* 100 (/ (float current-line) total-lines)))
current-line
total-lines))
(when (and eq (valid-equation-p (car eq) (cdr eq)))
(cl-incf sum (car eq))))
(message "Done! Processed %d equations." total-lines)
sum))
;; Run the solution
(setq raw-input7
(with-temp-buffer
(insert-file-contents "input7.txt")
(buffer-string)))
(solve-calibration raw-input7)
(defun parse-antenna-map (input)
"Parse input string into a hash table mapping frequencies to lists of points."
(let ((frequencies (make-hash-table :test 'equal))
(lines (split-string input "\n" t)))
(cl-loop for y from 0
for line in lines
do (cl-loop for x from 0
for char across line
unless (char-equal char ?.)
do (push (cons x y)
(gethash char frequencies))))
frequencies))
(defun find-all-antinodes (input)
"Find all unique antinode positions in the input map."
(let ((frequencies (parse-antenna-map input))
(antinodes (make-hash-table :test 'equal))
(lines (split-string input "\n" t))
(width (length (car (split-string input "\n" t))))
(height (length (split-string input "\n" t))))
;; For each frequency
(maphash
(lambda (_freq points)
;; For each pair of points with same frequency
(cl-loop for p1 in points
do (cl-loop for p2 in points
unless (equal p1 p2)
do (dolist (node (find-antinodes p1 p2))
;; Only count nodes within bounds with integer coordinates
(when (and (integerp (car node))
(integerp (cdr node))
(>= (car node) 0)
(< (car node) width)
(>= (cdr node) 0)
(< (cdr node) height))
(puthash node t antinodes))))))
frequencies)
;; Return count of unique antinodes
(hash-table-count antinodes)))
;; Test with example input
(setq example-input
"............
........0...
.....0......
.......0....
....0.......
......A.....
............
............
........A...
.........A..
............
............")
(find-all-antinodes example-input) ; Should return 14
;; Test with actual input
(setq raw-input8
(with-temp-buffer
(insert-file-contents "input8.txt")
(buffer-string)))
(find-all-antinodes raw-input8)
(defun points-in-line-p (p1 p2 p3)
"Check if three points are in a line."
(let ((x1 (car p1)) (y1 (cdr p1))
(x2 (car p2)) (y2 (cdr p2))
(x3 (car p3)) (y3 (cdr p3)))
;; Use cross product = 0 to check collinearity
(= 0 (- (* (- x2 x1) (- y3 y1))
(* (- y2 y1) (- x3 x1))))))
(defun find-all-antinodes-v3 (input)
"Find all antinodes by checking every grid point."
(let* ((frequencies (parse-antenna-map input))
(lines (split-string input "\n" t))
(width (length (car lines)))
(height (length lines))
(antinodes (make-hash-table :test 'equal)))
;; For each point in the grid
(dotimes (y height)
(dotimes (x width)
(let ((point (cons x y)))
;; Check against each frequency's antenna pairs
(maphash
(lambda (_freq antennas)
;; For each pair of antennas
(cl-loop for (a1 . rest) on antennas
do (cl-loop for a2 in rest
;; If point is collinear with antenna pair
when (points-in-line-p a1 a2 point)
do (puthash point t antinodes)
and return t))) ; Can break inner loop once found
frequencies))))
(hash-table-count antinodes)))
(find-all-antinodes-v3 raw-input8)
def parse_disk_map(input_str):
# Convert string of numbers into list of integers
return [int(c) for c in input_str]
def expand_disk_map(numbers):
# Convert compressed format into list showing file IDs and free space
result = []
file_id = 0
for i, n in enumerate(numbers):
if i % 2 == 0: # File blocks
result.extend([file_id] * n)
file_id += 1
else: # Free space blocks
result.extend(['.'] * n)
return result
def compact_disk(expanded):
# Move files to leftmost available space
result = expanded.copy()
# Process from right to left
for i in range(len(result)-1, -1, -1):
if result[i] != '.': # Found a file block
# Look for leftmost free space
for j in range(min(i, len(result))):
if result[j] == '.':
# Move file block
result[j] = result[i]
if i != j:
result[i] = '.'
break
return result
def calculate_checksum(compacted):
# Calculate checksum based on position * file ID
return sum(pos * file_id
for pos, file_id in enumerate(compacted)
if file_id != '.')
def solve_part1(input_str):
numbers = parse_disk_map(input_str)
expanded = expand_disk_map(numbers)
compacted = compact_disk(expanded)
return calculate_checksum(compacted)
# Example usage:
#print(solve_part1(example)) # Should print 1928
with open("input9.txt") as inf:
print(solve_part1(inf.read().strip()))