1 ;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*-
3 ;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
5 ;; Author: Dave Pearson <davep@davep.org>
6 ;; Maintainer: Dave Pearson <davep@davep.org>
8 ;; Keywords: games puzzles
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; The aim of 5x5 is to fill in all the squares. If you need any more of an
28 ;; explanation you probably shouldn't play the game.
32 ;; o The code for updating the grid needs to be re-done. At the moment it
33 ;; simply re-draws the grid every time a move is made.
35 ;; o Look into tarting up the display with color. gamegrid.el looks
36 ;; interesting, perhaps that is the way to go?
40 ;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an
43 ;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated
46 ;; Vincent Belaïche <vincentb1@users.sourceforge.net> & Jay P. Belanger
47 ;; <jay.p.belanger@gmail.com> for the math solver.
59 "5x5 - Silly little puzzle game."
63 (defcustom 5x5-grid-size
5
64 "Size of the playing area."
68 (defcustom 5x5-x-scale
4
69 "X scaling factor for drawing the grid."
73 (defcustom 5x5-y-scale
3
74 "Y scaling factor for drawing the grid."
78 (defcustom 5x5-animate-delay
.01
79 "Delay in seconds when animating a solution crack."
83 (defcustom 5x5-hassle-me t
84 "Should 5x5 ask you when you want to do a destructive operation?"
88 (defcustom 5x5-mode-hook nil
89 "Hook run on starting 5x5."
93 ;; Non-customize variables.
95 (defmacro 5x5-defvar-local
(var value doc
)
96 "Define VAR to VALUE with documentation DOC and make it buffer local."
98 (defvar ,var
,value
,doc
)
99 (make-variable-buffer-local (quote ,var
))))
101 (5x5-defvar-local 5x5-grid nil
102 "5x5 grid contents.")
104 (5x5-defvar-local 5x5-x-pos
2
105 "X position of cursor.")
107 (5x5-defvar-local 5x5-y-pos
2
108 "Y position of cursor.")
110 (5x5-defvar-local 5x5-moves
0
113 (5x5-defvar-local 5x5-cracking nil
114 "Are we in cracking mode?")
116 (defvar 5x5-buffer-name
"*5x5*"
117 "Name of the 5x5 play buffer.")
120 (let ((map (make-sparse-keymap)))
121 (suppress-keymap map t
)
122 (define-key map
"?" #'describe-mode
)
123 (define-key map
"\r" #'5x5-flip-current
)
124 (define-key map
" " #'5x5-flip-current
)
125 (define-key map
[up] #'5x5-up)
126 (define-key map [down] #'5x5-down)
127 (define-key map [left] #'5x5-left)
128 (define-key map [tab] #'5x5-right)
129 (define-key map [right] #'5x5-right)
130 (define-key map [(control a)] #'5x5-bol)
131 (define-key map [(control e)] #'5x5-eol)
132 (define-key map [(control p)] #'5x5-up)
133 (define-key map [(control n)] #'5x5-down)
134 (define-key map [(control b)] #'5x5-left)
135 (define-key map [(control f)] #'5x5-right)
136 (define-key map [home] #'5x5-bol)
137 (define-key map [end] #'5x5-eol)
138 (define-key map [prior] #'5x5-first)
139 (define-key map [next] #'5x5-last)
140 (define-key map "r" #'5x5-randomize)
141 (define-key map [(control c) (control r)] #'5x5-crack-randomly)
142 (define-key map [(control c) (control c)] #'5x5-crack-mutating-current)
143 (define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
144 (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
145 (define-key map "n" #'5x5-new-game)
146 (define-key map "s" #'5x5-solve-suggest)
147 (define-key map "q" #'5x5-quit-game)
149 "Local keymap for the 5x5 game.")
151 (5x5-defvar-local 5x5-solver-output nil
152 "List that is is the output of artihmetic solver.
154 This list L is such that
156 L = (M S_1 S_2 ... S_N)
158 M is the move count when the solve output was stored.
160 S_1 ... S_N are all the solutions ordered from least to greatest
161 number of strokes. S_1 is the solution to be displayed.
163 Each solution S_1, ..., S_N is a a list (STROKE-COUNT GRID) where
164 STROKE-COUNT is to number of strokes to achieve the solution and
165 GRID is the grid of positions to click.")
170 (easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
172 ["New game" 5x5-new-game t]
173 ["Random game" 5x5-randomize t]
174 ["Quit game" 5x5-quit-game t]
176 ["Use Calc solver" 5x5-solve-suggest t]
177 ["Crack randomly" 5x5-crack-randomly t]
178 ["Crack mutating current" 5x5-crack-mutating-current t]
179 ["Crack mutating best" 5x5-crack-mutating-best t]
180 ["Crack with xor mutate" 5x5-crack-xor-mutate t]))
182 ;; Gameplay functions.
184 (put '5x5-mode 'mode-class 'special)
187 "A mode for playing `5x5'.
189 The key bindings for `5x5-mode' are:
192 (kill-all-local-variables)
193 (use-local-map 5x5-mode-map)
194 (setq major-mode '5x5-mode
196 (run-mode-hooks '5x5-mode-hook)
197 (setq buffer-read-only t
199 (buffer-disable-undo))
202 (defun 5x5 (&optional size)
205 The object of 5x5 is very simple, by moving around the grid and flipping
206 squares you must fill the grid.
208 5x5 keyboard bindings are:
210 Flip \\[5x5-flip-current]
212 Move down \\[5x5-down]
213 Move left \\[5x5-left]
214 Move right \\[5x5-right]
215 Start new game \\[5x5-new-game]
216 New game with random grid \\[5x5-randomize]
217 Random cracker \\[5x5-crack-randomly]
218 Mutate current cracker \\[5x5-crack-mutating-current]
219 Mutate best cracker \\[5x5-crack-mutating-best]
220 Mutate xor cracker \\[5x5-crack-xor-mutate]
221 Quit current game \\[5x5-quit-game]"
224 (setq 5x5-cracking nil)
225 (switch-to-buffer 5x5-buffer-name)
228 (setq 5x5-grid-size size))
229 (if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0)))))
231 (5x5-draw-grid (list 5x5-grid))
232 (5x5-position-cursor))
234 (defun 5x5-new-game ()
235 "Start a new game of `5x5'."
237 (when (if (called-interactively-p 'interactive)
238 (5x5-y-or-n-p "Start a new game? ") t)
239 (setq 5x5-x-pos (/ 5x5-grid-size 2)
240 5x5-y-pos (/ 5x5-grid-size 2)
242 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)
243 5x5-solver-output nil)
244 (5x5-draw-grid (list 5x5-grid))
245 (5x5-position-cursor)))
247 (defun 5x5-quit-game ()
248 "Quit the current game of `5x5'."
250 (kill-buffer 5x5-buffer-name))
252 (defun 5x5-make-new-grid ()
253 "Create and return a new `5x5' grid structure."
254 (let ((grid (make-vector 5x5-grid-size nil)))
255 (loop for y from 0 to (1- 5x5-grid-size) do
256 (aset grid y (make-vector 5x5-grid-size nil)))
259 (defun 5x5-cell (grid y x)
260 "Return the value of the cell in GRID at location X,Y."
261 (aref (aref grid y) x))
263 (defun 5x5-set-cell (grid y x value)
264 "Set the value of cell X,Y in GRID to VALUE."
265 (aset (aref grid y) x value))
267 (defun 5x5-flip-cell (grid y x)
268 "Flip the value of cell X,Y in GRID."
269 (5x5-set-cell grid y x (not (5x5-cell grid y x))))
271 (defun 5x5-copy-grid (grid)
272 "Make a new copy of GRID."
273 (let ((copy (5x5-make-new-grid)))
274 (loop for y from 0 to (1- 5x5-grid-size) do
275 (loop for x from 0 to (1- 5x5-grid-size) do
276 (5x5-set-cell copy y x (5x5-cell grid y x))))
279 (defun 5x5-make-move (grid row col)
280 "Make a move on GRID at row ROW and column COL."
281 (5x5-flip-cell grid row col)
283 (5x5-flip-cell grid (1- row) col))
284 (if (< row (- 5x5-grid-size 1))
285 (5x5-flip-cell grid (1+ row) col))
287 (5x5-flip-cell grid row (1- col)))
288 (if (< col (- 5x5-grid-size 1))
289 (5x5-flip-cell grid row (1+ col)))
292 (defun 5x5-row-value (row)
293 "Get the \"on-value\" for grid row ROW."
294 (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
296 (defun 5x5-grid-value (grid)
297 "Get the \"on-value\" for grid GRID."
298 (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y))))
300 (defun 5x5-draw-grid-end ()
301 "Draw the top/bottom of the grid."
303 (loop for x from 0 to (1- 5x5-grid-size) do
304 (insert "-" (make-string 5x5-x-scale ?-)))
307 (defun 5x5-draw-grid (grids)
308 "Draw the grids GRIDS into the current buffer."
309 (let ((inhibit-read-only t) grid-org)
311 (loop for grid in grids do (5x5-draw-grid-end))
313 (setq grid-org (point))
314 (loop for y from 0 to (1- 5x5-grid-size) do
315 (loop for lines from 0 to (1- 5x5-y-scale) do
316 (loop for grid in grids do
317 (loop for x from 0 to (1- 5x5-grid-size) do
318 (insert (if (zerop x) "| " " ")
319 (make-string 5x5-x-scale
320 (if (5x5-cell grid y x) ?# ?.))))
323 (when 5x5-solver-output
324 (if (= (car 5x5-solver-output) 5x5-moves)
327 (beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
328 (let ((solution-grid (cdadr 5x5-solver-output)))
329 (dotimes (y 5x5-grid-size)
331 (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
332 (dotimes (x 5x5-grid-size)
333 (when (5x5-cell solution-grid y x)
337 (forward-char (1+ 5x5-x-scale))))
338 (forward-line 5x5-y-scale))))
339 (setq 5x5-solver-output nil)))
340 (loop for grid in grids do (5x5-draw-grid-end))
342 (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
344 (defun 5x5-position-cursor ()
345 "Position the cursor on the grid."
346 (goto-char (point-min))
347 (forward-line (1+ (* 5x5-y-pos 5x5-y-scale)))
348 (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1)))
350 (defun 5x5-made-move ()
351 "Keep track of how many moves have been made."
354 (defun 5x5-make-random-grid (&optional move)
355 "Make a random grid."
356 (setq move (or move (symbol-function '5x5-flip-cell)))
357 (let ((grid (5x5-make-new-grid)))
358 (loop for y from 0 to (1- 5x5-grid-size) do
359 (loop for x from 0 to (1- 5x5-grid-size) do
360 (if (zerop (random 2))
361 (funcall move grid y x))))
364 ;; Cracker functions.
367 (defun 5x5-crack-randomly ()
368 "Attempt to crack 5x5 using random solutions."
370 (5x5-crack #'5x5-make-random-solution))
373 (defun 5x5-crack-mutating-current ()
374 "Attempt to crack 5x5 by mutating the current solution."
376 (5x5-crack #'5x5-make-mutate-current))
379 (defun 5x5-crack-mutating-best ()
380 "Attempt to crack 5x5 by mutating the best solution."
382 (5x5-crack #'5x5-make-mutate-best))
385 (defun 5x5-crack-xor-mutate ()
386 "Attempt to crack 5x5 by xoring the current and best solution.
389 (5x5-crack #'5x5-make-xor-with-mutation))
392 (defun 5x5-crack (breeder)
393 "Attempt to find a solution for 5x5.
395 5x5-crack takes the argument BREEDER which should be a function that takes
396 two parameters, the first will be a grid vector array that is the current
397 solution and the second will be the best solution so far. The function
398 should return a grid vector array that is the new solution."
400 (interactive "aBreeder function: ")
402 (setq 5x5-cracking t)
403 (let* ((best-solution (5x5-make-random-grid))
404 (current-solution best-solution)
405 (best-result (5x5-make-new-grid))
406 (current-result (5x5-make-new-grid))
407 (target (* 5x5-grid-size 5x5-grid-size)))
408 (while (and (< (5x5-grid-value best-result) target)
409 (not (input-pending-p)))
410 (setq current-result (5x5-play-solution current-solution best-solution))
411 (if (> (5x5-grid-value current-result) (5x5-grid-value best-result))
412 (setq best-solution current-solution
413 best-result current-result))
414 (setq current-solution (funcall breeder
415 (5x5-copy-grid current-solution)
416 (5x5-copy-grid best-solution)))))
417 (setq 5x5-cracking nil))
419 (defun 5x5-make-random-solution (&rest _ignore)
420 "Make a random solution."
421 (5x5-make-random-grid))
423 (defun 5x5-make-mutate-current (current _best)
424 "Mutate the current solution."
425 (5x5-mutate-solution current))
427 (defun 5x5-make-mutate-best (_current best)
428 "Mutate the best solution."
429 (5x5-mutate-solution best))
431 (defun 5x5-make-xor-with-mutation (current best)
432 "Xor current and best solution then mutate the result."
433 (let ((xored (5x5-make-new-grid)))
434 (loop for y from 0 to (1- 5x5-grid-size) do
435 (loop for x from 0 to (1- 5x5-grid-size) do
436 (5x5-set-cell xored y x
437 (5x5-xor (5x5-cell current y x)
438 (5x5-cell best y x)))))
439 (5x5-mutate-solution xored)))
441 (defun 5x5-mutate-solution (solution)
442 "Randomly flip bits in the solution."
443 (loop for y from 0 to (1- 5x5-grid-size) do
444 (loop for x from 0 to (1- 5x5-grid-size) do
445 (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
446 (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
447 (5x5-flip-cell solution y x))))
450 (defun 5x5-play-solution (solution best)
451 "Play a solution on an empty grid. This destroys the current game
452 in progress because it is an animated attempt."
454 (let ((inhibit-quit t))
455 (loop for y from 0 to (1- 5x5-grid-size) do
456 (loop for x from 0 to (1- 5x5-grid-size) do
459 (if (5x5-cell solution y x)
461 (5x5-draw-grid (list 5x5-grid solution best))
462 (5x5-position-cursor)
463 (sit-for 5x5-animate-delay))))
467 ;;===========================================================================
468 (defun 5x5-grid-to-vec (grid)
469 "Convert GRID to an equivalent Calc matrix of (mod X 2) forms
470 where X is 1 for setting a position, and 0 for unsetting a
476 (if x '(mod 1 2) '(mod 0 2)))
480 (defun 5x5-vec-to-grid (grid-matrix)
481 "Convert a grid matrix GRID-MATRIX in Calc format to a grid in
482 5x5 format. See function `5x5-grid-to-vec'."
490 (lambda (y) (/= (cadr y) 0))
495 (if nil; set to t to enable solver logging
496 ;; Note these logging facilities were not cleaned out as the arithmetic
497 ;; solver is not yet complete --- it works only for grid size = 5.
498 ;; So they may be useful again to design a more generic solution.
500 (defvar 5x5-log-buffer nil)
501 (defun 5x5-log-init ()
502 (if (buffer-live-p 5x5-log-buffer)
503 (with-current-buffer 5x5-log-buffer (erase-buffer))
504 (setq 5x5-log-buffer (get-buffer-create "*5x5 LOG*"))))
506 (defun 5x5-log (name value)
507 "Debug purposes only.
509 Log a matrix VALUE of (mod B 2) forms, only B is output and
510 Scilab matrix notation is used. VALUE is returned so that it is
511 easy to log a value with minimal rewrite of code."
512 (when (buffer-live-p 5x5-log-buffer)
513 (let* ((unpacked-value
515 (lambda (row) (math-map-vec 'cadr row))
517 (calc-vector-commas "")
518 (calc-matrix-brackets '(C O))
519 (value-to-log (math-format-value unpacked-value)))
520 (with-current-buffer 5x5-log-buffer
521 (insert name ?= value-to-log ?\n))))
523 (defsubst 5x5-log-init ())
524 (defsubst 5x5-log (name value) value)))
526 (declare-function math-map-vec "calc-vec" (f a))
527 (declare-function math-sub "calc" (a b))
528 (declare-function math-mul "calc" (a b))
529 (declare-function math-make-intv "calc-forms" (mask lo hi))
530 (declare-function math-reduce-vec "calc-vec" (a b))
531 (declare-function math-format-number "calc" (a &optional prec))
532 (declare-function math-pow "calc-misc" (a b))
533 (declare-function calcFunc-arrange "calc-vec" (vec cols))
534 (declare-function calcFunc-cvec "calc-vec" (obj &rest dims))
535 (declare-function calcFunc-diag "calc-vec" (a &optional n))
536 (declare-function calcFunc-trn "calc-vec" (mat))
537 (declare-function calcFunc-inv "calc-misc" (m))
538 (declare-function calcFunc-mrow "calc-vec" (mat n))
539 (declare-function calcFunc-mcol "calc-vec" (mat n))
540 (declare-function calcFunc-vconcat "calc-vec" (a b))
541 (declare-function calcFunc-index "calc-vec" (n &optional start incr))
543 (defun 5x5-solver (grid)
544 "Return a list of solutions for GRID.
546 Given some grid GRID, the returned a list of solution LIST is
547 sorted from least Hamming weight to greatest one.
549 LIST = (SOLUTION-1 ... SOLUTION-N)
551 Each solution SOLUTION-I is a cons cell (HW . G) where HW is the
552 Hamming weight of the solution --- ie the number of strokes to
553 achieve it --- and G is the grid of positions to click in order
556 Solutions are sorted from least to greatest Hamming weight."
558 (flet ((5x5-mat-mode-2
563 (lambda (x) `(mod ,x 2))
566 (let* (calc-command-flags
567 (grid-size-squared (* 5x5-grid-size 5x5-grid-size))
569 ;; targetv is the vector the origine of which is org="current
570 ;; grid" and the end of which is dest="all ones".
575 ;; org point is the current grid
576 (org (calcFunc-arrange (5x5-grid-to-vec grid)
579 ;; end point of game is the all ones matrix
580 (dest (calcFunc-cvec '(mod 1 2) grid-size-squared 1)))
581 (math-sub dest org))))
583 ;; transferm is the transfer matrix, ie it is the 25x25
584 ;; matrix applied everytime a flip is carried out where a
585 ;; flip is defined by a 25x1 Dirac vector --- ie all zeros
586 ;; but 1 in the position that is flipped.
590 ;; transfer-grid is not a play grid, but this is the
591 ;; transfer matrix in the format of a vector of vectors, we
592 ;; do it this way because random access in vectors is
593 ;; faster. The motivation is just speed as we build it
594 ;; element by element, but that could have been created
595 ;; using only Calc primitives. Probably that would be a
596 ;; better idea to use Calc with some vector manipulation
597 ;; rather than going this way...
598 (5x5-grid-to-vec (let ((transfer-grid
599 (let ((5x5-grid-size grid-size-squared))
600 (5x5-make-new-grid))))
601 (dotimes (i 5x5-grid-size)
602 (dotimes (j 5x5-grid-size)
603 ;; k0 = flattened flip position corresponding
604 ;; to (i, j) on the grid.
605 (let* ((k0 (+ (* 5 i) j)))
607 (5x5-set-cell transfer-grid k0 k0 t)
611 (5x5-set-cell transfer-grid
612 (- k0 5x5-grid-size) k0 t))
615 (< (1+ i) 5x5-grid-size)
616 (5x5-set-cell transfer-grid
617 (+ k0 5x5-grid-size) k0 t))
621 (5x5-set-cell transfer-grid (1- k0) k0 t))
624 (< (1+ j) 5x5-grid-size)
625 (5x5-set-cell transfer-grid
628 ;; TODO: this is hard-coded for grid-size = 5, make it generic.
629 (transferm-kernel-size
630 (if (= 5x5-grid-size 5) 2
631 (error "Transfer matrix rank not known for grid-size != 5")))
633 ;; TODO: this is hard-coded for grid-size = 5, make it generic.
635 ;; base-change is a 25x25 matrix, where topleft submatrix
636 ;; 23x25 is a diagonal of 1, and the two last columns are a
637 ;; base of kernel of transferm.
639 ;; base-change must be by construction inversible.
643 (let ((id (5x5-mat-mode-2 (calcFunc-diag 1 grid-size-squared))))
644 (setcdr (last id (1+ transferm-kernel-size))
646 '(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
647 1 1 0 1 0 1 0 1 1 1 0)
648 (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
649 1 0 0 0 0 0 1 1 0 1 1)))))
654 (calcFunc-inv base-change)))
659 ;; P^-1 := inv-base-change
663 ;; P^-1 * B = P^-1 * A * P * P^-1 * X
675 (math-mul transferm base-change)))); CA
679 (math-mul inv-base-change targetv))); CB
680 (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
681 (row-2 (math-make-intv 1 transferm-kernel-size
682 grid-size-squared)); 3..25
683 (col-1 (math-make-intv 3 1 (- grid-size-squared
684 transferm-kernel-size))); 1..23
685 (col-2 (math-make-intv 1 (- grid-size-squared
686 transferm-kernel-size)
687 grid-size-squared)); 24..25
688 (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
689 (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
691 ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
692 ;; and ctransferm-2-2 = 0.
694 ;;(ctransferm-1-2 (calcFunc-mcol ctransferm-1-: col-2))
695 (ctransferm-2-: (calcFunc-mrow ctransferm row-2))
699 (calcFunc-mcol ctransferm-2-: col-1)))
701 ;; By construction ctransferm-2-2 = 0.
703 ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
705 (ctarget-1 (calcFunc-mrow ctarget row-1))
706 (ctarget-2 (calcFunc-mrow ctarget row-2))
708 ;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
709 ;; + ctransferm-1-2(2x2) *cx-2(2x1);
710 ;; ctarget-2(23x1) = ctransferm-2-1(23x23)*cx-1(23x1)
711 ;; + ctransferm-2-2(23x2)*cx-2(2x1);
714 ;; ctransferm-1-2 == zeros(2,2) and ctransferm-2-2 == zeros(23,2)
718 ;; ctarget-2 = ctransferm-2-1*cx-1
722 ;; cx-1 = inv-ctransferm-2-1 * ctarget-2
723 (cx-1 (math-mul (calcFunc-inv ctransferm-2-1) ctarget-2))
725 ;; Any cx-2 can do, so there are 2^{transferm-kernel-size} solutions.
727 ;; Within solution-list each element is a cons cell:
731 ;; where HW is the Hamming weight of solution, and SOL is
732 ;; the solution in the form of a grid.
737 ;; Compute `solution' in the form of a 25x1 matrix of
738 ;; (mod B 2) forms --- with B = 0 or 1 --- and
739 ;; return (HW . SOL) where HW is the Hamming weight
740 ;; of solution and SOL a grid.
741 (let ((solution (math-mul
743 (calcFunc-vconcat cx-1 cx-2)))); X = P * CX
745 ;; The Hamming Weight is computed by matrix reduction
746 ;; with an ad-hoc operator.
748 ;; (cadadr '(vec (mod x 2))) => x
749 (lambda (r x) (+ (if (integerp r) r (cadadr r))
753 (calcFunc-arrange solution 5x5-grid-size));cdr
755 ;; A (2^K) x K matrix, where K is the dimension of kernel
756 ;; of transfer matrix --- i.e. K=2 in if the grid is 5x5
757 ;; --- for I from 0 to K-1, each row rI correspond to the
758 ;; binary representation of number I, that is to say row
759 ;; rI is a 1xK vector:
760 ;; [ n{I,0} n{I,1} ... n{I,K-1} ]
762 ;; I = sum for J=0..K-1 of 2^(n{I,J})
763 (let ((calc-number-radix 2)
764 (calc-leading-zeros t)
765 (calc-word-size transferm-kernel-size))
769 (mapcar (lambda (x) `(vec (mod ,(logand x 1) 2)))
770 (substring (math-format-number x)
771 (- transferm-kernel-size)))))
772 (calcFunc-index (math-pow 2 transferm-kernel-size) 0))) ))
773 ;; Sort solutions according to respective Hamming weight.
774 (lambda (x y) (< (car x) (car y)))
776 (message "5x5 Solution computation done.")
779 (defun 5x5-solve-suggest (&optional n)
780 "Suggest to the user where to click.
782 Argument N is ignored."
783 ;; For the time being n is ignored, the idea was to use some numeric
784 ;; argument to show a limited amount of positions.
787 (let ((solutions (5x5-solver 5x5-grid)))
788 (setq 5x5-solver-output
789 (cons 5x5-moves solutions)))
790 (5x5-draw-grid (list 5x5-grid))
791 (5x5-position-cursor))
793 ;; Keyboard response functions.
795 (defun 5x5-flip-current ()
796 "Make a move on the current cursor location."
798 (setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
801 (5x5-draw-grid (list 5x5-grid)))
802 (5x5-position-cursor)
803 (when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size))
805 (message "You win!")))
810 (unless (zerop 5x5-y-pos)
812 (5x5-position-cursor)))
817 (unless (= 5x5-y-pos (1- 5x5-grid-size))
819 (5x5-position-cursor)))
824 (unless (zerop 5x5-x-pos)
826 (5x5-position-cursor)))
831 (unless (= 5x5-x-pos (1- 5x5-grid-size))
833 (5x5-position-cursor)))
836 "Move to beginning of line."
839 (5x5-position-cursor))
842 "Move to end of line."
844 (setq 5x5-x-pos (1- 5x5-grid-size))
845 (5x5-position-cursor))
848 "Move to the first cell."
852 (5x5-position-cursor))
855 "Move to the last cell."
857 (setq 5x5-x-pos (1- 5x5-grid-size)
858 5x5-y-pos (1- 5x5-grid-size))
859 (5x5-position-cursor))
861 (defun 5x5-randomize ()
862 "Randomize the grid."
864 (when (5x5-y-or-n-p "Start a new game with a random grid? ")
865 (setq 5x5-x-pos (/ 5x5-grid-size 2)
866 5x5-y-pos (/ 5x5-grid-size 2)
868 5x5-grid (5x5-make-random-grid (symbol-function '5x5-make-move))
869 5x5-solver-output nil)
871 (5x5-draw-grid (list 5x5-grid)))
872 (5x5-position-cursor)))
877 "Boolean exclusive-or of X and Y."
878 (and (or x y) (not (and x y))))
880 (defun 5x5-y-or-n-p (prompt)
881 "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."