mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-05 08:53:45 +00:00
945 lines
30 KiB
EmacsLisp
945 lines
30 KiB
EmacsLisp
;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
|
|
|
|
;; Author: Dave Pearson <davep@davep.org>
|
|
;; Created: 1998-10-03
|
|
;; Keywords: games puzzles
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; The aim of 5x5 is to fill in all the squares. If you need any more of an
|
|
;; explanation you probably shouldn't play the game.
|
|
|
|
;;; TODO:
|
|
|
|
;; o The code for updating the grid needs to be re-done. At the moment it
|
|
;; simply re-draws the grid every time a move is made.
|
|
;;
|
|
;; o Look into improving the display with color. gamegrid.el looks
|
|
;; interesting, perhaps that is the way to go?
|
|
|
|
;;; Thanks:
|
|
|
|
;; Ralf Fassel <ralf@akutech.de> for his help and introduction to writing an
|
|
;; emacs mode.
|
|
;;
|
|
;; Pascal Q. Porcupine <joshagam@cs.nmsu.edu> for inspiring the animated
|
|
;; cracker.
|
|
;;
|
|
;; Vincent Belaïche <vincentb1@users.sourceforge.net> & Jay P. Belanger
|
|
;; <jay.p.belanger@gmail.com> for the math solver.
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
;; Customize options.
|
|
|
|
(defgroup 5x5 nil
|
|
"5x5 - Silly little puzzle game."
|
|
:group 'games
|
|
:prefix "5x5-")
|
|
|
|
(defcustom 5x5-grid-size 5
|
|
"Size of the playing area."
|
|
:type 'integer)
|
|
|
|
(defcustom 5x5-x-scale 4
|
|
"X scaling factor for drawing the grid."
|
|
:type 'integer)
|
|
|
|
(defcustom 5x5-y-scale 3
|
|
"Y scaling factor for drawing the grid."
|
|
:type 'integer)
|
|
|
|
(defcustom 5x5-animate-delay .01
|
|
"Delay in seconds when animating a solution crack."
|
|
:type 'number)
|
|
|
|
(defcustom 5x5-hassle-me t
|
|
"Should 5x5 ask you when you want to do a destructive operation?"
|
|
:type 'boolean)
|
|
|
|
(defcustom 5x5-mode-hook nil
|
|
"Hook run on starting 5x5."
|
|
:type 'hook)
|
|
|
|
;; Non-customize variables.
|
|
|
|
(defmacro 5x5-defvar-local (var value doc)
|
|
"Define VAR to VALUE with documentation DOC and make it buffer local."
|
|
(declare (obsolete defvar-local "28.1"))
|
|
`(progn
|
|
(defvar ,var ,value ,doc)
|
|
(make-variable-buffer-local (quote ,var))))
|
|
|
|
(defvar-local 5x5-grid nil
|
|
"5x5 grid contents.")
|
|
|
|
(defvar-local 5x5-x-pos 2
|
|
"X position of cursor.")
|
|
|
|
(defvar-local 5x5-y-pos 2
|
|
"Y position of cursor.")
|
|
|
|
(defvar-local 5x5-moves 0
|
|
"Moves made.")
|
|
|
|
(defvar-local 5x5-cracking nil
|
|
"Are we in cracking mode?")
|
|
|
|
(defvar 5x5-buffer-name "*5x5*"
|
|
"Name of the 5x5 play buffer.")
|
|
|
|
(defvar 5x5-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(suppress-keymap map t)
|
|
(define-key map "?" #'describe-mode)
|
|
(define-key map "\r" #'5x5-flip-current)
|
|
(define-key map " " #'5x5-flip-current)
|
|
(define-key map [up] #'5x5-up)
|
|
(define-key map [down] #'5x5-down)
|
|
(define-key map [left] #'5x5-left)
|
|
(define-key map [tab] #'5x5-right)
|
|
(define-key map [right] #'5x5-right)
|
|
(define-key map [(control a)] #'5x5-bol)
|
|
(define-key map [(control e)] #'5x5-eol)
|
|
(define-key map [(control p)] #'5x5-up)
|
|
(define-key map [(control n)] #'5x5-down)
|
|
(define-key map [(control b)] #'5x5-left)
|
|
(define-key map [(control f)] #'5x5-right)
|
|
(define-key map [home] #'5x5-bol)
|
|
(define-key map [end] #'5x5-eol)
|
|
(define-key map [prior] #'5x5-first)
|
|
(define-key map [next] #'5x5-last)
|
|
(define-key map "r" #'5x5-randomize)
|
|
(define-key map [(control c) (control r)] #'5x5-crack-randomly)
|
|
(define-key map [(control c) (control c)] #'5x5-crack-mutating-current)
|
|
(define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
|
|
(define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
|
|
(define-key map "n" #'5x5-new-game)
|
|
(define-key map "s" #'5x5-solve-suggest)
|
|
(define-key map "<" #'5x5-solve-rotate-left)
|
|
(define-key map ">" #'5x5-solve-rotate-right)
|
|
(define-key map "q" #'5x5-quit-game)
|
|
map)
|
|
"Local keymap for the 5x5 game.")
|
|
|
|
(defvar-local 5x5-solver-output nil
|
|
"List that is the output of an arithmetic solver.
|
|
|
|
This list L is such that
|
|
|
|
L = (M S_1 S_2 ... S_N)
|
|
|
|
M is the move count when the solve output was stored.
|
|
|
|
S_1 ... S_N are all the solutions ordered from least to greatest
|
|
number of strokes. S_1 is the solution to be displayed.
|
|
|
|
Each solution S_1, ..., S_N is a list (STROKE-COUNT GRID) where
|
|
STROKE-COUNT is the number of strokes to achieve the solution and
|
|
GRID is the grid of positions to click.")
|
|
|
|
|
|
;; Menu definition.
|
|
|
|
(easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
|
|
'("5x5"
|
|
["New game" 5x5-new-game t]
|
|
["Random game" 5x5-randomize t]
|
|
["Quit game" 5x5-quit-game t]
|
|
"---"
|
|
["Use Calc solver" 5x5-solve-suggest t]
|
|
["Rotate left list of Calc solutions" 5x5-solve-rotate-left t]
|
|
["Rotate right list of Calc solutions" 5x5-solve-rotate-right t]
|
|
"---"
|
|
["Crack randomly" 5x5-crack-randomly t]
|
|
["Crack mutating current" 5x5-crack-mutating-current t]
|
|
["Crack mutating best" 5x5-crack-mutating-best t]
|
|
["Crack with xor mutate" 5x5-crack-xor-mutate t]))
|
|
|
|
;; Gameplay functions.
|
|
|
|
(define-derived-mode 5x5-mode special-mode "5x5"
|
|
"A mode for playing `5x5'."
|
|
:interactive nil
|
|
(setq buffer-read-only t
|
|
truncate-lines t)
|
|
(buffer-disable-undo))
|
|
|
|
;;;###autoload
|
|
(defun 5x5 (&optional size)
|
|
"Play 5x5.
|
|
|
|
The object of 5x5 is very simple, by moving around the grid and flipping
|
|
squares you must fill the grid.
|
|
|
|
5x5 keyboard bindings are:
|
|
\\<5x5-mode-map>
|
|
Flip \\[5x5-flip-current]
|
|
Move up \\[5x5-up]
|
|
Move down \\[5x5-down]
|
|
Move left \\[5x5-left]
|
|
Move right \\[5x5-right]
|
|
Start new game \\[5x5-new-game]
|
|
New game with random grid \\[5x5-randomize]
|
|
Random cracker \\[5x5-crack-randomly]
|
|
Mutate current cracker \\[5x5-crack-mutating-current]
|
|
Mutate best cracker \\[5x5-crack-mutating-best]
|
|
Mutate xor cracker \\[5x5-crack-xor-mutate]
|
|
Solve with Calc \\[5x5-solve-suggest]
|
|
Rotate left Calc Solutions \\[5x5-solve-rotate-left]
|
|
Rotate right Calc Solutions \\[5x5-solve-rotate-right]
|
|
Quit current game \\[5x5-quit-game]"
|
|
|
|
(interactive "P")
|
|
(setq 5x5-cracking nil)
|
|
(switch-to-buffer 5x5-buffer-name)
|
|
(5x5-mode)
|
|
(when (natnump size)
|
|
(setq 5x5-grid-size size))
|
|
(if (or (not 5x5-grid) (not (= 5x5-grid-size (length (aref 5x5-grid 0)))))
|
|
(5x5-new-game))
|
|
(5x5-draw-grid (list 5x5-grid))
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-new-game ()
|
|
"Start a new game of `5x5'."
|
|
(interactive nil 5x5-mode)
|
|
(when (if (called-interactively-p 'interactive)
|
|
(5x5-y-or-n-p "Start a new game? ") t)
|
|
(setq 5x5-x-pos (/ 5x5-grid-size 2)
|
|
5x5-y-pos (/ 5x5-grid-size 2)
|
|
5x5-moves 0
|
|
5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)
|
|
5x5-solver-output nil)
|
|
(5x5-draw-grid (list 5x5-grid))
|
|
(5x5-position-cursor)))
|
|
|
|
(defun 5x5-quit-game ()
|
|
"Quit the current game of `5x5'."
|
|
(interactive nil 5x5-mode)
|
|
(kill-buffer 5x5-buffer-name))
|
|
|
|
(defun 5x5-make-new-grid ()
|
|
"Create and return a new `5x5' grid structure."
|
|
(let ((grid (make-vector 5x5-grid-size nil)))
|
|
(dotimes (y 5x5-grid-size)
|
|
(aset grid y (make-vector 5x5-grid-size nil)))
|
|
grid))
|
|
|
|
(defun 5x5-cell (grid y x)
|
|
"Return the value of the cell in GRID at location X,Y."
|
|
(aref (aref grid y) x))
|
|
|
|
(defun 5x5-set-cell (grid y x value)
|
|
"Set the value of cell X,Y in GRID to VALUE."
|
|
(aset (aref grid y) x value))
|
|
|
|
(defun 5x5-flip-cell (grid y x)
|
|
"Flip the value of cell X,Y in GRID."
|
|
(5x5-set-cell grid y x (not (5x5-cell grid y x))))
|
|
|
|
(defun 5x5-copy-grid (grid)
|
|
"Make a new copy of GRID."
|
|
(let ((copy (5x5-make-new-grid)))
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (x 5x5-grid-size)
|
|
(5x5-set-cell copy y x (5x5-cell grid y x))))
|
|
copy))
|
|
|
|
(defun 5x5-make-move (grid row col)
|
|
"Make a move on GRID at row ROW and column COL."
|
|
(5x5-flip-cell grid row col)
|
|
(if (> row 0)
|
|
(5x5-flip-cell grid (1- row) col))
|
|
(if (< row (- 5x5-grid-size 1))
|
|
(5x5-flip-cell grid (1+ row) col))
|
|
(if (> col 0)
|
|
(5x5-flip-cell grid row (1- col)))
|
|
(if (< col (- 5x5-grid-size 1))
|
|
(5x5-flip-cell grid row (1+ col)))
|
|
grid)
|
|
|
|
(defun 5x5-row-value (row)
|
|
"Get the \"on-value\" for grid row ROW."
|
|
(cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
|
|
|
|
(defun 5x5-grid-value (grid)
|
|
"Get the \"on-value\" for grid GRID."
|
|
(cl-loop for y from 0 to (1- 5x5-grid-size)
|
|
sum (5x5-row-value (aref grid y))))
|
|
|
|
(defun 5x5-draw-grid-end ()
|
|
"Draw the top/bottom of the grid."
|
|
(insert "+")
|
|
(dotimes (_ 5x5-grid-size)
|
|
(insert "-" (make-string 5x5-x-scale ?-)))
|
|
(insert "-+ "))
|
|
|
|
(defun 5x5-draw-grid (grids)
|
|
"Draw the grids GRIDS into the current buffer."
|
|
(let ((inhibit-read-only t) grid-org)
|
|
(erase-buffer)
|
|
(dolist (_ grids) (5x5-draw-grid-end))
|
|
(insert "\n")
|
|
(setq grid-org (point))
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (_lines 5x5-y-scale)
|
|
(dolist (grid grids)
|
|
(dotimes (x 5x5-grid-size)
|
|
(insert (if (zerop x) "| " " ")
|
|
(make-string 5x5-x-scale
|
|
(if (5x5-cell grid y x) ?# ?.))))
|
|
(insert " | "))
|
|
(insert "\n")))
|
|
(when 5x5-solver-output
|
|
(if (= (car 5x5-solver-output) 5x5-moves)
|
|
(save-excursion
|
|
(goto-char grid-org)
|
|
(beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
|
|
(let ((solution-grid (cl-cdadr 5x5-solver-output)))
|
|
(dotimes (y 5x5-grid-size)
|
|
(save-excursion
|
|
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
|
|
(dotimes (x 5x5-grid-size)
|
|
(when (5x5-cell solution-grid y x)
|
|
(if (= 0 (mod 5x5-x-scale 2))
|
|
(progn
|
|
(insert "()")
|
|
(delete-region (point) (+ (point) 2))
|
|
(backward-char 2))
|
|
(insert-char ?O 1)
|
|
(delete-char 1)
|
|
(backward-char)))
|
|
(forward-char (1+ 5x5-x-scale))))
|
|
(forward-line 5x5-y-scale))))
|
|
(setq 5x5-solver-output nil)))
|
|
(dolist (_grid grids) (5x5-draw-grid-end))
|
|
(insert "\n")
|
|
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
|
|
|
|
(defun 5x5-position-cursor ()
|
|
"Position the cursor on the grid."
|
|
(goto-char (point-min))
|
|
(forward-line (1+ (* 5x5-y-pos 5x5-y-scale)))
|
|
(goto-char (+ (point) (* 5x5-x-pos 5x5-x-scale) (+ 5x5-x-pos 1) 1)))
|
|
|
|
(defun 5x5-made-move ()
|
|
"Keep track of how many moves have been made."
|
|
(cl-incf 5x5-moves))
|
|
|
|
(defun 5x5-make-random-grid (&optional move)
|
|
"Make a random grid."
|
|
(setq move (or move (symbol-function '5x5-flip-cell)))
|
|
(let ((grid (5x5-make-new-grid)))
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (x 5x5-grid-size)
|
|
(if (zerop (random 2))
|
|
(funcall move grid y x))))
|
|
grid))
|
|
|
|
;; Cracker functions.
|
|
|
|
;;;###autoload
|
|
(defun 5x5-crack-randomly ()
|
|
"Attempt to crack 5x5 using random solutions."
|
|
(interactive)
|
|
(5x5-crack #'5x5-make-random-solution))
|
|
|
|
;;;###autoload
|
|
(defun 5x5-crack-mutating-current ()
|
|
"Attempt to crack 5x5 by mutating the current solution."
|
|
(interactive)
|
|
(5x5-crack #'5x5-make-mutate-current))
|
|
|
|
;;;###autoload
|
|
(defun 5x5-crack-mutating-best ()
|
|
"Attempt to crack 5x5 by mutating the best solution."
|
|
(interactive)
|
|
(5x5-crack #'5x5-make-mutate-best))
|
|
|
|
;;;###autoload
|
|
(defun 5x5-crack-xor-mutate ()
|
|
"Attempt to crack 5x5 by xoring the current and best solution.
|
|
Mutate the result."
|
|
(interactive)
|
|
(5x5-crack #'5x5-make-xor-with-mutation))
|
|
|
|
;;;###autoload
|
|
(defun 5x5-crack (breeder)
|
|
"Attempt to find a solution for 5x5.
|
|
|
|
5x5-crack takes the argument BREEDER which should be a function that takes
|
|
two parameters, the first will be a grid vector array that is the current
|
|
solution and the second will be the best solution so far. The function
|
|
should return a grid vector array that is the new solution."
|
|
|
|
(interactive "aBreeder function: ")
|
|
(5x5)
|
|
(setq 5x5-cracking t)
|
|
(let* ((best-solution (5x5-make-random-grid))
|
|
(current-solution best-solution)
|
|
(best-result (5x5-make-new-grid))
|
|
(current-result (5x5-make-new-grid))
|
|
(target (* 5x5-grid-size 5x5-grid-size)))
|
|
(while (and (< (5x5-grid-value best-result) target)
|
|
(not (input-pending-p)))
|
|
(setq current-result (5x5-play-solution current-solution best-solution))
|
|
(if (> (5x5-grid-value current-result) (5x5-grid-value best-result))
|
|
(setq best-solution current-solution
|
|
best-result current-result))
|
|
(setq current-solution (funcall breeder
|
|
(5x5-copy-grid current-solution)
|
|
(5x5-copy-grid best-solution)))))
|
|
(setq 5x5-cracking nil))
|
|
|
|
(defun 5x5-make-random-solution (&rest _ignore)
|
|
"Make a random solution."
|
|
(5x5-make-random-grid))
|
|
|
|
(defun 5x5-make-mutate-current (current _best)
|
|
"Mutate the current solution."
|
|
(5x5-mutate-solution current))
|
|
|
|
(defun 5x5-make-mutate-best (_current best)
|
|
"Mutate the best solution."
|
|
(5x5-mutate-solution best))
|
|
|
|
(defun 5x5-make-xor-with-mutation (current best)
|
|
"Xor current and best solution then mutate the result."
|
|
(let ((xored (5x5-make-new-grid)))
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (x 5x5-grid-size)
|
|
(5x5-set-cell xored y x
|
|
(xor (5x5-cell current y x)
|
|
(5x5-cell best y x)))))
|
|
(5x5-mutate-solution xored)))
|
|
|
|
(defun 5x5-mutate-solution (solution)
|
|
"Randomly flip bits in the solution."
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (x 5x5-grid-size)
|
|
(if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
|
|
(/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
|
|
(5x5-flip-cell solution y x))))
|
|
solution)
|
|
|
|
(defun 5x5-play-solution (solution best)
|
|
"Play a solution on an empty grid. This destroys the current game
|
|
in progress because it is an animated attempt."
|
|
(5x5-new-game)
|
|
(let ((inhibit-quit t))
|
|
(dotimes (y 5x5-grid-size)
|
|
(dotimes (x 5x5-grid-size)
|
|
(setq 5x5-y-pos y
|
|
5x5-x-pos x)
|
|
(if (5x5-cell solution y x)
|
|
(5x5-flip-current))
|
|
(5x5-draw-grid (list 5x5-grid solution best))
|
|
(5x5-position-cursor)
|
|
(sit-for 5x5-animate-delay))))
|
|
5x5-grid)
|
|
|
|
;; Arithmetic solver
|
|
;;===========================================================================
|
|
(defun 5x5-grid-to-vec (grid)
|
|
"Convert GRID to an equivalent Calc matrix of (mod X 2) forms
|
|
where X is 1 for setting a position, and 0 for unsetting a
|
|
position."
|
|
(cons 'vec
|
|
(mapcar (lambda (y)
|
|
(cons 'vec
|
|
(mapcar (lambda (x)
|
|
(if x '(mod 1 2) '(mod 0 2)))
|
|
y)))
|
|
grid)))
|
|
|
|
(defun 5x5-vec-to-grid (grid-matrix)
|
|
"Convert a grid matrix GRID-MATRIX in Calc format to a grid in
|
|
5x5 format. See function `5x5-grid-to-vec'."
|
|
(apply
|
|
#'vector
|
|
(mapcar
|
|
(lambda (x)
|
|
(apply
|
|
#'vector
|
|
(mapcar
|
|
(lambda (y) (/= (cadr y) 0))
|
|
(cdr x))))
|
|
(cdr grid-matrix))))
|
|
|
|
(eval-and-compile
|
|
(if nil; set to t to enable solver logging
|
|
;; Note these logging facilities were not cleaned out as the arithmetic
|
|
;; solver is not yet complete --- it works only for grid size = 5.
|
|
;; So they may be useful again to design a more generic solution.
|
|
(progn
|
|
(defvar 5x5-log-buffer nil)
|
|
(defun 5x5-log-init ()
|
|
(if (buffer-live-p 5x5-log-buffer)
|
|
(with-current-buffer 5x5-log-buffer (erase-buffer))
|
|
(setq 5x5-log-buffer (get-buffer-create "*5x5 LOG*"))))
|
|
|
|
(defun 5x5-log (name value)
|
|
"Debug purposes only.
|
|
|
|
Log a matrix VALUE of (mod B 2) forms, only B is output and
|
|
Scilab matrix notation is used. VALUE is returned so that it is
|
|
easy to log a value with minimal rewrite of code."
|
|
(when (buffer-live-p 5x5-log-buffer)
|
|
(defvar calc-matrix-brackets)
|
|
(defvar calc-vector-commas)
|
|
(let* ((unpacked-value
|
|
(math-map-vec
|
|
(lambda (row) (math-map-vec 'cadr row))
|
|
value))
|
|
(calc-vector-commas "")
|
|
(calc-matrix-brackets '(C O))
|
|
(value-to-log (math-format-value unpacked-value)))
|
|
(with-current-buffer 5x5-log-buffer
|
|
(insert name ?= value-to-log ?\n))))
|
|
value))
|
|
(defsubst 5x5-log-init ())
|
|
(defsubst 5x5-log (_name value) value)))
|
|
|
|
(declare-function math-map-vec "calc-vec" (f a))
|
|
(declare-function math-sub "calc" (a b))
|
|
(declare-function math-mul "calc" (a b))
|
|
(declare-function math-make-intv "calc-forms" (mask lo hi))
|
|
(declare-function math-reduce-vec "calc-vec" (a b))
|
|
(declare-function math-format-number "calc" (a &optional prec))
|
|
(declare-function math-pow "calc-misc" (a b))
|
|
(declare-function calcFunc-arrange "calc-vec" (vec cols))
|
|
(declare-function calcFunc-cvec "calc-vec" (obj &rest dims))
|
|
(declare-function calcFunc-diag "calc-vec" (a &optional n))
|
|
(declare-function calcFunc-trn "calc-vec" (mat))
|
|
(declare-function calcFunc-inv "calc-misc" (m))
|
|
(declare-function calcFunc-mrow "calc-vec" (mat n))
|
|
(declare-function calcFunc-mcol "calc-vec" (mat n))
|
|
(declare-function calcFunc-vconcat "calc-vec" (a b))
|
|
(declare-function calcFunc-index "calc-vec" (n &optional start incr))
|
|
(defvar calc-word-size)
|
|
(defvar calc-leading-zeros)
|
|
(defvar calc-number-radix)
|
|
(defvar calc-command-flags)
|
|
|
|
(defun 5x5-solver (grid)
|
|
"Return a list of solutions for GRID.
|
|
|
|
Given some grid GRID, the returned a list of solution LIST is
|
|
sorted from least Hamming weight to greatest one.
|
|
|
|
LIST = (SOLUTION-1 ... SOLUTION-N)
|
|
|
|
Each solution SOLUTION-I is a cons cell (HW . G) where HW is the
|
|
Hamming weight of the solution --- ie the number of strokes to
|
|
achieve it --- and G is the grid of positions to click in order
|
|
to complete the 5x5.
|
|
|
|
Solutions are sorted from least to greatest Hamming weight."
|
|
(require 'calc-ext)
|
|
(cl-flet ((5x5-mat-mode-2
|
|
(a)
|
|
(math-map-vec
|
|
(lambda (y)
|
|
(math-map-vec
|
|
(lambda (x) `(mod ,x 2))
|
|
y))
|
|
a)))
|
|
(let* (calc-command-flags
|
|
(grid-size-squared (* 5x5-grid-size 5x5-grid-size))
|
|
|
|
;; targetv is the vector the origin of which is org="current
|
|
;; grid" and the end of which is dest="all ones".
|
|
(targetv
|
|
(5x5-log
|
|
"b"
|
|
(let (
|
|
;; org point is the current grid
|
|
(org (calcFunc-arrange (5x5-grid-to-vec grid)
|
|
1))
|
|
|
|
;; end point of game is the all ones matrix
|
|
(dest (calcFunc-cvec '(mod 1 2) grid-size-squared 1)))
|
|
(math-sub dest org))))
|
|
|
|
;; transferm is the transfer matrix, ie it is the 25x25
|
|
;; matrix applied every time a flip is carried out where a
|
|
;; flip is defined by a 25x1 Dirac vector --- ie all zeros
|
|
;; but 1 in the position that is flipped.
|
|
(transferm
|
|
(5x5-log
|
|
"a"
|
|
;; transfer-grid is not a play grid, but this is the
|
|
;; transfer matrix in the format of a vector of vectors, we
|
|
;; do it this way because random access in vectors is
|
|
;; faster. The motivation is just speed as we build it
|
|
;; element by element, but that could have been created
|
|
;; using only Calc primitives. Probably that would be a
|
|
;; better idea to use Calc with some vector manipulation
|
|
;; rather than going this way...
|
|
(5x5-grid-to-vec (let ((transfer-grid
|
|
(let ((5x5-grid-size grid-size-squared))
|
|
(5x5-make-new-grid))))
|
|
(dotimes (i 5x5-grid-size)
|
|
(dotimes (j 5x5-grid-size)
|
|
;; k0 = flattened flip position corresponding
|
|
;; to (i, j) on the grid.
|
|
(let* ((k0 (+ (* 5 i) j)))
|
|
;; cross center
|
|
(5x5-set-cell transfer-grid k0 k0 t)
|
|
;; Cross top.
|
|
(and
|
|
(> i 0)
|
|
(5x5-set-cell transfer-grid
|
|
(- k0 5x5-grid-size) k0 t))
|
|
;; Cross bottom.
|
|
(and
|
|
(< (1+ i) 5x5-grid-size)
|
|
(5x5-set-cell transfer-grid
|
|
(+ k0 5x5-grid-size) k0 t))
|
|
;; Cross left.
|
|
(and
|
|
(> j 0)
|
|
(5x5-set-cell transfer-grid (1- k0) k0 t))
|
|
;; Cross right.
|
|
(and
|
|
(< (1+ j) 5x5-grid-size)
|
|
(5x5-set-cell transfer-grid
|
|
(1+ k0) k0 t)))))
|
|
transfer-grid))))
|
|
;; TODO: this is hard-coded for grid-size = 5, make it generic.
|
|
(transferm-kernel-size
|
|
(if (= 5x5-grid-size 5) 2
|
|
(error "Transfer matrix rank not known for grid-size != 5")))
|
|
|
|
;; TODO: this is hard-coded for grid-size = 5, make it generic.
|
|
;;
|
|
;; base-change is a 25x25 matrix, where topleft submatrix
|
|
;; 23x25 is a diagonal of 1, and the two last columns are a
|
|
;; base of kernel of transferm.
|
|
;;
|
|
;; base-change must be by construction invertible.
|
|
(base-change
|
|
(5x5-log
|
|
"p"
|
|
(let ((id (5x5-mat-mode-2 (calcFunc-diag 1 grid-size-squared))))
|
|
(setcdr (last id (1+ transferm-kernel-size))
|
|
(cdr (5x5-mat-mode-2
|
|
'(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
|
|
1 1 0 1 0 1 0 1 1 1 0)
|
|
(vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
|
|
1 0 0 0 0 0 1 1 0 1 1)))))
|
|
(calcFunc-trn id))))
|
|
|
|
(inv-base-change
|
|
(5x5-log "invp"
|
|
(calcFunc-inv base-change)))
|
|
|
|
;; B:= targetv
|
|
;; A:= transferm
|
|
;; P:= base-change
|
|
;; P^-1 := inv-base-change
|
|
;; X := solution
|
|
|
|
;; B = A * X
|
|
;; P^-1 * B = P^-1 * A * P * P^-1 * X
|
|
;; CX = P^-1 * X
|
|
;; CA = P^-1 * A * P
|
|
;; CB = P^-1 * B
|
|
;; CB = CA * CX
|
|
;; CX = CA^-1 * CB
|
|
;; X = P * CX
|
|
(ctransferm
|
|
(5x5-log
|
|
"ca"
|
|
(math-mul
|
|
inv-base-change
|
|
(math-mul transferm base-change)))); CA
|
|
(ctarget
|
|
(5x5-log
|
|
"cb"
|
|
(math-mul inv-base-change targetv))); CB
|
|
;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
|
|
(row-2 (math-make-intv 1 transferm-kernel-size
|
|
grid-size-squared)); 3..25
|
|
(col-1 (math-make-intv 3 1 (- grid-size-squared
|
|
transferm-kernel-size))); 1..23
|
|
;; (col-2 (math-make-intv 1 (- grid-size-squared
|
|
;; transferm-kernel-size)
|
|
;; grid-size-squared)) ; 24..25
|
|
;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
|
|
;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
|
|
|
|
;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
|
|
;; and ctransferm-2-2 = 0.
|
|
|
|
;;(ctransferm-1-2 (calcFunc-mcol ctransferm-1-: col-2))
|
|
(ctransferm-2-: (calcFunc-mrow ctransferm row-2))
|
|
(ctransferm-2-1
|
|
(5x5-log
|
|
"ca_2_1"
|
|
(calcFunc-mcol ctransferm-2-: col-1)))
|
|
|
|
;; By construction ctransferm-2-2 = 0.
|
|
;;
|
|
;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
|
|
|
|
;; (ctarget-1 (calcFunc-mrow ctarget row-1))
|
|
(ctarget-2 (calcFunc-mrow ctarget row-2))
|
|
|
|
;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
|
|
;; + ctransferm-1-2(2x2) *cx-2(2x1);
|
|
;; ctarget-2(23x1) = ctransferm-2-1(23x23)*cx-1(23x1)
|
|
;; + ctransferm-2-2(23x2)*cx-2(2x1);
|
|
;; By construction:
|
|
;;
|
|
;; ctransferm-1-2 == zeros(2,2) and ctransferm-2-2 == zeros(23,2)
|
|
;;
|
|
;; So:
|
|
;;
|
|
;; ctarget-2 = ctransferm-2-1*cx-1
|
|
;;
|
|
;; So:
|
|
;;
|
|
;; cx-1 = inv-ctransferm-2-1 * ctarget-2
|
|
(cx-1 (math-mul (calcFunc-inv ctransferm-2-1) ctarget-2))
|
|
|
|
;; Any cx-2 can do, so there are 2^{transferm-kernel-size} solutions.
|
|
(solution-list
|
|
;; Within solution-list each element is a cons cell:
|
|
;;
|
|
;; (HW . SOL)
|
|
;;
|
|
;; where HW is the Hamming weight of solution, and SOL is
|
|
;; the solution in the form of a grid.
|
|
(sort
|
|
(cdr
|
|
(math-map-vec
|
|
(lambda (cx-2)
|
|
;; Compute `solution' in the form of a 25x1 matrix of
|
|
;; (mod B 2) forms --- with B = 0 or 1 --- and
|
|
;; return (HW . SOL) where HW is the Hamming weight
|
|
;; of solution and SOL a grid.
|
|
(let ((solution (math-mul
|
|
base-change
|
|
(calcFunc-vconcat cx-1 cx-2)))); X = P * CX
|
|
(cons
|
|
;; The Hamming Weight is computed by matrix reduction
|
|
;; with an ad-hoc operator.
|
|
(math-reduce-vec
|
|
;; (cl-cadadr '(vec (mod x 2))) => x
|
|
(lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
|
|
(cl-cadadr x)))
|
|
solution); car
|
|
(5x5-vec-to-grid
|
|
(calcFunc-arrange solution 5x5-grid-size));cdr
|
|
)))
|
|
;; A (2^K) x K matrix, where K is the dimension of kernel
|
|
;; of transfer matrix --- i.e. K=2 in if the grid is 5x5
|
|
;; --- for I from 0 to K-1, each row rI correspond to the
|
|
;; binary representation of number I, that is to say row
|
|
;; rI is a 1xK vector:
|
|
;; [ n{I,0} n{I,1} ... n{I,K-1} ]
|
|
;; such that:
|
|
;; I = sum for J=0..K-1 of 2^(n{I,J})
|
|
(let ((calc-number-radix 2)
|
|
(calc-leading-zeros t)
|
|
(calc-word-size transferm-kernel-size))
|
|
(math-map-vec
|
|
(lambda (x)
|
|
(cons 'vec
|
|
(mapcar (lambda (x) `(vec (mod ,(logand x 1) 2)))
|
|
(substring (math-format-number x)
|
|
(- transferm-kernel-size)))))
|
|
(calcFunc-index (math-pow 2 transferm-kernel-size) 0))) ))
|
|
;; Sort solutions according to respective Hamming weight.
|
|
(lambda (x y) (< (car x) (car y)))
|
|
)))
|
|
(message "5x5 Solution computation done.")
|
|
solution-list)))
|
|
|
|
(defun 5x5-solve-suggest (&optional _n)
|
|
"Suggest to the user where to click.
|
|
|
|
Argument N is ignored."
|
|
;; For the time being n is ignored, the idea was to use some numeric
|
|
;; argument to show a limited amount of positions.
|
|
(interactive "P" 5x5-mode)
|
|
(5x5-log-init)
|
|
(let ((solutions (5x5-solver 5x5-grid)))
|
|
(setq 5x5-solver-output
|
|
(cons 5x5-moves solutions)))
|
|
(5x5-draw-grid (list 5x5-grid))
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-solve-rotate-left (&optional n)
|
|
"Rotate left by N the list of solutions in 5x5-solver-output.
|
|
|
|
If N is not supplied rotate by 1, that is to say put the last
|
|
element first in the list.
|
|
|
|
The 5x5 game has in general several solutions. For grid size=5,
|
|
there are 4 possible solutions. When function
|
|
`5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the
|
|
solution that is presented is the one that needs least number of
|
|
strokes --- other solutions can be viewed by rotating through the
|
|
list. The list of solution is ordered by number of strokes, so
|
|
rotating left just after calling `5x5-solve-suggest' will show
|
|
the solution with second least number of strokes, while rotating
|
|
right will show the solution with greatest number of strokes."
|
|
(interactive "P" 5x5-mode)
|
|
(let ((len (length 5x5-solver-output)))
|
|
(when (>= len 3)
|
|
(setq n (if (integerp n) n 1)
|
|
n (mod n (1- len)))
|
|
(unless (eq n 0)
|
|
(setq n (- len n 1))
|
|
(let* ((p-tail (last 5x5-solver-output (1+ n)))
|
|
(tail (cdr p-tail))
|
|
(l-tail (last tail)))
|
|
;;
|
|
;; For n = 2:
|
|
;;
|
|
;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
|
|
;; |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil
|
|
;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
|
|
;; ^ ^ ^ ^
|
|
;; | | | |
|
|
;; + 5x5-solver-output | | + l-tail
|
|
;; + p-tail |
|
|
;; + tail
|
|
;;
|
|
(setcdr l-tail (cdr 5x5-solver-output))
|
|
(setcdr 5x5-solver-output tail)
|
|
(unless (eq p-tail 5x5-solver-output)
|
|
(setcdr p-tail nil)))
|
|
(5x5-draw-grid (list 5x5-grid))
|
|
(5x5-position-cursor)))))
|
|
|
|
(defun 5x5-solve-rotate-right (&optional n)
|
|
"Rotate right by N the list of solutions in 5x5-solver-output.
|
|
If N is not supplied, rotate by 1. Similar to function
|
|
`5x5-solve-rotate-left' except that rotation is right instead of
|
|
lest."
|
|
(interactive "P" 5x5-mode)
|
|
(setq n
|
|
(if (integerp n) (- n)
|
|
-1))
|
|
(5x5-solve-rotate-left n))
|
|
|
|
|
|
|
|
;; Keyboard response functions.
|
|
|
|
(defun 5x5-flip-current ()
|
|
"Make a move on the current cursor location."
|
|
(interactive nil 5x5-mode)
|
|
(setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
|
|
(5x5-made-move)
|
|
(unless 5x5-cracking
|
|
(5x5-draw-grid (list 5x5-grid)))
|
|
(5x5-position-cursor)
|
|
(when (= (5x5-grid-value 5x5-grid) (* 5x5-grid-size 5x5-grid-size))
|
|
(beep)
|
|
(message "You win!")))
|
|
|
|
(defun 5x5-up ()
|
|
"Move up."
|
|
(interactive nil 5x5-mode)
|
|
(unless (zerop 5x5-y-pos)
|
|
(cl-decf 5x5-y-pos)
|
|
(5x5-position-cursor)))
|
|
|
|
(defun 5x5-down ()
|
|
"Move down."
|
|
(interactive nil 5x5-mode)
|
|
(unless (= 5x5-y-pos (1- 5x5-grid-size))
|
|
(cl-incf 5x5-y-pos)
|
|
(5x5-position-cursor)))
|
|
|
|
(defun 5x5-left ()
|
|
"Move left."
|
|
(interactive nil 5x5-mode)
|
|
(unless (zerop 5x5-x-pos)
|
|
(cl-decf 5x5-x-pos)
|
|
(5x5-position-cursor)))
|
|
|
|
(defun 5x5-right ()
|
|
"Move right."
|
|
(interactive nil 5x5-mode)
|
|
(unless (= 5x5-x-pos (1- 5x5-grid-size))
|
|
(cl-incf 5x5-x-pos)
|
|
(5x5-position-cursor)))
|
|
|
|
(defun 5x5-bol ()
|
|
"Move to beginning of line."
|
|
(interactive nil 5x5-mode)
|
|
(setq 5x5-x-pos 0)
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-eol ()
|
|
"Move to end of line."
|
|
(interactive nil 5x5-mode)
|
|
(setq 5x5-x-pos (1- 5x5-grid-size))
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-first ()
|
|
"Move to the first cell."
|
|
(interactive nil 5x5-mode)
|
|
(setq 5x5-x-pos 0
|
|
5x5-y-pos 0)
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-last ()
|
|
"Move to the last cell."
|
|
(interactive nil 5x5-mode)
|
|
(setq 5x5-x-pos (1- 5x5-grid-size)
|
|
5x5-y-pos (1- 5x5-grid-size))
|
|
(5x5-position-cursor))
|
|
|
|
(defun 5x5-randomize ()
|
|
"Randomize the grid."
|
|
(interactive nil 5x5-mode)
|
|
(when (5x5-y-or-n-p "Start a new game with a random grid? ")
|
|
(setq 5x5-x-pos (/ 5x5-grid-size 2)
|
|
5x5-y-pos (/ 5x5-grid-size 2)
|
|
5x5-moves 0
|
|
5x5-grid (5x5-make-random-grid (symbol-function '5x5-make-move))
|
|
5x5-solver-output nil)
|
|
(unless 5x5-cracking
|
|
(5x5-draw-grid (list 5x5-grid)))
|
|
(5x5-position-cursor)))
|
|
|
|
;; Support functions
|
|
|
|
(define-obsolete-function-alias '5x5-xor 'xor "27.1")
|
|
|
|
(defun 5x5-y-or-n-p (prompt)
|
|
"5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."
|
|
(if 5x5-hassle-me
|
|
(y-or-n-p prompt)
|
|
t))
|
|
|
|
(provide '5x5)
|
|
|
|
;;; 5x5.el ends here
|