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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;;; solver.el --- Day 14 -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: December 16, 2022
;; Modified: December 16, 2022
;;
;;; Commentary:
;;
;; Day 14
;;
;;; Code:
(require 'seq)
(require 'subr-x)
(defun solver-bounds (str-or-buffer)
(with-temp-buffer
(if (stringp str-or-buffer)
(insert str-or-buffer)
(insert-buffer-substring str-or-buffer))
(goto-char (point-min))
(let ((xmax 0) (ymax 0)
(xmin 55550) (ymin 55550))
(while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) nil t)
(setq xmax (max xmax (string-to-number (match-string 1))))
(setq xmin (min xmin (string-to-number (match-string 1))))
(setq ymax (max ymax (string-to-number (match-string 2))))
(setq ymin (min ymin (string-to-number (match-string 2)))))
(list xmax xmin ymax ymin))))
(cl-defstruct (grid (:constructor solver-grid--create)
(:copier nil))
"Represents a snapshot of game of life."
bounds
x-len
y-len
grid)
(defun solver-grid-create (bounds x-len y-len)
(solver-grid--create :bounds bounds :x-len x-len :y-len y-len
:grid (make-vector (* x-len y-len) 0)))
(defun solver-abyss-grid (bounds)
(let ((x-len (1+ (- (car bounds) (cadr bounds))))
(y-len (1+ (elt bounds 2))))
(solver-grid-create bounds x-len y-len)))
(defun solver-finite-grid (bounds)
(let* ((y-len (+ 3 (elt bounds 2)))
(x-len (* 2 y-len)))
(setcar bounds (+ 500 y-len))
(setf (elt bounds 1) (- 500 y-len))
(solver-grid-create bounds x-len y-len)))
(defun solver-point (x y grid)
(let ((x (- x (cadr (grid-bounds grid)))))
(when (and (< -1 x (grid-x-len grid))
(< -1 y (grid-y-len grid)))
(+ x (* y (grid-x-len grid))))))
(defun solver--wall-line (grid)
(let (startx starty)
(while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) (line-end-position) t)
(let ((fx (string-to-number (match-string 1)))
(fy (string-to-number (match-string 2))))
(unless (null startx)
(if (= startx fx)
(cl-loop for y from (min starty fy) to (max starty fy)
do (aset (grid-grid grid) (solver-point startx y grid) 1))
(cl-loop for x from (min startx fx) to (max startx fx)
do (aset (grid-grid grid) (solver-point x starty grid) 1))))
(setq startx fx
starty fy)))))
(defun solver-walls (str-or-buffer grid &optional finite-grid)
(with-temp-buffer
(if (stringp str-or-buffer)
(insert str-or-buffer)
(insert-buffer-substring str-or-buffer))
(goto-char (point-min))
(while (not (eobp))
(solver--wall-line grid)
(forward-line)))
(when finite-grid
(cl-loop with yrow = (* (grid-x-len grid) (1- (grid-y-len grid)))
for x from 0 below (grid-x-len grid)
do (aset (grid-grid grid) (+ x yrow) 1)))
grid)
(defun solver-draw-grid (grid)
(let ((stride (grid-x-len grid)))
(seq-do-indexed
(lambda (elt idx)
(let ((slot (mod idx stride)))
(when (= 0 slot)
(insert "\n"))
(insert (cl-case elt
(0 ".")
(1 "#")
(2 "o")))))
(grid-grid grid))))
(defun solver-simulate (grid)
(let ((x 500) (y 0) (drops 0))
(while
(ignore-error 'wrong-type-argument ;; went out of grid
(cond
((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid)))
(cl-incf y)) ;; check next
((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid)))
(cl-incf y)
(cl-decf x)) ;; check left
((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid)))
(cl-incf y)
(cl-incf x)) ;; check right
(t (aset (grid-grid grid) (solver-point x y grid) 2)
(cl-incf drops)
(unless (= y 0)
(setq x 500 y 0))))))
drops))
(defun solver (instructions grid-type)
(let* ((bounds (solver-bounds instructions))
(grid (funcall grid-type bounds)))
(solver-walls instructions grid (eq #'solver-finite-grid grid-type))
(solver-simulate grid)))
(ert-deftest test ()
(should (= 24 (solver "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" #'solver-abyss-grid)))
(should (= 665 (solver (find-file-noselect "input") #'solver-abyss-grid)))
(should (= 93 (solver "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" #'solver-finite-grid)))
(should (= 25434 (solver (find-file-noselect "input") #'solver-finite-grid))))
|
