| blob | 4359f3f9aa1255ae340d70e6ce33f11031f7fcea |
1 ;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*-
3 ;; Copyright (C) 1999-2014 Free Software Foundation, Inc.
5 ;; Author: Dave Pearson <davep@davep.org>
6 ;; Maintainer: Dave Pearson <davep@davep.org>
7 ;; Created: 1998-10-03
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/>.
25 ;;; Commentary:
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.
30 ;;; TODO:
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.
34 ;;
35 ;; o Look into tarting up the display with color. gamegrid.el looks
36 ;; interesting, perhaps that is the way to go?
38 ;;; Thanks:
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
44 ;; cracker.
45 ;;
46 ;; Vincent Belaïche <vincentb1@users.sourceforge.net> & Jay P. Belanger
47 ;; <jay.p.belanger@gmail.com> for the math solver.
49 ;;; Code:
51 ;; Things we need.
55 ;; Customize options.
58 "5x5 - Silly little puzzle game."
63 "Size of the playing area."
68 "X scaling factor for drawing the grid."
73 "Y scaling factor for drawing the grid."
78 "Delay in seconds when animating a solution crack."
83 "Should 5x5 ask you when you want to do a destructive operation?"
88 "Hook run on starting 5x5."
92 ;; Non-customize variables.
95 "Define VAR to VALUE with documentation DOC and make it buffer local."
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)
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)
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)
143 (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
144 (define-key map "n" #'5x5-new-game)
145 (define-key map "s" #'5x5-solve-suggest)
146 (define-key map "<" #'5x5-solve-rotate-left)
147 (define-key map ">" #'5x5-solve-rotate-right)
148 (define-key map "q" #'5x5-quit-game)
149 map)
150 "Local keymap for the 5x5 game.")
152 (5x5-defvar-local 5x5-solver-output nil
153 "List that is the output of an arithmetic solver.
155 This list L is such that
157 L = (M S_1 S_2 ... S_N)
159 M is the move count when the solve output was stored.
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.
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
166 GRID is the grid of positions to click.")
169 ;; Menu definition.
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 "---"
177 ["Use Calc solver" 5x5-solve-suggest t]
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 "---"
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]))
186 ;; Gameplay functions.
188 (define-derived-mode 5x5-mode special-mode "5x5"
189 "A mode for playing `5x5'."
190 (setq buffer-read-only t
191 truncate-lines t)
192 (buffer-disable-undo))
194 ;;;###autoload
195 (defun 5x5 (&optional size)
196 "Play 5x5.
198 The object of 5x5 is very simple, by moving around the grid and flipping
199 squares you must fill the grid.
201 5x5 keyboard bindings are:
219 (interactive "P")
220 (setq 5x5-cracking nil)
221 (switch-to-buffer 5x5-buffer-name)
222 (5x5-mode)
223 (when (natnump size)
224 (setq 5x5-grid-size size))
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))
228 (5x5-position-cursor))
230 (defun 5x5-new-game ()
231 "Start a new game of `5x5'."
232 (interactive)
233 (when (if (called-interactively-p 'interactive)
234 (5x5-y-or-n-p "Start a new game? ") t)
235 (setq 5x5-x-pos (/ 5x5-grid-size 2)
236 5x5-y-pos (/ 5x5-grid-size 2)
237 5x5-moves 0
238 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)
239 5x5-solver-output nil)
240 (5x5-draw-grid (list 5x5-grid))
241 (5x5-position-cursor)))
243 (defun 5x5-quit-game ()
244 "Quit the current game of `5x5'."
245 (interactive)
246 (kill-buffer 5x5-buffer-name))
248 (defun 5x5-make-new-grid ()
249 "Create and return a new `5x5' grid structure."
250 (let ((grid (make-vector 5x5-grid-size nil)))
251 (dotimes (y 5x5-grid-size)
252 (aset grid y (make-vector 5x5-grid-size nil)))
253 grid))
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))
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))
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))))
267 (defun 5x5-copy-grid (grid)
268 "Make a new copy of GRID."
269 (let ((copy (5x5-make-new-grid)))
270 (dotimes (y 5x5-grid-size)
271 (dotimes (x 5x5-grid-size)
272 (5x5-set-cell copy y x (5x5-cell grid y x))))
273 copy))
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)
288 (defun 5x5-row-value (row)
290 (cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
292 (defun 5x5-grid-value (grid)
294 (cl-loop for y from 0 to (1- 5x5-grid-size)
295 sum (5x5-row-value (aref grid y))))
297 (defun 5x5-draw-grid-end ()
298 "Draw the top/bottom of the grid."
299 (insert "+")
300 (dotimes (x 5x5-grid-size)
301 (insert "-" (make-string 5x5-x-scale ?-)))
302 (insert "-+ "))
304 (defun 5x5-draw-grid (grids)
305 "Draw the grids GRIDS into the current buffer."
306 (let ((inhibit-read-only t) grid-org)
307 (erase-buffer)
308 (dolist (grid grids) (5x5-draw-grid-end))
310 (setq grid-org (point))
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 " | "))
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)))
325 (let ((solution-grid (cl-cdadr 5x5-solver-output)))
326 (dotimes (y 5x5-grid-size)
327 (save-excursion
328 (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
329 (dotimes (x 5x5-grid-size)
330 (when (5x5-cell solution-grid y x)
331 (if (= 0 (mod 5x5-x-scale 2))
332 (progn
333 (insert "()")
334 (delete-region (point) (+ (point) 2))
335 (backward-char 2))
336 (insert-char ?O 1)
337 (delete-char 1)
338 (backward-char)))
339 (forward-char (1+ 5x5-x-scale))))
340 (forward-line 5x5-y-scale))))
341 (setq 5x5-solver-output nil)))
342 (dolist (grid grids) (5x5-draw-grid-end))
344 (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
346 (defun 5x5-position-cursor ()
347 "Position the cursor on the grid."
348 (goto-char (point-min))
349 (forward-line (1+ (* 5x5-y-pos 5x5-y-scale)))
350 (goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1)))
352 (defun 5x5-made-move ()
353 "Keep track of how many moves have been made."
354 (cl-incf 5x5-moves))
356 (defun 5x5-make-random-grid (&optional move)
357 "Make a random grid."
358 (setq move (or move (symbol-function '5x5-flip-cell)))
359 (let ((grid (5x5-make-new-grid)))
360 (dotimes (y 5x5-grid-size)
361 (dotimes (x 5x5-grid-size)
362 (if (zerop (random 2))
363 (funcall move grid y x))))
364 grid))
366 ;; Cracker functions.
368 ;;;###autoload
369 (defun 5x5-crack-randomly ()
370 "Attempt to crack 5x5 using random solutions."
371 (interactive)
372 (5x5-crack #'5x5-make-random-solution))
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))
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))
386 ;;;###autoload
387 (defun 5x5-crack-xor-mutate ()
388 "Attempt to crack 5x5 by xoring the current and best solution.
389 Mutate the result."
390 (interactive)
391 (5x5-crack #'5x5-make-xor-with-mutation))
393 ;;;###autoload
394 (defun 5x5-crack (breeder)
395 "Attempt to find a solution for 5x5.
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
399 solution and the second will be the best solution so far. The function
400 should return a grid vector array that is the new solution."
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))
421 (defun 5x5-make-random-solution (&rest _ignore)
422 "Make a random solution."
423 (5x5-make-random-grid))
425 (defun 5x5-make-mutate-current (current _best)
426 "Mutate the current solution."
427 (5x5-mutate-solution current))
429 (defun 5x5-make-mutate-best (_current best)
430 "Mutate the best solution."
431 (5x5-mutate-solution best))
433 (defun 5x5-make-xor-with-mutation (current best)
434 "Xor current and best solution then mutate the result."
435 (let ((xored (5x5-make-new-grid)))
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)))))
441 (5x5-mutate-solution xored)))
443 (defun 5x5-mutate-solution (solution)
444 "Randomly flip bits in the solution."
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))))
450 solution)
452 (defun 5x5-play-solution (solution best)
453 "Play a solution on an empty grid. This destroys the current game
454 in progress because it is an animated attempt."
455 (5x5-new-game)
456 (let ((inhibit-quit t))
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))))
466 5x5-grid)
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)))
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))))
496 (eval-and-compile
497 (if nil; set to t to enable solver logging
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.
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*"))))
508 (defun 5x5-log (name value)
509 "Debug purposes only.
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
524 value))
525 (defsubst 5x5-log-init ())
526 (defsubst 5x5-log (name value) value)))
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))
545 (defun 5x5-solver (grid)
546 "Return a list of solutions for GRID.
548 Given some grid GRID, the returned a list of solution LIST is
549 sorted from least Hamming weight to greatest one.
551 LIST = (SOLUTION-1 ... SOLUTION-N)
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
555 achieve it --- and G is the grid of positions to click in order
556 to complete the 5x5.
558 Solutions are sorted from least to greatest Hamming weight."
559 (require 'calc-ext)
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)))
568 (let* (calc-command-flags
569 (grid-size-squared (* 5x5-grid-size 5x5-grid-size))
571 ;; targetv is the vector the origin of which is org="current
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))
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))))
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")))
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 ;;
641 ;; base-change must be by construction invertible.
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)
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)))))
652 (calcFunc-trn id))))
654 (inv-base-change
655 (5x5-log "invp"
656 (calcFunc-inv base-change)))
658 ;; B:= targetv
659 ;; A:= transferm
660 ;; P:= base-change
661 ;; P^-1 := inv-base-change
662 ;; X := solution
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))
693 ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
694 ;; and ctransferm-2-2 = 0.
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)))
703 ;; By construction ctransferm-2-2 = 0.
704 ;;
705 ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
707 (ctarget-1 (calcFunc-mrow ctarget row-1))
708 (ctarget-2 (calcFunc-mrow ctarget row-2))
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))
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
750 ;; (cl-cadadr '(vec (mod x 2))) => x
751 (lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
752 (cl-cadadr x)))
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)))
781 (defun 5x5-solve-suggest (&optional n)
782 "Suggest to the user where to click.
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))
795 (defun 5x5-solve-rotate-left (&optional n)
796 "Rotate left by N the list of solutions in 5x5-solver-output.
798 If N is not supplied rotate by 1, that is to say put the last
799 element first in the list.
801 The 5x5 game has in general several solutions. For grid size=5,
802 there are 4 possible solutions. When function
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
808 the solution with second least number of strokes, while rotating
809 right will show the solution with greatest number of strokes."
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)))))
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))
852 ;; Keyboard response functions.
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!")))
866 (defun 5x5-up ()
867 "Move up."
868 (interactive)
869 (unless (zerop 5x5-y-pos)
870 (cl-decf 5x5-y-pos)
871 (5x5-position-cursor)))
873 (defun 5x5-down ()
874 "Move down."
875 (interactive)
876 (unless (= 5x5-y-pos (1- 5x5-grid-size))
877 (cl-incf 5x5-y-pos)
878 (5x5-position-cursor)))
880 (defun 5x5-left ()
881 "Move left."
882 (interactive)
883 (unless (zerop 5x5-x-pos)
884 (cl-decf 5x5-x-pos)
885 (5x5-position-cursor)))
887 (defun 5x5-right ()
888 "Move right."
889 (interactive)
890 (unless (= 5x5-x-pos (1- 5x5-grid-size))
891 (cl-incf 5x5-x-pos)
892 (5x5-position-cursor)))
894 (defun 5x5-bol ()
895 "Move to beginning of line."
896 (interactive)
897 (setq 5x5-x-pos 0)
898 (5x5-position-cursor))
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))
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))
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))
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
927 5x5-grid (5x5-make-random-grid (symbol-function '5x5-make-move))
928 5x5-solver-output nil)
929 (unless 5x5-cracking
930 (5x5-draw-grid (list 5x5-grid)))
931 (5x5-position-cursor)))
933 ;; Support functions
935 (defun 5x5-xor (x y)
936 "Boolean exclusive-or of X and Y."
937 (and (or x y) (not (and x y))))
939 (defun 5x5-y-or-n-p (prompt)
940 "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."
941 (if 5x5-hassle-me
942 (y-or-n-p prompt)
943 t))
945 (provide '5x5)
947 ;;; 5x5.el ends here