Commit | Line | Data |
---|---|---|
b776bc70 | 1 | ;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*- |
116f0564 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1999-2014 Free Software Foundation, Inc. |
116f0564 | 4 | |
26a8d08d GM |
5 | ;; Author: Dave Pearson <davep@davep.org> |
6 | ;; Maintainer: Dave Pearson <davep@davep.org> | |
116f0564 | 7 | ;; Created: 1998-10-03 |
116f0564 KH |
8 | ;; Keywords: games puzzles |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
116f0564 | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
116f0564 KH |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
116f0564 KH |
24 | |
25 | ;;; Commentary: | |
26 | ||
b776bc70 | 27 | ;; The aim of 5x5 is to fill in all the squares. If you need any more of an |
116f0564 KH |
28 | ;; explanation you probably shouldn't play the game. |
29 | ||
30 | ;;; TODO: | |
31 | ||
b776bc70 | 32 | ;; o The code for updating the grid needs to be re-done. At the moment it |
116f0564 KH |
33 | ;; simply re-draws the grid every time a move is made. |
34 | ;; | |
b776bc70 | 35 | ;; o Look into tarting up the display with color. gamegrid.el looks |
116f0564 KH |
36 | ;; interesting, perhaps that is the way to go? |
37 | ||
38 | ;;; Thanks: | |
39 | ||
40 | ;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an | |
41 | ;; emacs mode. | |
42 | ;; | |
43 | ;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated | |
b776bc70 VB |
44 | ;; cracker. |
45 | ;; | |
46 | ;; Vincent Belaïche <vincentb1@users.sourceforge.net> & Jay P. Belanger | |
47 | ;; <jay.p.belanger@gmail.com> for the math solver. | |
116f0564 | 48 | |
6e44da43 PJ |
49 | ;;; Code: |
50 | ||
116f0564 KH |
51 | ;; Things we need. |
52 | ||
a464a6c7 | 53 | (eval-when-compile (require 'cl-lib)) |
116f0564 | 54 | |
116f0564 KH |
55 | ;; Customize options. |
56 | ||
57 | (defgroup 5x5 nil | |
58 | "5x5 - Silly little puzzle game." | |
59 | :group 'games | |
60 | :prefix "5x5-") | |
61 | ||
62 | (defcustom 5x5-grid-size 5 | |
67d110f1 | 63 | "Size of the playing area." |
116f0564 KH |
64 | :type 'integer |
65 | :group '5x5) | |
66 | ||
67 | (defcustom 5x5-x-scale 4 | |
67d110f1 | 68 | "X scaling factor for drawing the grid." |
116f0564 KH |
69 | :type 'integer |
70 | :group '5x5) | |
71 | ||
72 | (defcustom 5x5-y-scale 3 | |
67d110f1 | 73 | "Y scaling factor for drawing the grid." |
116f0564 KH |
74 | :type 'integer |
75 | :group '5x5) | |
76 | ||
77 | (defcustom 5x5-animate-delay .01 | |
67d110f1 | 78 | "Delay in seconds when animating a solution crack." |
116f0564 KH |
79 | :type 'number |
80 | :group '5x5) | |
81 | ||
82 | (defcustom 5x5-hassle-me t | |
67d110f1 | 83 | "Should 5x5 ask you when you want to do a destructive operation?" |
116f0564 KH |
84 | :type 'boolean |
85 | :group '5x5) | |
86 | ||
87 | (defcustom 5x5-mode-hook nil | |
67d110f1 | 88 | "Hook run on starting 5x5." |
116f0564 KH |
89 | :type 'hook |
90 | :group '5x5) | |
91 | ||
92 | ;; Non-customize variables. | |
93 | ||
b776bc70 VB |
94 | (defmacro 5x5-defvar-local (var value doc) |
95 | "Define VAR to VALUE with documentation DOC and make it buffer local." | |
96 | `(progn | |
97 | (defvar ,var ,value ,doc) | |
98 | (make-variable-buffer-local (quote ,var)))) | |
99 | ||
100 | (5x5-defvar-local 5x5-grid nil | |
116f0564 KH |
101 | "5x5 grid contents.") |
102 | ||
b776bc70 | 103 | (5x5-defvar-local 5x5-x-pos 2 |
116f0564 KH |
104 | "X position of cursor.") |
105 | ||
b776bc70 | 106 | (5x5-defvar-local 5x5-y-pos 2 |
116f0564 KH |
107 | "Y position of cursor.") |
108 | ||
b776bc70 | 109 | (5x5-defvar-local 5x5-moves 0 |
116f0564 KH |
110 | "Moves made.") |
111 | ||
b776bc70 | 112 | (5x5-defvar-local 5x5-cracking nil |
116f0564 KH |
113 | "Are we in cracking mode?") |
114 | ||
115 | (defvar 5x5-buffer-name "*5x5*" | |
116 | "Name of the 5x5 play buffer.") | |
117 | ||
a0310a6c | 118 | (defvar 5x5-mode-map |
116f0564 KH |
119 | (let ((map (make-sparse-keymap))) |
120 | (suppress-keymap map t) | |
121 | (define-key map "?" #'describe-mode) | |
122 | (define-key map "\r" #'5x5-flip-current) | |
123 | (define-key map " " #'5x5-flip-current) | |
124 | (define-key map [up] #'5x5-up) | |
125 | (define-key map [down] #'5x5-down) | |
126 | (define-key map [left] #'5x5-left) | |
127 | (define-key map [tab] #'5x5-right) | |
128 | (define-key map [right] #'5x5-right) | |
129 | (define-key map [(control a)] #'5x5-bol) | |
130 | (define-key map [(control e)] #'5x5-eol) | |
08f87e3c KH |
131 | (define-key map [(control p)] #'5x5-up) |
132 | (define-key map [(control n)] #'5x5-down) | |
133 | (define-key map [(control b)] #'5x5-left) | |
134 | (define-key map [(control f)] #'5x5-right) | |
116f0564 KH |
135 | (define-key map [home] #'5x5-bol) |
136 | (define-key map [end] #'5x5-eol) | |
137 | (define-key map [prior] #'5x5-first) | |
138 | (define-key map [next] #'5x5-last) | |
139 | (define-key map "r" #'5x5-randomize) | |
140 | (define-key map [(control c) (control r)] #'5x5-crack-randomly) | |
141 | (define-key map [(control c) (control c)] #'5x5-crack-mutating-current) | |
142 | (define-key map [(control c) (control b)] #'5x5-crack-mutating-best) | |
a1506d29 | 143 | (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate) |
116f0564 | 144 | (define-key map "n" #'5x5-new-game) |
b776bc70 | 145 | (define-key map "s" #'5x5-solve-suggest) |
7cf3f556 VB |
146 | (define-key map "<" #'5x5-solve-rotate-left) |
147 | (define-key map ">" #'5x5-solve-rotate-right) | |
116f0564 | 148 | (define-key map "q" #'5x5-quit-game) |
a0310a6c DN |
149 | map) |
150 | "Local keymap for the 5x5 game.") | |
116f0564 | 151 | |
b776bc70 | 152 | (5x5-defvar-local 5x5-solver-output nil |
58179cce | 153 | "List that is the output of an arithmetic solver. |
b776bc70 VB |
154 | |
155 | This list L is such that | |
156 | ||
157 | L = (M S_1 S_2 ... S_N) | |
158 | ||
159 | M is the move count when the solve output was stored. | |
160 | ||
161 | S_1 ... S_N are all the solutions ordered from least to greatest | |
162 | number of strokes. S_1 is the solution to be displayed. | |
163 | ||
91af3942 PE |
164 | Each solution S_1, ..., S_N is a list (STROKE-COUNT GRID) where |
165 | STROKE-COUNT is the number of strokes to achieve the solution and | |
b776bc70 VB |
166 | GRID is the grid of positions to click.") |
167 | ||
168 | ||
116f0564 KH |
169 | ;; Menu definition. |
170 | ||
171 | (easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu." | |
172 | '("5x5" | |
173 | ["New game" 5x5-new-game t] | |
174 | ["Random game" 5x5-randomize t] | |
175 | ["Quit game" 5x5-quit-game t] | |
176 | "---" | |
b776bc70 | 177 | ["Use Calc solver" 5x5-solve-suggest t] |
7cf3f556 VB |
178 | ["Rotate left list of Calc solutions" 5x5-solve-rotate-left t] |
179 | ["Rotate right list of Calc solutions" 5x5-solve-rotate-right t] | |
180 | "---" | |
116f0564 KH |
181 | ["Crack randomly" 5x5-crack-randomly t] |
182 | ["Crack mutating current" 5x5-crack-mutating-current t] | |
183 | ["Crack mutating best" 5x5-crack-mutating-best t] | |
184 | ["Crack with xor mutate" 5x5-crack-xor-mutate t])) | |
185 | ||
186 | ;; Gameplay functions. | |
187 | ||
1b3b87df SM |
188 | (define-derived-mode 5x5-mode special-mode "5x5" |
189 | "A mode for playing `5x5'." | |
116f0564 KH |
190 | (setq buffer-read-only t |
191 | truncate-lines t) | |
c83c9654 | 192 | (buffer-disable-undo)) |
116f0564 KH |
193 | |
194 | ;;;###autoload | |
195 | (defun 5x5 (&optional size) | |
196 | "Play 5x5. | |
197 | ||
198 | The object of 5x5 is very simple, by moving around the grid and flipping | |
199 | squares you must fill the grid. | |
200 | ||
201 | 5x5 keyboard bindings are: | |
202 | \\<5x5-mode-map> | |
7cf3f556 VB |
203 | Flip \\[5x5-flip-current] |
204 | Move up \\[5x5-up] | |
205 | Move down \\[5x5-down] | |
206 | Move left \\[5x5-left] | |
207 | Move right \\[5x5-right] | |
208 | Start new game \\[5x5-new-game] | |
209 | New game with random grid \\[5x5-randomize] | |
210 | Random cracker \\[5x5-crack-randomly] | |
211 | Mutate current cracker \\[5x5-crack-mutating-current] | |
212 | Mutate best cracker \\[5x5-crack-mutating-best] | |
213 | Mutate xor cracker \\[5x5-crack-xor-mutate] | |
214 | Solve with Calc \\[5x5-solve-suggest] | |
215 | Rotate left Calc Solutions \\[5x5-solve-rotate-left] | |
216 | Rotate right Calc Solutions \\[5x5-solve-rotate-right] | |
217 | Quit current game \\[5x5-quit-game]" | |
116f0564 KH |
218 | |
219 | (interactive "P") | |
220 | (setq 5x5-cracking nil) | |
116f0564 | 221 | (switch-to-buffer 5x5-buffer-name) |
b776bc70 VB |
222 | (5x5-mode) |
223 | (when (natnump size) | |
224 | (setq 5x5-grid-size size)) | |
116f0564 KH |
225 | (if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0))))) |
226 | (5x5-new-game)) | |
227 | (5x5-draw-grid (list 5x5-grid)) | |
b776bc70 | 228 | (5x5-position-cursor)) |
116f0564 KH |
229 | |
230 | (defun 5x5-new-game () | |
231 | "Start a new game of `5x5'." | |
232 | (interactive) | |
32226619 JB |
233 | (when (if (called-interactively-p 'interactive) |
234 | (5x5-y-or-n-p "Start a new game? ") t) | |
116f0564 KH |
235 | (setq 5x5-x-pos (/ 5x5-grid-size 2) |
236 | 5x5-y-pos (/ 5x5-grid-size 2) | |
237 | 5x5-moves 0 | |
91513f63 VB |
238 | 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos) |
239 | 5x5-solver-output nil) | |
ca5f43fa RS |
240 | (5x5-draw-grid (list 5x5-grid)) |
241 | (5x5-position-cursor))) | |
116f0564 KH |
242 | |
243 | (defun 5x5-quit-game () | |
244 | "Quit the current game of `5x5'." | |
245 | (interactive) | |
246 | (kill-buffer 5x5-buffer-name)) | |
247 | ||
248 | (defun 5x5-make-new-grid () | |
249 | "Create and return a new `5x5' grid structure." | |
250 | (let ((grid (make-vector 5x5-grid-size nil))) | |
a464a6c7 SM |
251 | (dotimes (y 5x5-grid-size) |
252 | (aset grid y (make-vector 5x5-grid-size nil))) | |
116f0564 KH |
253 | grid)) |
254 | ||
255 | (defun 5x5-cell (grid y x) | |
256 | "Return the value of the cell in GRID at location X,Y." | |
257 | (aref (aref grid y) x)) | |
258 | ||
259 | (defun 5x5-set-cell (grid y x value) | |
260 | "Set the value of cell X,Y in GRID to VALUE." | |
261 | (aset (aref grid y) x value)) | |
262 | ||
263 | (defun 5x5-flip-cell (grid y x) | |
264 | "Flip the value of cell X,Y in GRID." | |
265 | (5x5-set-cell grid y x (not (5x5-cell grid y x)))) | |
266 | ||
267 | (defun 5x5-copy-grid (grid) | |
268 | "Make a new copy of GRID." | |
269 | (let ((copy (5x5-make-new-grid))) | |
a464a6c7 SM |
270 | (dotimes (y 5x5-grid-size) |
271 | (dotimes (x 5x5-grid-size) | |
272 | (5x5-set-cell copy y x (5x5-cell grid y x)))) | |
116f0564 KH |
273 | copy)) |
274 | ||
275 | (defun 5x5-make-move (grid row col) | |
276 | "Make a move on GRID at row ROW and column COL." | |
277 | (5x5-flip-cell grid row col) | |
278 | (if (> row 0) | |
279 | (5x5-flip-cell grid (1- row) col)) | |
280 | (if (< row (- 5x5-grid-size 1)) | |
281 | (5x5-flip-cell grid (1+ row) col)) | |
282 | (if (> col 0) | |
283 | (5x5-flip-cell grid row (1- col))) | |
284 | (if (< col (- 5x5-grid-size 1)) | |
285 | (5x5-flip-cell grid row (1+ col))) | |
286 | grid) | |
287 | ||
288 | (defun 5x5-row-value (row) | |
289 | "Get the \"on-value\" for grid row ROW." | |
a464a6c7 | 290 | (cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0))) |
116f0564 KH |
291 | |
292 | (defun 5x5-grid-value (grid) | |
293 | "Get the \"on-value\" for grid GRID." | |
a464a6c7 SM |
294 | (cl-loop for y from 0 to (1- 5x5-grid-size) |
295 | sum (5x5-row-value (aref grid y)))) | |
116f0564 KH |
296 | |
297 | (defun 5x5-draw-grid-end () | |
849aa553 | 298 | "Draw the top/bottom of the grid." |
116f0564 | 299 | (insert "+") |
a464a6c7 SM |
300 | (dotimes (x 5x5-grid-size) |
301 | (insert "-" (make-string 5x5-x-scale ?-))) | |
116f0564 KH |
302 | (insert "-+ ")) |
303 | ||
304 | (defun 5x5-draw-grid (grids) | |
305 | "Draw the grids GRIDS into the current buffer." | |
b776bc70 | 306 | (let ((inhibit-read-only t) grid-org) |
116f0564 | 307 | (erase-buffer) |
a464a6c7 | 308 | (dolist (grid grids) (5x5-draw-grid-end)) |
116f0564 | 309 | (insert "\n") |
b776bc70 | 310 | (setq grid-org (point)) |
a464a6c7 SM |
311 | (dotimes (y 5x5-grid-size) |
312 | (dotimes (lines 5x5-y-scale) | |
313 | (dolist (grid grids) | |
314 | (dotimes (x 5x5-grid-size) | |
315 | (insert (if (zerop x) "| " " ") | |
316 | (make-string 5x5-x-scale | |
317 | (if (5x5-cell grid y x) ?# ?.)))) | |
318 | (insert " | ")) | |
319 | (insert "\n"))) | |
b776bc70 VB |
320 | (when 5x5-solver-output |
321 | (if (= (car 5x5-solver-output) 5x5-moves) | |
322 | (save-excursion | |
323 | (goto-char grid-org) | |
324 | (beginning-of-line (+ 1 (/ 5x5-y-scale 2))) | |
a464a6c7 SM |
325 | (let ((solution-grid (cl-cdadr 5x5-solver-output))) |
326 | (dotimes (y 5x5-grid-size) | |
b776bc70 VB |
327 | (save-excursion |
328 | (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2))) | |
a464a6c7 | 329 | (dotimes (x 5x5-grid-size) |
b776bc70 | 330 | (when (5x5-cell solution-grid y x) |
7cf3f556 VB |
331 | (if (= 0 (mod 5x5-x-scale 2)) |
332 | (progn | |
333 | (insert "()") | |
334 | (delete-region (point) (+ (point) 2)) | |
335 | (backward-char 2)) | |
b776bc70 VB |
336 | (insert-char ?O 1) |
337 | (delete-char 1) | |
7cf3f556 | 338 | (backward-char))) |
b776bc70 VB |
339 | (forward-char (1+ 5x5-x-scale)))) |
340 | (forward-line 5x5-y-scale)))) | |
341 | (setq 5x5-solver-output nil))) | |
a464a6c7 | 342 | (dolist (grid grids) (5x5-draw-grid-end)) |
116f0564 KH |
343 | (insert "\n") |
344 | (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves)))) | |
345 | ||
346 | (defun 5x5-position-cursor () | |
347 | "Position the cursor on the grid." | |
9b4c5ecd GM |
348 | (goto-char (point-min)) |
349 | (forward-line (1+ (* 5x5-y-pos 5x5-y-scale))) | |
116f0564 KH |
350 | (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1))) |
351 | ||
352 | (defun 5x5-made-move () | |
353 | "Keep track of how many moves have been made." | |
a464a6c7 | 354 | (cl-incf 5x5-moves)) |
116f0564 | 355 | |
b776bc70 | 356 | (defun 5x5-make-random-grid (&optional move) |
116f0564 | 357 | "Make a random grid." |
b776bc70 | 358 | (setq move (or move (symbol-function '5x5-flip-cell))) |
116f0564 | 359 | (let ((grid (5x5-make-new-grid))) |
a464a6c7 SM |
360 | (dotimes (y 5x5-grid-size) |
361 | (dotimes (x 5x5-grid-size) | |
362 | (if (zerop (random 2)) | |
363 | (funcall move grid y x)))) | |
116f0564 KH |
364 | grid)) |
365 | ||
366 | ;; Cracker functions. | |
367 | ||
368 | ;;;###autoload | |
369 | (defun 5x5-crack-randomly () | |
370 | "Attempt to crack 5x5 using random solutions." | |
371 | (interactive) | |
372 | (5x5-crack #'5x5-make-random-solution)) | |
373 | ||
374 | ;;;###autoload | |
375 | (defun 5x5-crack-mutating-current () | |
376 | "Attempt to crack 5x5 by mutating the current solution." | |
377 | (interactive) | |
378 | (5x5-crack #'5x5-make-mutate-current)) | |
379 | ||
380 | ;;;###autoload | |
381 | (defun 5x5-crack-mutating-best () | |
382 | "Attempt to crack 5x5 by mutating the best solution." | |
383 | (interactive) | |
384 | (5x5-crack #'5x5-make-mutate-best)) | |
385 | ||
386 | ;;;###autoload | |
387 | (defun 5x5-crack-xor-mutate () | |
849aa553 | 388 | "Attempt to crack 5x5 by xoring the current and best solution. |
36912c16 | 389 | Mutate the result." |
116f0564 KH |
390 | (interactive) |
391 | (5x5-crack #'5x5-make-xor-with-mutation)) | |
392 | ||
393 | ;;;###autoload | |
394 | (defun 5x5-crack (breeder) | |
395 | "Attempt to find a solution for 5x5. | |
396 | ||
397 | 5x5-crack takes the argument BREEDER which should be a function that takes | |
398 | two parameters, the first will be a grid vector array that is the current | |
849aa553 | 399 | solution and the second will be the best solution so far. The function |
116f0564 KH |
400 | should return a grid vector array that is the new solution." |
401 | ||
402 | (interactive "aBreeder function: ") | |
403 | (5x5) | |
404 | (setq 5x5-cracking t) | |
405 | (let* ((best-solution (5x5-make-random-grid)) | |
406 | (current-solution best-solution) | |
407 | (best-result (5x5-make-new-grid)) | |
408 | (current-result (5x5-make-new-grid)) | |
409 | (target (* 5x5-grid-size 5x5-grid-size))) | |
410 | (while (and (< (5x5-grid-value best-result) target) | |
411 | (not (input-pending-p))) | |
412 | (setq current-result (5x5-play-solution current-solution best-solution)) | |
413 | (if (> (5x5-grid-value current-result) (5x5-grid-value best-result)) | |
414 | (setq best-solution current-solution | |
415 | best-result current-result)) | |
416 | (setq current-solution (funcall breeder | |
417 | (5x5-copy-grid current-solution) | |
418 | (5x5-copy-grid best-solution))))) | |
419 | (setq 5x5-cracking nil)) | |
420 | ||
121656e9 | 421 | (defun 5x5-make-random-solution (&rest _ignore) |
116f0564 KH |
422 | "Make a random solution." |
423 | (5x5-make-random-grid)) | |
424 | ||
121656e9 | 425 | (defun 5x5-make-mutate-current (current _best) |
116f0564 KH |
426 | "Mutate the current solution." |
427 | (5x5-mutate-solution current)) | |
428 | ||
121656e9 | 429 | (defun 5x5-make-mutate-best (_current best) |
116f0564 KH |
430 | "Mutate the best solution." |
431 | (5x5-mutate-solution best)) | |
432 | ||
433 | (defun 5x5-make-xor-with-mutation (current best) | |
849aa553 | 434 | "Xor current and best solution then mutate the result." |
116f0564 | 435 | (let ((xored (5x5-make-new-grid))) |
a464a6c7 SM |
436 | (dotimes (y 5x5-grid-size) |
437 | (dotimes (x 5x5-grid-size) | |
438 | (5x5-set-cell xored y x | |
439 | (5x5-xor (5x5-cell current y x) | |
440 | (5x5-cell best y x))))) | |
116f0564 KH |
441 | (5x5-mutate-solution xored))) |
442 | ||
443 | (defun 5x5-mutate-solution (solution) | |
444 | "Randomly flip bits in the solution." | |
a464a6c7 SM |
445 | (dotimes (y 5x5-grid-size) |
446 | (dotimes (x 5x5-grid-size) | |
447 | (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2)) | |
448 | (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2)) | |
449 | (5x5-flip-cell solution y x)))) | |
116f0564 KH |
450 | solution) |
451 | ||
452 | (defun 5x5-play-solution (solution best) | |
849aa553 JB |
453 | "Play a solution on an empty grid. This destroys the current game |
454 | in progress because it is an animated attempt." | |
116f0564 | 455 | (5x5-new-game) |
26a8d08d | 456 | (let ((inhibit-quit t)) |
a464a6c7 SM |
457 | (dotimes (y 5x5-grid-size) |
458 | (dotimes (x 5x5-grid-size) | |
459 | (setq 5x5-y-pos y | |
460 | 5x5-x-pos x) | |
461 | (if (5x5-cell solution y x) | |
462 | (5x5-flip-current)) | |
463 | (5x5-draw-grid (list 5x5-grid solution best)) | |
464 | (5x5-position-cursor) | |
465 | (sit-for 5x5-animate-delay)))) | |
116f0564 | 466 | 5x5-grid) |
a1506d29 | 467 | |
b776bc70 VB |
468 | ;; Arithmetic solver |
469 | ;;=========================================================================== | |
470 | (defun 5x5-grid-to-vec (grid) | |
471 | "Convert GRID to an equivalent Calc matrix of (mod X 2) forms | |
472 | where X is 1 for setting a position, and 0 for unsetting a | |
473 | position." | |
474 | (cons 'vec | |
475 | (mapcar (lambda (y) | |
476 | (cons 'vec | |
477 | (mapcar (lambda (x) | |
478 | (if x '(mod 1 2) '(mod 0 2))) | |
479 | y))) | |
480 | grid))) | |
481 | ||
482 | (defun 5x5-vec-to-grid (grid-matrix) | |
483 | "Convert a grid matrix GRID-MATRIX in Calc format to a grid in | |
484 | 5x5 format. See function `5x5-grid-to-vec'." | |
485 | (apply | |
486 | 'vector | |
487 | (mapcar | |
488 | (lambda (x) | |
489 | (apply | |
490 | 'vector | |
491 | (mapcar | |
492 | (lambda (y) (/= (cadr y) 0)) | |
493 | (cdr x)))) | |
494 | (cdr grid-matrix)))) | |
495 | ||
eb8a5e9b | 496 | (eval-and-compile |
b776bc70 | 497 | (if nil; set to t to enable solver logging |
91513f63 VB |
498 | ;; Note these logging facilities were not cleaned out as the arithmetic |
499 | ;; solver is not yet complete --- it works only for grid size = 5. | |
500 | ;; So they may be useful again to design a more generic solution. | |
b776bc70 VB |
501 | (progn |
502 | (defvar 5x5-log-buffer nil) | |
503 | (defun 5x5-log-init () | |
504 | (if (buffer-live-p 5x5-log-buffer) | |
505 | (with-current-buffer 5x5-log-buffer (erase-buffer)) | |
506 | (setq 5x5-log-buffer (get-buffer-create "*5x5 LOG*")))) | |
507 | ||
508 | (defun 5x5-log (name value) | |
eb8a5e9b | 509 | "Debug purposes only. |
b776bc70 VB |
510 | |
511 | Log a matrix VALUE of (mod B 2) forms, only B is output and | |
512 | Scilab matrix notation is used. VALUE is returned so that it is | |
513 | easy to log a value with minimal rewrite of code." | |
514 | (when (buffer-live-p 5x5-log-buffer) | |
515 | (let* ((unpacked-value | |
516 | (math-map-vec | |
517 | (lambda (row) (math-map-vec 'cadr row)) | |
518 | value)) | |
519 | (calc-vector-commas "") | |
520 | (calc-matrix-brackets '(C O)) | |
521 | (value-to-log (math-format-value unpacked-value))) | |
522 | (with-current-buffer 5x5-log-buffer | |
523 | (insert name ?= value-to-log ?\n)))) | |
524 | value)) | |
91513f63 VB |
525 | (defsubst 5x5-log-init ()) |
526 | (defsubst 5x5-log (name value) value))) | |
eb8a5e9b GM |
527 | |
528 | (declare-function math-map-vec "calc-vec" (f a)) | |
529 | (declare-function math-sub "calc" (a b)) | |
530 | (declare-function math-mul "calc" (a b)) | |
531 | (declare-function math-make-intv "calc-forms" (mask lo hi)) | |
532 | (declare-function math-reduce-vec "calc-vec" (a b)) | |
533 | (declare-function math-format-number "calc" (a &optional prec)) | |
534 | (declare-function math-pow "calc-misc" (a b)) | |
535 | (declare-function calcFunc-arrange "calc-vec" (vec cols)) | |
536 | (declare-function calcFunc-cvec "calc-vec" (obj &rest dims)) | |
537 | (declare-function calcFunc-diag "calc-vec" (a &optional n)) | |
538 | (declare-function calcFunc-trn "calc-vec" (mat)) | |
539 | (declare-function calcFunc-inv "calc-misc" (m)) | |
540 | (declare-function calcFunc-mrow "calc-vec" (mat n)) | |
541 | (declare-function calcFunc-mcol "calc-vec" (mat n)) | |
542 | (declare-function calcFunc-vconcat "calc-vec" (a b)) | |
543 | (declare-function calcFunc-index "calc-vec" (n &optional start incr)) | |
b776bc70 VB |
544 | |
545 | (defun 5x5-solver (grid) | |
546 | "Return a list of solutions for GRID. | |
547 | ||
548 | Given some grid GRID, the returned a list of solution LIST is | |
eb8a5e9b | 549 | sorted from least Hamming weight to greatest one. |
b776bc70 VB |
550 | |
551 | LIST = (SOLUTION-1 ... SOLUTION-N) | |
552 | ||
553 | Each solution SOLUTION-I is a cons cell (HW . G) where HW is the | |
554 | Hamming weight of the solution --- ie the number of strokes to | |
eb8a5e9b | 555 | achieve it --- and G is the grid of positions to click in order |
b776bc70 VB |
556 | to complete the 5x5. |
557 | ||
558 | Solutions are sorted from least to greatest Hamming weight." | |
559 | (require 'calc-ext) | |
d5c6faf9 SM |
560 | (cl-flet ((5x5-mat-mode-2 |
561 | (a) | |
562 | (math-map-vec | |
563 | (lambda (y) | |
564 | (math-map-vec | |
565 | (lambda (x) `(mod ,x 2)) | |
566 | y)) | |
567 | a))) | |
b776bc70 VB |
568 | (let* (calc-command-flags |
569 | (grid-size-squared (* 5x5-grid-size 5x5-grid-size)) | |
570 | ||
e1dbe924 | 571 | ;; targetv is the vector the origin of which is org="current |
b776bc70 VB |
572 | ;; grid" and the end of which is dest="all ones". |
573 | (targetv | |
574 | (5x5-log | |
575 | "b" | |
576 | (let ( | |
577 | ;; org point is the current grid | |
578 | (org (calcFunc-arrange (5x5-grid-to-vec grid) | |
579 | 1)) | |
580 | ||
581 | ;; end point of game is the all ones matrix | |
582 | (dest (calcFunc-cvec '(mod 1 2) grid-size-squared 1))) | |
583 | (math-sub dest org)))) | |
584 | ||
585 | ;; transferm is the transfer matrix, ie it is the 25x25 | |
586 | ;; matrix applied everytime a flip is carried out where a | |
587 | ;; flip is defined by a 25x1 Dirac vector --- ie all zeros | |
588 | ;; but 1 in the position that is flipped. | |
589 | (transferm | |
590 | (5x5-log | |
591 | "a" | |
592 | ;; transfer-grid is not a play grid, but this is the | |
593 | ;; transfer matrix in the format of a vector of vectors, we | |
594 | ;; do it this way because random access in vectors is | |
595 | ;; faster. The motivation is just speed as we build it | |
596 | ;; element by element, but that could have been created | |
597 | ;; using only Calc primitives. Probably that would be a | |
598 | ;; better idea to use Calc with some vector manipulation | |
599 | ;; rather than going this way... | |
600 | (5x5-grid-to-vec (let ((transfer-grid | |
601 | (let ((5x5-grid-size grid-size-squared)) | |
602 | (5x5-make-new-grid)))) | |
603 | (dotimes (i 5x5-grid-size) | |
604 | (dotimes (j 5x5-grid-size) | |
605 | ;; k0 = flattened flip position corresponding | |
606 | ;; to (i, j) on the grid. | |
607 | (let* ((k0 (+ (* 5 i) j))) | |
608 | ;; cross center | |
609 | (5x5-set-cell transfer-grid k0 k0 t) | |
610 | ;; Cross top. | |
611 | (and | |
612 | (> i 0) | |
613 | (5x5-set-cell transfer-grid | |
614 | (- k0 5x5-grid-size) k0 t)) | |
615 | ;; Cross bottom. | |
616 | (and | |
617 | (< (1+ i) 5x5-grid-size) | |
618 | (5x5-set-cell transfer-grid | |
619 | (+ k0 5x5-grid-size) k0 t)) | |
620 | ;; Cross left. | |
621 | (and | |
622 | (> j 0) | |
623 | (5x5-set-cell transfer-grid (1- k0) k0 t)) | |
624 | ;; Cross right. | |
625 | (and | |
626 | (< (1+ j) 5x5-grid-size) | |
627 | (5x5-set-cell transfer-grid | |
628 | (1+ k0) k0 t))))) | |
629 | transfer-grid)))) | |
630 | ;; TODO: this is hard-coded for grid-size = 5, make it generic. | |
631 | (transferm-kernel-size | |
632 | (if (= 5x5-grid-size 5) 2 | |
633 | (error "Transfer matrix rank not known for grid-size != 5"))) | |
634 | ||
635 | ;; TODO: this is hard-coded for grid-size = 5, make it generic. | |
636 | ;; | |
637 | ;; base-change is a 25x25 matrix, where topleft submatrix | |
638 | ;; 23x25 is a diagonal of 1, and the two last columns are a | |
639 | ;; base of kernel of transferm. | |
640 | ;; | |
53964682 | 641 | ;; base-change must be by construction invertible. |
b776bc70 VB |
642 | (base-change |
643 | (5x5-log | |
644 | "p" | |
645 | (let ((id (5x5-mat-mode-2 (calcFunc-diag 1 grid-size-squared)))) | |
646 | (setcdr (last id (1+ transferm-kernel-size)) | |
647 | (cdr (5x5-mat-mode-2 | |
648 | '(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1 | |
649 | 1 1 0 1 0 1 0 1 1 1 0) | |
d5c6faf9 SM |
650 | (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1 |
651 | 1 0 0 0 0 0 1 1 0 1 1))))) | |
b776bc70 VB |
652 | (calcFunc-trn id)))) |
653 | ||
654 | (inv-base-change | |
655 | (5x5-log "invp" | |
656 | (calcFunc-inv base-change))) | |
657 | ||
658 | ;; B:= targetv | |
659 | ;; A:= transferm | |
660 | ;; P:= base-change | |
661 | ;; P^-1 := inv-base-change | |
662 | ;; X := solution | |
663 | ||
664 | ;; B = A * X | |
665 | ;; P^-1 * B = P^-1 * A * P * P^-1 * X | |
666 | ;; CX = P^-1 * X | |
667 | ;; CA = P^-1 * A * P | |
668 | ;; CB = P^-1 * B | |
669 | ;; CB = CA * CX | |
670 | ;; CX = CA^-1 * CB | |
671 | ;; X = P * CX | |
672 | (ctransferm | |
673 | (5x5-log | |
674 | "ca" | |
675 | (math-mul | |
676 | inv-base-change | |
677 | (math-mul transferm base-change)))); CA | |
678 | (ctarget | |
679 | (5x5-log | |
680 | "cb" | |
681 | (math-mul inv-base-change targetv))); CB | |
682 | (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2 | |
683 | (row-2 (math-make-intv 1 transferm-kernel-size | |
684 | grid-size-squared)); 3..25 | |
685 | (col-1 (math-make-intv 3 1 (- grid-size-squared | |
686 | transferm-kernel-size))); 1..23 | |
687 | (col-2 (math-make-intv 1 (- grid-size-squared | |
688 | transferm-kernel-size) | |
689 | grid-size-squared)); 24..25 | |
690 | (ctransferm-1-: (calcFunc-mrow ctransferm row-1)) | |
691 | (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1)) | |
692 | ||
693 | ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0 | |
694 | ;; and ctransferm-2-2 = 0. | |
695 | ||
696 | ;;(ctransferm-1-2 (calcFunc-mcol ctransferm-1-: col-2)) | |
697 | (ctransferm-2-: (calcFunc-mrow ctransferm row-2)) | |
698 | (ctransferm-2-1 | |
699 | (5x5-log | |
700 | "ca_2_1" | |
701 | (calcFunc-mcol ctransferm-2-: col-1))) | |
702 | ||
703 | ;; By construction ctransferm-2-2 = 0. | |
704 | ;; | |
705 | ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2)) | |
706 | ||
707 | (ctarget-1 (calcFunc-mrow ctarget row-1)) | |
708 | (ctarget-2 (calcFunc-mrow ctarget row-2)) | |
709 | ||
710 | ;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1) | |
711 | ;; + ctransferm-1-2(2x2) *cx-2(2x1); | |
712 | ;; ctarget-2(23x1) = ctransferm-2-1(23x23)*cx-1(23x1) | |
713 | ;; + ctransferm-2-2(23x2)*cx-2(2x1); | |
714 | ;; By construction: | |
715 | ;; | |
716 | ;; ctransferm-1-2 == zeros(2,2) and ctransferm-2-2 == zeros(23,2) | |
717 | ;; | |
718 | ;; So: | |
719 | ;; | |
720 | ;; ctarget-2 = ctransferm-2-1*cx-1 | |
721 | ;; | |
722 | ;; So: | |
723 | ;; | |
724 | ;; cx-1 = inv-ctransferm-2-1 * ctarget-2 | |
725 | (cx-1 (math-mul (calcFunc-inv ctransferm-2-1) ctarget-2)) | |
726 | ||
727 | ;; Any cx-2 can do, so there are 2^{transferm-kernel-size} solutions. | |
728 | (solution-list | |
729 | ;; Within solution-list each element is a cons cell: | |
730 | ;; | |
731 | ;; (HW . SOL) | |
732 | ;; | |
733 | ;; where HW is the Hamming weight of solution, and SOL is | |
734 | ;; the solution in the form of a grid. | |
735 | (sort | |
736 | (cdr | |
737 | (math-map-vec | |
738 | (lambda (cx-2) | |
739 | ;; Compute `solution' in the form of a 25x1 matrix of | |
740 | ;; (mod B 2) forms --- with B = 0 or 1 --- and | |
741 | ;; return (HW . SOL) where HW is the Hamming weight | |
742 | ;; of solution and SOL a grid. | |
743 | (let ((solution (math-mul | |
744 | base-change | |
745 | (calcFunc-vconcat cx-1 cx-2)))); X = P * CX | |
746 | (cons | |
747 | ;; The Hamming Weight is computed by matrix reduction | |
748 | ;; with an ad-hoc operator. | |
749 | (math-reduce-vec | |
a464a6c7 SM |
750 | ;; (cl-cadadr '(vec (mod x 2))) => x |
751 | (lambda (r x) (+ (if (integerp r) r (cl-cadadr r)) | |
752 | (cl-cadadr x))) | |
b776bc70 VB |
753 | solution); car |
754 | (5x5-vec-to-grid | |
755 | (calcFunc-arrange solution 5x5-grid-size));cdr | |
756 | ))) | |
757 | ;; A (2^K) x K matrix, where K is the dimension of kernel | |
758 | ;; of transfer matrix --- i.e. K=2 in if the grid is 5x5 | |
759 | ;; --- for I from 0 to K-1, each row rI correspond to the | |
760 | ;; binary representation of number I, that is to say row | |
761 | ;; rI is a 1xK vector: | |
762 | ;; [ n{I,0} n{I,1} ... n{I,K-1} ] | |
763 | ;; such that: | |
764 | ;; I = sum for J=0..K-1 of 2^(n{I,J}) | |
765 | (let ((calc-number-radix 2) | |
766 | (calc-leading-zeros t) | |
767 | (calc-word-size transferm-kernel-size)) | |
768 | (math-map-vec | |
769 | (lambda (x) | |
770 | (cons 'vec | |
771 | (mapcar (lambda (x) `(vec (mod ,(logand x 1) 2))) | |
772 | (substring (math-format-number x) | |
773 | (- transferm-kernel-size))))) | |
774 | (calcFunc-index (math-pow 2 transferm-kernel-size) 0))) )) | |
775 | ;; Sort solutions according to respective Hamming weight. | |
776 | (lambda (x y) (< (car x) (car y))) | |
777 | ))) | |
778 | (message "5x5 Solution computation done.") | |
779 | solution-list))) | |
780 | ||
781 | (defun 5x5-solve-suggest (&optional n) | |
782 | "Suggest to the user where to click. | |
783 | ||
784 | Argument N is ignored." | |
785 | ;; For the time being n is ignored, the idea was to use some numeric | |
786 | ;; argument to show a limited amount of positions. | |
787 | (interactive "P") | |
788 | (5x5-log-init) | |
789 | (let ((solutions (5x5-solver 5x5-grid))) | |
790 | (setq 5x5-solver-output | |
791 | (cons 5x5-moves solutions))) | |
792 | (5x5-draw-grid (list 5x5-grid)) | |
793 | (5x5-position-cursor)) | |
794 | ||
7cf3f556 VB |
795 | (defun 5x5-solve-rotate-left (&optional n) |
796 | "Rotate left by N the list of solutions in 5x5-solver-output. | |
797 | ||
798 | If N is not supplied rotate by 1, that is to say put the last | |
799 | element first in the list. | |
800 | ||
801 | The 5x5 game has in general several solutions. For grid size=5, | |
802 | there are 4 possible solutions. When function | |
803 | `5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the | |
804 | solution that is presented is the one that needs least number of | |
805 | strokes --- other solutions can be viewed by rotating through the | |
806 | list. The list of solution is ordered by number of strokes, so | |
807 | rotating left just after calling `5x5-solve-suggest' will show | |
58179cce JB |
808 | the solution with second least number of strokes, while rotating |
809 | right will show the solution with greatest number of strokes." | |
7cf3f556 VB |
810 | (interactive "P") |
811 | (let ((len (length 5x5-solver-output))) | |
812 | (when (>= len 3) | |
813 | (setq n (if (integerp n) n 1) | |
814 | n (mod n (1- len))) | |
815 | (unless (eq n 0) | |
816 | (setq n (- len n 1)) | |
817 | (let* ((p-tail (last 5x5-solver-output (1+ n))) | |
818 | (tail (cdr p-tail)) | |
819 | (l-tail (last tail))) | |
820 | ;; | |
821 | ;; For n = 2: | |
822 | ;; | |
823 | ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ | |
824 | ;; |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil | |
825 | ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ | |
826 | ;; ^ ^ ^ ^ | |
827 | ;; | | | | | |
828 | ;; + 5x5-solver-output | | + l-tail | |
829 | ;; + p-tail | | |
830 | ;; + tail | |
831 | ;; | |
832 | (setcdr l-tail (cdr 5x5-solver-output)) | |
833 | (setcdr 5x5-solver-output tail) | |
834 | (unless (eq p-tail 5x5-solver-output) | |
835 | (setcdr p-tail nil))) | |
836 | (5x5-draw-grid (list 5x5-grid)) | |
837 | (5x5-position-cursor))))) | |
838 | ||
839 | (defun 5x5-solve-rotate-right (&optional n) | |
840 | "Rotate right by N the list of solutions in 5x5-solver-output. | |
841 | If N is not supplied, rotate by 1. Similar to function | |
842 | `5x5-solve-rotate-left' except that rotation is right instead of | |
843 | lest." | |
844 | (interactive "P") | |
845 | (setq n | |
846 | (if (integerp n) (- n) | |
847 | -1)) | |
848 | (5x5-solve-rotate-left n)) | |
849 | ||
850 | ||
851 | ||
116f0564 KH |
852 | ;; Keyboard response functions. |
853 | ||
854 | (defun 5x5-flip-current () | |
855 | "Make a move on the current cursor location." | |
856 | (interactive) | |
857 | (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos)) | |
858 | (5x5-made-move) | |
859 | (unless 5x5-cracking | |
860 | (5x5-draw-grid (list 5x5-grid))) | |
861 | (5x5-position-cursor) | |
862 | (when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size)) | |
863 | (beep) | |
864 | (message "You win!"))) | |
865 | ||
866 | (defun 5x5-up () | |
867 | "Move up." | |
868 | (interactive) | |
869 | (unless (zerop 5x5-y-pos) | |
a464a6c7 | 870 | (cl-decf 5x5-y-pos) |
116f0564 KH |
871 | (5x5-position-cursor))) |
872 | ||
873 | (defun 5x5-down () | |
874 | "Move down." | |
875 | (interactive) | |
876 | (unless (= 5x5-y-pos (1- 5x5-grid-size)) | |
a464a6c7 | 877 | (cl-incf 5x5-y-pos) |
116f0564 KH |
878 | (5x5-position-cursor))) |
879 | ||
880 | (defun 5x5-left () | |
881 | "Move left." | |
882 | (interactive) | |
883 | (unless (zerop 5x5-x-pos) | |
a464a6c7 | 884 | (cl-decf 5x5-x-pos) |
116f0564 KH |
885 | (5x5-position-cursor))) |
886 | ||
887 | (defun 5x5-right () | |
888 | "Move right." | |
889 | (interactive) | |
890 | (unless (= 5x5-x-pos (1- 5x5-grid-size)) | |
a464a6c7 | 891 | (cl-incf 5x5-x-pos) |
116f0564 KH |
892 | (5x5-position-cursor))) |
893 | ||
894 | (defun 5x5-bol () | |
895 | "Move to beginning of line." | |
896 | (interactive) | |
897 | (setq 5x5-x-pos 0) | |
898 | (5x5-position-cursor)) | |
899 | ||
900 | (defun 5x5-eol () | |
901 | "Move to end of line." | |
902 | (interactive) | |
903 | (setq 5x5-x-pos (1- 5x5-grid-size)) | |
904 | (5x5-position-cursor)) | |
905 | ||
906 | (defun 5x5-first () | |
907 | "Move to the first cell." | |
908 | (interactive) | |
909 | (setq 5x5-x-pos 0 | |
910 | 5x5-y-pos 0) | |
911 | (5x5-position-cursor)) | |
912 | ||
913 | (defun 5x5-last () | |
914 | "Move to the last cell." | |
915 | (interactive) | |
916 | (setq 5x5-x-pos (1- 5x5-grid-size) | |
917 | 5x5-y-pos (1- 5x5-grid-size)) | |
918 | (5x5-position-cursor)) | |
919 | ||
920 | (defun 5x5-randomize () | |
921 | "Randomize the grid." | |
922 | (interactive) | |
923 | (when (5x5-y-or-n-p "Start a new game with a random grid? ") | |
924 | (setq 5x5-x-pos (/ 5x5-grid-size 2) | |
925 | 5x5-y-pos (/ 5x5-grid-size 2) | |
926 | 5x5-moves 0 | |
91513f63 VB |
927 | 5x5-grid (5x5-make-random-grid (symbol-function '5x5-make-move)) |
928 | 5x5-solver-output nil) | |
116f0564 KH |
929 | (unless 5x5-cracking |
930 | (5x5-draw-grid (list 5x5-grid))) | |
931 | (5x5-position-cursor))) | |
932 | ||
933 | ;; Support functions | |
934 | ||
935 | (defun 5x5-xor (x y) | |
936 | "Boolean exclusive-or of X and Y." | |
937 | (and (or x y) (not (and x y)))) | |
a1506d29 | 938 | |
116f0564 | 939 | (defun 5x5-y-or-n-p (prompt) |
849aa553 | 940 | "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting." |
116f0564 KH |
941 | (if 5x5-hassle-me |
942 | (y-or-n-p prompt) | |
943 | t)) | |
944 | ||
945 | (provide '5x5) | |
946 | ||
947 | ;;; 5x5.el ends here |