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
138
139
140
141
142
|
;;; 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
(bounds
&aux
(x-len (1+ (- (car bounds) (cadr bounds))))
(y-len (1+ (elt bounds 2)))
(stride (* 8 (1+ (/ x-len 8))))
(grid (make-vector (* stride y-len) 0))))
(:copier nil))
"Represents a snapshot of game of life."
bounds
x-len
y-len
stride
grid)
(defun solver-point (x y grid)
(let ((x (- x (cadr (grid-bounds grid)))))
(when (and (< -1 (grid-x-len grid))
(< -1 y (grid-y-len grid)))
(+ x (* y (grid-stride 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)
(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)))
grid)
(defun solver-draw-wall (grid)
(let ((array (copy-sequence (grid-grid grid)))
(stride (grid-stride grid))
(y-len (grid-y-len grid)))
(create-image array
'xbm t
:scale 20
:stride stride
:width (grid-x-len grid)
:height (grid-y-len grid)
:foreground "#ffffff"
:background "#000000")))
(defun solver-draw-grid (grid)
(let ((stride (grid-stride 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))))
(solver-walls "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9"
(solver-grid-create '(503 494 9 4)))
(solver-point 496 3 (solver-grid-create '(503 494 9 4)))
(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)
(setq x 500 y 0)))))
drops))
(let* ((instr "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9")
(instr (find-file-noselect "input"))
(bounds (solver-bounds instr))
(grid (solver-grid-create bounds))
)
(solver-walls instr grid)
;; sim
(solver-simulate grid)
;; (solver-draw-grid grid)
)
|
