[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: 5x5 Arithmetic solver
|
From: |
Vincent Belaïche |
|
Subject: |
Re: 5x5 Arithmetic solver |
|
Date: |
Sat, 21 May 2011 09:15:57 +0200 |
Salut Stéfan,
Toujours aussi à cheval sur les conventions de codage !
>> Please find herein attached a contribution to the 5x5 game. This is an
>> arithmetic solver based on a matrix inversion in a (Z/2Z)^25 vector
>> space.
>
>Thanks. A few comments:
>- avoid using a tarball and just attach the diff as-is,
> makes it a lot easier to review.
noted
>- why 5x5-local-variables?
That is used in 5x5-mode to imply that all listed variable are made
local to that very 5x5 buffer. if after `M-x 5x5' you do a `M-x
rename-uniquely' and then `M-x 5x5' again then you have have two
independent games.
>- explain the changes in the 5x5 function.
I had to change slightly the order of operations because setting the
mode has to be done before any buffer local 5x5 variable is touched, as
precisely those variables are made local by setting the mode
>- many of your lines have trailing whitespace. I generally don't care
> much, about it, but some people do, and it's usually preferable to
> avoid them. M-x picture-mode C-c C-c gets rid of them for you (as
> a side-effect).
Done
>- try to keep the first line of docstrings as a self-sufficient sentence
> (because M-x apropos only shows the first line).
>- stay within 80 columns.
Do you mean that we are still in the 80ies ;-P ?
Ok, done.
>- your code is not properly indented (e.g. the `grid' argument in
> 5x5-grid-to-vec).
Done
>- Please capitalize your comments and terminate them with a "." or some
> other appropriate punctuation.
Some comments by a variable name, so they are not capitalized.
Some comments are equations like this:
;; 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
I don't think that this is common practice to use a punctuation at the
end of an equation.
Some other comment is commented out code like this:
;;(ctransferm-1-2 (calcFunc-mcol ctransferm-1-: col-2))
This code is not there because I don't need that variable, but I found
useful to show how it would be defined.
For all the remaining comments I have done it
>- 5x5-solve-suggest should have a docstring.
Done
>- try C-u checkdoc-current-buffer.
I get
checkdoc-continue: Too many occurrences of \[function]. Use \{keymap}
instead
Because 5x5 is used many times as if it was
>- we need a ChangeLog entry.
Here it is:
-----------------------------------------------------------------------
2011-05-21 Vincent Belaïche <address@hidden>
* play/5x5.el: Add an arithmetic solver to suggest positions to
click on.
-----------------------------------------------------------------------
>- I don't understand the "solve step" message (e.g. it said 23 every
> time, even though I followed its suggestions and finished in 12 moves).
>
>
Ask it to Jay, this message is output by Calc, not by 5x5. 23 is due
to this that you have to invert a 23x23 matrix. Altough the 5x5 transfer
matrix is 25x25, its rank is only 23, so I extract some submatrix to
compute the solution.
> Stefan
Vincent.
=== modified file 'lisp/play/5x5.el'
--- lisp/play/5x5.el 2011-04-21 12:24:46 +0000
+++ lisp/play/5x5.el 2011-05-19 20:05:06 +0000
@@ -41,7 +41,10 @@
;; emacs mode.
;;
;; Pascal Q. Porcupine <address@hidden> for inspiring the animated
-;; solver.
+;; cracker.
+;;
+;; Vincent Belaïche <address@hidden> & Jay P. Belanger
+;; <address@hidden> for the math solver.
;;; Code:
@@ -134,10 +137,35 @@
(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 "q" #'5x5-quit-game)
map)
"Local keymap for the 5x5 game.")
+(defvar 5x5-solver-output nil
+ "List L 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 a list (STROKE-COUNT GRID) where
+STROKE-COUNT is to number of strokes to achieve the solution and
+GRID is the grid of positions to click.")
+
+(defconst 5x5-local-variables
+ '(5x5-grid
+ 5x5-moves
+ 5x5-grid-size
+ 5x5-x-pos
+ 5x5-y-pos
+ 5x5-cracking
+ 5x5-solver-output)
+ "List of variables to be local to a 5x5 buffer.")
+
;; Menu definition.
(easy-menu-define 5x5-mode-menu 5x5-mode-map "5x5 menu."
@@ -146,6 +174,7 @@
["Random game" 5x5-randomize t]
["Quit game" 5x5-quit-game t]
"---"
+ ["Use Calc solver" 5x5-solve-suggest t]
["Crack randomly" 5x5-crack-randomly t]
["Crack mutating current" 5x5-crack-mutating-current t]
["Crack mutating best" 5x5-crack-mutating-best t]
@@ -162,6 +191,8 @@
\\{5x5-mode-map}"
(kill-all-local-variables)
+ (dolist (v 5x5-local-variables)
+ (make-local-variable v))
(use-local-map 5x5-mode-map)
(setq major-mode '5x5-mode
mode-name "5x5")
@@ -194,14 +225,14 @@
(interactive "P")
(setq 5x5-cracking nil)
- (when size
- (setq 5x5-grid-size size))
(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)
- (5x5-mode))
+ (5x5-position-cursor))
(defun 5x5-new-game ()
"Start a new game of `5x5'."
@@ -277,10 +308,11 @@
(defun 5x5-draw-grid (grids)
"Draw the grids GRIDS into the current buffer."
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil) grid-org)
(erase-buffer)
(loop for grid in grids do (5x5-draw-grid-end))
(insert "\n")
+ (setq grid-org (point))
(loop for y from 0 to (1- 5x5-grid-size) do
(loop for lines from 0 to (1- 5x5-y-scale) do
(loop for grid in grids do
@@ -290,6 +322,23 @@
(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 (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)
+ (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)))
(loop for grid in grids do (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids))
5x5-moves))))
@@ -415,6 +464,273 @@
(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 set positions, and 0 for unset positions."
+ (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))))
+
+(if nil; set to t to enable solver logging
+ (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 purpuse 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)
+ (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))
+ (defmacro 5x5-log-init ())
+ (defmacro 5x5-log (name value) value))
+
+(defun 5x5-solver (grid)
+ "Given some grid GRID, return a list of solution LIST sorted
+from least Hamming weight to geatest 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
+achieves 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)
+ (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 origine 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))))
+
+ ;; transfer matrix is the 25x25 matrix applied everytime 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 primitive. 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
diag of 1,
+ ;; and two last columns are a base of kernel of transferm.
+ ;;
+ ;; base-change must be by construction inversible
+ (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
+ ;; (cadadr '(vec (mod x 2))) => x
+ (lambda (r x) (+ (if (integerp r) r (cadadr r))
+ (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 --- ie K=2 in if the grid is 5x5 --- for I from 0 to
+ ;; K-1, each row rI correspond to the binary representatrion 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)))
+ )))
+
+ solution-list)))
+
+(defun 5x5-solve-suggest (&optional n)
+ ;; for the time begin n is ignored, the idea was to use some numeric
+ ;; argument to show a limited amount of positions
+ (interactive "P")
+ (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))
+
;; Keyboard response functions.
(defun 5x5-flip-current ()