aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/15-puzzle-solver/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/15_puzzle_solver
note: Games

36
Task/15-puzzle-solver/00-TASK.txt Normal file
View file

@ -0,0 +1,36 @@
Your task is to write a program that finds a solution in the fewest moves possible single moves to a random [[wp:15_puzzle|Fifteen Puzzle Game]].<br />
For this task you will be using the following puzzle:<br />
<pre>15 14 1 6
9 11 4 12
0 10 7 3
13 8 5 2</pre>
<br />
Solution:<pre>
1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0
</pre>
The output must show the moves' directions, like so: left, left, left, down, right... and so on.<br />
There are two solutions, of fifty-two moves:<br>
rrrulddluuuldrurdddrullulurrrddldluurddlulurruldrdrd<br>
rrruldluuldrurdddluulurrrdlddruldluurddlulurruldrrdd<br>
see: [http://www.rosettacode.org/wiki/15_puzzle_solver/Optimal_solution Pretty Print of Optimal Solution]
Finding either one, or both is an acceptable result.<br>
;Extra credit.
Solve the following problem:
<pre>
0 12 9 13
15 11 10 14
3 7 2 5
4 8 6 1
</pre>
;Related Task:
* [[15_Puzzle_Game|15 puzzle game]]
* [[A* search algorithm]]
<br><br>

84
Task/15-puzzle-solver/11l/15-puzzle-solver.11l Normal file
View file

@ -0,0 +1,84 @@
-V
nr = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
nc = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]
T Solver
n = 0
np = 0
n0 = [0] * 100
n2 = [UInt64(0)] * 100
n3 = [Char("\0")] * 100
n4 = [0] * 100
F (values)
.n0[0] = values.index(0)
UInt64 tmp = 0
L(val) values
tmp = (tmp << 4) [|] val
.n2[0] = tmp
F fI()
V n = .n
V g = (11 - .n0[n]) * 4
V a = .n2[n] [&] (UInt64(15) << g)
.n0[n + 1] = .n0[n] + 4
.n2[n + 1] = .n2[n] - a + (a << 16)
.n3[n + 1] = Char(‘d’)
.n4[n + 1] = .n4[n] + Int(:nr[Int(a >> g)] > .n0[n] I/ 4)
F fG()
V n = .n
V g = (19 - .n0[n]) * 4
V a = .n2[n] [&] (UInt64(15) << g)
.n0[n + 1] = .n0[n] - 4
.n2[n + 1] = .n2[n] - a + (a >> 16)
.n3[n + 1] = Char(‘u’)
.n4[n + 1] = .n4[n] + Int(:nr[Int(a >> g)] < .n0[n] I/ 4)
F fE()
V n = .n
V g = (14 - .n0[n]) * 4
V a = .n2[n] [&] (UInt64(15) << g)
.n0[n + 1] = .n0[n] + 1
.n2[n + 1] = .n2[n] - a + (a << 4)
.n3[n + 1] = Char(‘r’)
.n4[n + 1] = .n4[n] + Int(:nc[Int(a >> g)] > .n0[n] % 4)
F fL()
V n = .n
V g = (16 - .n0[n]) * 4
V a = .n2[n] [&] (UInt64(15) << g)
.n0[n + 1] = .n0[n] - 1
.n2[n + 1] = .n2[n] - a + (a >> 4)
.n3[n + 1] = Char(‘l’)
.n4[n + 1] = .n4[n] + Int(:nc[Int(a >> g)] < .n0[n] % 4)
F fY()
I .n2[.n] == 1234'5678'9ABC'DEF0
R 1B
I .n4[.n] <= .np
R .fN()
R 0B
F fN() -> Bool
V n = .n
I .n3[n] != ‘u’ & .n0[n] I/ 4 < 3 {.fI(); .n++; I .fY() {R 1B}; .n--}
I .n3[n] != ‘d’ & .n0[n] I/ 4 > 0 {.fG(); .n++; I .fY() {R 1B}; .n--}
I .n3[n] != ‘l’ & .n0[n] % 4 < 3 {.fE(); .n++; I .fY() {R 1B}; .n--}
I .n3[n] != ‘r’ & .n0[n] % 4 > 0 {.fL(); .n++; I .fY() {R 1B}; .n--}
R 0B
F run()
L !.fY()
.np++
print(‘Solution found with ’(.n)‘ moves: ’, end' ‘’)
L(g) 1 .. .n
print(.n3[g], end' ‘’)
print(‘.’)
V solver = Solver([15, 14, 1, 6,
9, 11, 4, 12,
0, 10, 7, 3,
13, 8, 5, 2])
solver.run()

1019
Task/15-puzzle-solver/AArch64-Assembly/15-puzzle-solver.aarch64 Normal file
View file

File diff suppressed because it is too large Load diff

941
Task/15-puzzle-solver/ARM-Assembly/15-puzzle-solver.arm Normal file
View file

@ -0,0 +1,941 @@
/* ARM assembly Raspberry PI */
/* program puzzle15solver.s */
/* my first other program find à solution in 134 moves !!! */
/* this second program is a adaptation algorithme C++ and go rosetta code */
/* thanck for the creators */
/* 1 byte by box on game board */
/* create a file with nano */
/* 15, 2, 3, 4
5, 6, 7, 1
9, 10, 8, 11
13, 14, 12, 0 */
/* Run this programm : puzzle15solver <file name> */
/* wait several minutes for résult */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ STDIN, 0 @ Linux input console
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ READ, 3 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
.equ OPEN, 5 @ Linux syscall
.equ CLOSE, 6 @ Linux syscall
.equ TRUE, 1
.equ FALSE, 0
.equ O_RDWR, 0x0002 @ open for reading and writing
.equ SIZE, 4
.equ NBBOX, SIZE * SIZE
.equ TAILLEBUFFER, 100
.equ NBMAXIELEMENTS, 100
.equ CONST_I, 1
.equ CONST_G, 8
.equ CONST_E, 2
.equ CONST_L, 4
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessTitre: .asciz "Nom du fichier : "
sMessResult: .ascii " "
sMessValeur: .fill 11, 1, ' ' @ size => 11
szCarriageReturn: .asciz "\n"
szMessCounterSolution: .asciz "Solution in @ moves : \n"
//szMessMoveError: .asciz "Huh... Impossible move !!!!\n"
szMessErreur: .asciz "Error detected.\n"
szMessImpossible: .asciz "!!! Impossible solution !!!\n"
szMessErrBuffer: .asciz "buffer size too less !!"
szMessSpaces: .asciz " "
iTabNr: .int 3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3
iTabNc: .int 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
sZoneConv: .skip 24
iAdrHeap: .skip 4
ibox: .skip SIZE * SIZE @ game boxes
iAdrFicName: .skip 4
iTabN0: .skip 4 * NBMAXIELEMENTS @ empty box
iTabN3: .skip 4 * NBMAXIELEMENTS @ moves
iTabN4: .skip 4 * NBMAXIELEMENTS @ ????
iTabN2: .skip 4 * NBMAXIELEMENTS @ table game address
sBuffer: .skip TAILLEBUFFER
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ INFO: main
mov r0,sp @ stack address for load parameter
bl traitFic @ read file and store value in array
cmp r0,#-1
beq 100f @ error ?
ldr r0,iAdribox
bl displayGame @ display array game
ldr r0,iAdribox @ control if solution exists
bl controlSolution
cmp r0,#TRUE
beq 1f
ldr r0,iAdrszMessImpossible @ no solution !!!
bl affichageMess
b 100f
1:
ldr r0,iAdribox
ldr r9,iAdriTabN2
str r0,[r9] @ N2 address global
mov r10,#0 @ variable _n global
mov r12,#0 @ variable n global
bl searchSolution
cmp r0,#TRUE
bne 100f @ no solution ?
ldr r3,iAdriTabN2
ldr r0,[r3,r12,lsl #2] @ visual solution control
bl displayGame
mov r0,r12 @ move counter
ldr r1,iAdrsZoneConv
bl conversion10 @ conversion counter
mov r2,#0
strb r2,[r1,r0] @ and display
ldr r0,iAdrszMessCounterSolution
bl strInsertAtCharInc
ldr r1,iAdrsZoneConv
bl affichageMess
ldr r5,iAdriTabN3
ldr r3,iAdrsBuffer
mov r2,#1
mov r4,#0
2: @ loop solution display
ldrb r1,[r5,r2,lsl #2]
cmp r2,#TAILLEBUFFER
bge 99f
strb r1,[r3,r4]
add r4,r4,#1
add r2,r2,#1
cmp r2,r12
ble 2b
mov r1,#0
str r1,[r3,r4] @ zéro final
mov r0,r3
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 100f
99:
ldr r0,iAdrszMessErrBuffer
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdribox: .int ibox
iAdriTabN0: .int iTabN0
iAdriTabN2: .int iTabN2
iAdriTabN3: .int iTabN3
iAdriTabN4: .int iTabN4
iAdrszMessCounterSolution: .int szMessCounterSolution
iAdrszMessImpossible: .int szMessImpossible
iAdrszMessErrBuffer: .int szMessErrBuffer
iAdrsZoneConv: .int sZoneConv
/******************************************************************/
/* search Solution */
/******************************************************************/
searchSolution: @ INFO: searchSolution
push {r1-r8,lr} @ save registers
@ address allocation place on the heap
mov r0,#0 @ allocation place heap
mov r7,#0x2D @ call system 'brk'
svc #0
cmp r0,#-1 @ allocation error
beq 99f
ldr r1,iAdriAdrHeap
str r0,[r1] @ store heap address
bl functionFN
ldr r3,iAdriTabN2
ldr r0,[r3,r12,lsl #2] @ last current game
bl gameOK @ it is Ok ?
cmp r0,#TRUE
beq 100f @ yes --> end
ldr r1,iAdriAdrHeap @ free up resources
ldr r0,[r1] @ restaur start address heap
mov r7,#0x2D @ call system 'brk'
svc #0
cmp r0,#-1 @ allocation error
beq 99f
add r10,r10,#1 @ _n
mov r12,#0 @ n
bl searchSolution @ next recursif call
b 100f
99:
ldr r0,iAdrszMessErreur
bl affichageMess
100:
pop {r1-r8,lr} @ restaur registers
bx lr @return
iAdrszMessErreur: .int szMessErreur
iAdriAdrHeap: .int iAdrHeap
/******************************************************************/
/* Fonction FN */
/******************************************************************/
functionFN: @ INFO: functionFN
push {lr} @ save register
ldr r4,iAdriTabN3
ldr r3,[r4,r12,lsl #2]
ldr r5,iAdriTabN0 @ load position empty box
ldr r6,[r5,r12,lsl #2]
cmp r6,#15 @ last box
bne 2f
cmp r3,#'R'
bne 11f
mov r0,#CONST_G
bl functionFZ
b 100f
11:
cmp r3,#'D'
bne 12f
mov r0,#CONST_L
bl functionFZ
b 100f
12:
mov r0,#CONST_G + CONST_L
bl functionFZ
b 100f
2:
cmp r6,#12
bne 3f
cmp r3,#'L'
bne 21f
mov r0,#CONST_G
bl functionFZ
b 100f
21:
cmp r3,#'D'
bne 22f
mov r0,#CONST_E
bl functionFZ
b 100f
22:
mov r0,#CONST_E + CONST_G
bl functionFZ
b 100f
3:
cmp r6,#13
beq 30f
cmp r6,#14
bne 4f
30:
cmp r3,#'L'
bne 31f
mov r0,#CONST_G + CONST_L
bl functionFZ
b 100f
31:
cmp r3,#'R'
bne 32f
mov r0,#CONST_G + CONST_E
bl functionFZ
b 100f
32:
cmp r3,#'D'
bne 33f
mov r0,#CONST_E + CONST_L
bl functionFZ
b 100f
33:
mov r0,#CONST_L + CONST_E + CONST_G
bl functionFZ
b 100f
4:
cmp r6,#3
bne 5f
cmp r3,#'R'
bne 41f
mov r0,#CONST_I
bl functionFZ
b 100f
41:
cmp r3,#'U'
bne 42f
mov r0,#CONST_L
bl functionFZ
b 100f
42:
mov r0,#CONST_I + CONST_L
bl functionFZ
b 100f
5:
cmp r6,#0
bne 6f
cmp r3,#'L'
bne 51f
mov r0,#CONST_I
bl functionFZ
b 100f
51:
cmp r3,#'U'
bne 52f
mov r0,#CONST_E
bl functionFZ
b 100f
52:
mov r0,#CONST_I + CONST_E
bl functionFZ
b 100f
6:
cmp r6,#1
beq 60f
cmp r6,#2
bne 7f
60:
cmp r3,#'L'
bne 61f
mov r0,#CONST_I + CONST_L
bl functionFZ
b 100f
61:
cmp r3,#'R'
bne 62f
mov r0,#CONST_E + CONST_I
bl functionFZ
b 100f
62:
cmp r3,#'U'
bne 63f
mov r0,#CONST_E + CONST_L
bl functionFZ
b 100f
63:
mov r0,#CONST_I + CONST_E + CONST_L
bl functionFZ
b 100f
7:
cmp r6,#7
beq 70f
cmp r6,#11
bne 8f
70:
cmp r3,#'R'
bne 71f
mov r0,#CONST_I + CONST_G
bl functionFZ
b 100f
71:
cmp r3,#'U'
bne 72f
mov r0,#CONST_G + CONST_L
bl functionFZ
b 100f
72:
cmp r3,#'D'
bne 73f
mov r0,#CONST_I + CONST_L
bl functionFZ
b 100f
73:
mov r0,#CONST_I + CONST_G + CONST_L
bl functionFZ
b 100f
8:
cmp r6,#4
beq 80f
cmp r6,#8
bne 9f
80:
cmp r3,#'D'
bne 81f
mov r0,#CONST_I + CONST_E
bl functionFZ
b 100f
81:
cmp r3,#'U'
bne 82f
mov r0,#CONST_G + CONST_E
bl functionFZ
b 100f
82:
cmp r3,#'L'
bne 83f
mov r0,#CONST_I + CONST_G
bl functionFZ
b 100f
83:
mov r0,#CONST_G + CONST_E + CONST_I
bl functionFZ
b 100f
9:
cmp r3,#'D'
bne 91f
mov r0,#CONST_I + CONST_E + CONST_L
bl functionFZ
b 100f
91:
cmp r3,#'L'
bne 92f
mov r0,#CONST_I + CONST_G + CONST_L
bl functionFZ
b 100f
92:
cmp r3,#'R'
bne 93f
mov r0,#CONST_I + CONST_G + CONST_E
bl functionFZ
b 100f
93:
cmp r3,#'U'
bne 94f
mov r0,#CONST_G + CONST_E + CONST_L
bl functionFZ
b 100f
94:
mov r0,#CONST_G + CONST_L + CONST_I + CONST_E
bl functionFZ
b 100f
99: @ error
ldr r0,iAdrszMessErreur
bl affichageMess
100:
pop {lr} @ restaur registers
bx lr @return
/******************************************************************/
/* function FZ */
/* */
/***************************************************************/
/* r0 contains variable w */
functionFZ: @ INFO: functionFZ
push {r1,r2,lr} @ save registers
mov r2,r0
and r1,r2,#CONST_I
cmp r1,#0
ble 1f
bl functionFI
bl functionFY
cmp r0,#TRUE
beq 100f
sub r12,r12,#1 @ variable n
1:
ands r1,r2,#CONST_G
ble 2f
bl functionFG
bl functionFY
cmp r0,#TRUE
beq 100f
sub r12,r12,#1 @ variable n
2:
ands r1,r2,#CONST_E
ble 3f
bl functionFE
bl functionFY
cmp r0,#TRUE
beq 100f
sub r12,r12,#1 @ variable n
3:
ands r1,r2,#CONST_L
ble 4f
bl functionFL
bl functionFY
cmp r0,#TRUE
beq 100f
sub r12,r12,#1 @ variable n
4:
mov r0,#FALSE
100:
pop {r1,r2,lr} @ restaur registers
bx lr @return
/******************************************************************/
/* function FY */
/******************************************************************/
functionFY: @ INFO: functionFY
push {lr} @ save registers
ldr r1,iAdriTabN2
ldr r0,[r1,r12,lsl #2]
bl gameOK @ game OK ?
cmp r0,#TRUE
beq 100f
ldr r1,iAdriTabN4
ldr r0,[r1,r12,lsl #2]
cmp r0,r10
bgt 1f
bl functionFN
b 100f
1:
mov r0,#FALSE
100:
pop {lr} @ restaur registers
bx lr @return
/******************************************************************/
/* the empty box is down */
/******************************************************************/
functionFI: @ INFO: functionFI
push {r0-r8,lr} @ save registers
ldr r0,iAdriTabN0
ldr r1,[r0,r12,lsl #2] @ empty box
add r2,r1,#4
ldr r3,[r9,r12,lsl #2] @ load game current
ldrb r4,[r3,r2] @ load box down empty box
add r5,r12,#1 @ n+1
add r8,r1,#4 @ new position empty case
str r8,[r0,r5,lsl #2] @ store new position empty case
ldr r6,iAdriTabN3
mov r7,#'D' @ down
str r7,[r6,r5,lsl #2] @ store move
ldr r6,iAdriTabN4
ldr r7,[r6,r12,lsl #2]
str r7,[r6,r5,lsl #2] @ N4 (n+1) = n4(n)
mov r0,r3
bl createGame @ create copy game
ldrb r3,[r0,r1] @ and inversion box
ldrb r8,[r0,r2]
strb r8,[r0,r1]
strb r3,[r0,r2]
str r0,[r9,r5,lsl #2] @ store new game in table
lsr r1,r1,#2 @ line position empty case = N°/ 4
ldr r0,iAdriTabNr
ldr r2,[r0,r4,lsl #2] @ load N° line box moved
cmp r2,r1 @ compare ????
ble 1f
add r7,r7,#1 @ and increment ????
str r7,[r6,r5,lsl #2]
1:
add r12,r12,#1 @ increment N
pop {r0-r8,lr}
bx lr @return
iAdriTabNr: .int iTabNr
iAdriTabNc: .int iTabNc
/******************************************************************/
/* empty case UP see explain in english in function FI */
/******************************************************************/
functionFG: @ INFO: functionFG
push {r0-r8,lr} @ save registers
ldr r0,iAdriTabN0
ldr r1,[r0,r12,lsl #2] @ case vide
sub r2,r1,#4 @ position case au dessus
ldr r3,[r9,r12,lsl #2] @ extrait jeu courant
ldrb r4,[r3,r2] @ extrait le contenu case au dessus
add r5,r12,#1 @ N+1 = N
sub r8,r1,#4 @ nouvelle position case vide
str r8,[r0,r5,lsl #2] @ et on la stocke
ldr r6,iAdriTabN3
mov r7,#'U' @ puis on stocke le code mouvement
str r7,[r6,r5,lsl #2]
ldr r6,iAdriTabN4
ldr r7,[r6,r12,lsl #2]
str r7,[r6,r5,lsl #2] @ N4 (N+1) = N4 (N)
mov r0,r3 @ jeu courant
bl createGame @ création nouveau jeu
ldrb r3,[r0,r1] @ et echange les 2 cases
ldrb r8,[r0,r2]
strb r8,[r0,r1]
strb r3,[r0,r2]
str r0,[r9,r5,lsl #2] @ stocke la nouvelle situation
lsr r1,r1,#2 @ ligne case vide = position /4
ldr r0,iAdriTabNr
ldr r2,[r0,r4,lsl #2] @ extrait table à la position case
cmp r2,r1 @ et comparaison ???
bge 1f
add r7,r7,#1 @ puis increment N4 de 1 ???
str r7,[r6,r5,lsl #2]
1:
add r12,r12,#1 @ increment de N
pop {r0-r8,lr}
bx lr @return
/******************************************************************/
/* empty case go right see explain finction FI ou FG en français */
/******************************************************************/
functionFE: @ INFO: functionFE
push {r0-r8,lr} @ save registers
ldr r0,iAdriTabN0
ldr r1,[r0,r12,lsl #2]
add r2,r1,#1
ldr r3,[r9,r12,lsl #2]
ldrb r4,[r3,r2] @ extrait le contenu case
add r5,r12,#1
add r8,r1,#1
str r8,[r0,r5,lsl #2] @ nouvelle case vide
ldr r6,iAdriTabN3
mov r7,#'R'
str r7,[r6,r5,lsl #2] @ mouvement
ldr r6,iAdriTabN4
ldr r7,[r6,r12,lsl #2]
str r7,[r6,r5,lsl #2] @ N4 ??
mov r0,r3
bl createGame
ldrb r3,[r0,r1] @ exchange two boxes
ldrb r8,[r0,r2]
strb r8,[r0,r1]
strb r3,[r0,r2]
str r0,[r9,r5,lsl #2] @ stocke la nouvelle situation
lsr r3,r1,#2
sub r1,r1,r3,lsl #2
ldr r0,iAdriTabNc
ldr r2,[r0,r4,lsl #2] @ extrait table à la position case
cmp r2,r1
ble 1f
add r7,r7,#1
str r7,[r6,r5,lsl #2]
1:
add r12,r12,#1
pop {r0-r8,lr}
bx lr @return
/******************************************************************/
/* empty box go left see explain function FI ou FG en français */
/******************************************************************/
functionFL: @ INFO: functionFL
push {r0-r8,lr} @ save registers
ldr r0,iAdriTabN0
ldr r1,[r0,r12,lsl #2] @ case vide
sub r2,r1,#1
ldr r3,[r9,r12,lsl #2] @ extrait jeu courant
ldrb r4,[r3,r2] @ extrait le contenu case
add r5,r12,#1
sub r8,r1,#1
str r8,[r0,r5,lsl #2] @ nouvelle case vide
ldr r6,iAdriTabN3
mov r7,#'L'
str r7,[r6,r5,lsl #2] @ mouvement
ldr r6,iAdriTabN4
ldr r7,[r6,r12,lsl #2]
str r7,[r6,r5,lsl #2] @ N4 ??
mov r0,r3
bl createGame
ldrb r3,[r0,r1] @ exchange two boxes
ldrb r8,[r0,r2]
strb r8,[r0,r1]
strb r3,[r0,r2]
str r0,[r9,r5,lsl #2] @ stocke la nouvelle situation
lsr r3,r1,#2
sub r1,r1,r3,lsl #2 @ compute remainder
ldr r0,iAdriTabNc
ldr r2,[r0,r4,lsl #2] @ extrait table colonne à la position case
cmp r2,r1
bge 1f
add r7,r7,#1
str r7,[r6,r5,lsl #2]
1:
add r12,r12,#1
pop {r0-r8,lr}
bx lr @return
/******************************************************************/
/* create new Game */
/******************************************************************/
/* r0 contains box address */
/* r0 return address new game */
createGame: @ INFO: createGame
push {r1-r8,lr} @ save registers
mov r4,r0 @ save value
mov r0,#0 @ allocation place heap
mov r7,#0x2D @ call system 'brk'
svc #0
cmp r0,#-1 @ allocation error
beq 99f
mov r5,r0 @ save address heap for output string
add r0,#SIZE * SIZE @ reservation place one element
mov r7,#0x2D @ call system 'brk'
svc #0
cmp r0,#-1 @ allocation error
beq 99f
mov r2,#0
1: @ loop copy boxes
ldrb r3,[r4,r2]
strb r3,[r5,r2]
add r2,r2,#1
cmp r2,#NBBOX
blt 1b
add r11,r11,#1
mov r0,r5
b 100f
99: @ error
ldr r0,iAdrszMessErreur
bl affichageMess
100:
pop {r1-r8,lr} @ restaur registers
bx lr @return
/******************************************************************/
/* read file */
/******************************************************************/
/* r0 contains address stack begin */
traitFic: @ INFO: traitFic
push {r1-r8,fp,lr} @ save registers
mov fp,r0 @ fp <- start address
ldr r4,[fp] @ number of Command line arguments
cmp r4,#1
movle r0,#-1
ble 99f
add r5,fp,#8 @ second parameter address
ldr r5,[r5]
ldr r0,iAdriAdrFicName
str r5,[r0]
ldr r0,iAdrszMessTitre
bl affichageMess @ display string
mov r0,r5
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess @ display carriage return
mov r0,r5 @ file name
mov r1,#O_RDWR @ flags
mov r2,#0 @ mode
mov r7, #OPEN @ call system OPEN
svc 0
cmp r0,#0 @ error ?
ble 99f
mov r8,r0 @ File Descriptor
ldr r1,iAdrsBuffer @ buffer address
mov r2,#TAILLEBUFFER @ buffer size
mov r7,#READ @ read file
svc #0
cmp r0,#0 @ error ?
blt 99f
@ extraction datas
ldr r1,iAdrsBuffer @ buffer address
add r1,r0
mov r0,#0 @ store zéro final
strb r0,[r1]
ldr r0,iAdribox @ game box address
ldr r1,iAdrsBuffer @ buffer address
bl extracDatas
@ close file
mov r0,r8
mov r7, #CLOSE
svc 0
mov r0,#0
b 100f
99: @ error
ldr r1,iAdrszMessErreur @ error message
bl displayError
mov r0,#-1
100:
pop {r1-r8,fp,lr} @ restaur registers
bx lr @return
iAdriAdrFicName: .int iAdrFicName
iAdrszMessTitre: .int szMessTitre
iAdrsBuffer: .int sBuffer
/******************************************************************/
/* extrac digit file buffer */
/******************************************************************/
/* r0 contains boxs address */
/* r1 contains buffer address */
extracDatas: @ INFO: extracDatas
push {r1-r8,lr} @ save registers
mov r7,r0
mov r6,r1
mov r2,#0 @ string buffer indice
mov r4,r1 @ start digit ascii
mov r5,#0 @ box index
1:
ldrb r3,[r6,r2]
cmp r3,#0
beq 4f @ end
cmp r3,#0xA
beq 2f
cmp r3,#','
beq 3f
add r2,#1
b 1b
2:
mov r3,#0
strb r3,[r6,r2]
ldrb r3,[r6,r2]
cmp r3,#0xD
addeq r2,#2
addne r2,#1
b 4f
3:
mov r3,#0
strb r3,[r6,r2]
add r2,#1
4:
mov r0,r4
bl conversionAtoD
strb r0,[r7,r5]
cmp r0,#0
ldreq r0,iAdriTabN0
streq r5,[r0] @ empty box in item zéro
add r5,#1
cmp r5,#NBBOX @ number box = maxi ?
bge 100f
add r4,r6,r2 @ new start address digit ascii
b 1b
100:
pop {r1-r8,lr} @ restaur registers
bx lr @return
/******************************************************************/
/* control of the game solution */
/******************************************************************/
/* r0 contains boxs address */
/* r0 returns 0 if not possible */
/* r0 returns 1 if possible */
controlSolution: @ INFO: controlSolution
push {r1-r8,lr} @ save registers
mov r5,r0
ldr r8,iAdriTabN0
ldr r8,[r8] @ empty box
@ empty box
mov r7,#0
cmp r8,#1
moveq r7,#1
beq 1f
cmp r8,#3
moveq r7,#1
beq 1f
cmp r8,#4
moveq r7,#1
beq 1f
cmp r8,#6
moveq r7,#1
beq 1f
cmp r8,#9
moveq r7,#1
beq 1f
cmp r8,#11
moveq r7,#1
beq 1f
cmp r8,#12
moveq r7,#1
beq 1f
cmp r8,#14
moveq r7,#1
1:
rsb r6,r8,#NBBOX - 1
add r7,r6
@ count permutations
mov r1,#-1
mov r6,#0
2:
add r1,#1
cmp r1,#NBBOX
bge 80f
cmp r1,r8
beq 2b
ldrb r3,[r5,r1]
mov r2,r1
3:
add r2,#1
cmp r2,#NBBOX
bge 2b
cmp r2,r8
beq 3b
ldrb r4,[r5,r2]
cmp r4,r3
addlt r6,#1
b 3b
80:
add r6,r7
tst r6,#1
movne r0,#0 @ impossible
moveq r0,#1 @ OK
100:
pop {r1-r8,lr} @ restaur registers
bx lr @return
/******************************************************************/
/* game Ok ? */
/******************************************************************/
/* r0 contains boxs address */
gameOK: @ INFO: gameOK
push {r1-r4,lr} @ save registers
mov r2,#0
ldrb r3,[r0,r2]
cmp r3,#0
moveq r3,#0xF
add r2,#1
1:
ldrb r4,[r0,r2]
cmp r4,#0
moveq r3,#0xF
cmp r4,r3
movle r0,#FALSE @ game not Ok
ble 100f
mov r3,r4
add r2,#1
cmp r2,#NBBOX -2
ble 1b
mov r0,#TRUE @ game Ok
100:
pop {r1-r4,lr} @ restaur registers
bx lr @return
/******************************************************************/
/* display game */
/******************************************************************/
/* r0 contains boxs address */
displayGame: @ INFO: displayGame
push {r0-r5,lr} @ save registers
mov r4,r0
ldr r0,iAdrszMessTitre
bl affichageMess @ display string
ldr r0,iAdriAdrFicName
ldr r0,[r0]
bl affichageMess @ display string
ldr r0,iAdrszCarriageReturn
bl affichageMess @ display line return
mov r2,#0
ldr r1,iAdrsMessValeur
1:
ldrb r0,[r4,r2]
cmp r0,#0
ldreq r0,iSpaces @ store spaces
streq r0,[r1]
beq 2f
bl conversion10 @ call conversion decimal
mov r0,#0
strb r0,[r1,#3] @ zéro final
2:
ldr r0,iAdrsMessResult
bl affichageMess @ display message
add r0,r2,#1
tst r0,#0b11
bne 3f
ldr r0,iAdrszCarriageReturn
bl affichageMess @ display message
3:
add r2,#1
cmp r2,#NBBOX - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess @ display line return
100:
pop {r0-r5,lr} @ restaur registers
bx lr @return
iSpaces: .int 0x00202020 @ spaces
//iAdrszMessMoveError: .int szMessMoveError
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessValeur: .int sMessValeur
iAdrsMessResult: .int sMessResult
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"

192
Task/15-puzzle-solver/Ada/15-puzzle-solver.ada Normal file
View file

@ -0,0 +1,192 @@
with Ada.Text_IO;
procedure Puzzle_15 is
type Direction is (Up, Down, Left, Right);
type Row_Type is range 0 .. 3;
type Col_Type is range 0 .. 3;
type Tile_Type is range 0 .. 15;
To_Col : constant array (Tile_Type) of Col_Type :=
(3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2);
To_Row : constant array (Tile_Type) of Row_Type :=
(3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3);
type Board_Type is array (Row_Type, Col_Type) of Tile_Type;
Solved_Board : constant Board_Type :=
((1, 2, 3, 4),
(5, 6, 7, 8),
(9, 10, 11, 12),
(13, 14, 15, 0));
type Try_Type is
record
Board : Board_Type;
Move : Direction;
Cost : Integer;
Row : Row_Type;
Col : Col_Type;
end record;
Stack : array (0 .. 100) of Try_Type;
Top : Natural := 0;
Iteration_Count : Natural := 0;
procedure Move_Down is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row + 1, Col);
Penalty : constant Integer :=
(if To_Row (Tile) <= Row then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row + 1, Col) := 0;
Stack (Top + 1) := (Board => Board,
Move => Down,
Row => Row + 1,
Col => Col,
Cost => Stack (Top).Cost + Penalty);
end Move_Down;
procedure Move_Up is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row - 1, Col);
Penalty : constant Integer :=
(if To_Row (Tile) >= Row then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row - 1, Col) := 0;
Stack (Top + 1) := (Board => Board,
Move => Up,
Row => Row - 1,
Col => Col,
Cost => Stack (Top).Cost + Penalty);
end Move_Up;
procedure Move_Left is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row, Col - 1);
Penalty : constant Integer :=
(if To_Col (Tile) >= Col then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row, Col - 1) := 0;
Stack (Top + 1) := (Board => Board,
Move => Left,
Row => Row,
Col => Col - 1,
Cost => Stack (Top).Cost + Penalty);
end Move_Left;
procedure Move_Right is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row, Col + 1);
Penalty : constant Integer :=
(if To_Col (Tile) <= Col then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row, Col + 1) := 0;
Stack (Top + 1) := (Board => Board,
Move => Right,
Row => Row,
Col => Col + 1,
Cost => Stack (Top).Cost + Penalty);
end Move_Right;
function Is_Solution return Boolean;
function Test_Moves return Boolean is
begin
if
Stack (Top).Move /= Down and then
Stack (Top).Row /= Row_Type'First
then
Move_Up;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Up and then
Stack (Top).Row /= Row_Type'Last
then
Move_Down;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Right and then
Stack (Top).Col /= Col_Type'First
then
Move_Left;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Left and then
Stack (Top).Col /= Col_Type'Last
then
Move_Right;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
return False;
end Test_Moves;
function Is_Solution return Boolean is
use Ada.Text_IO;
begin
if Stack (Top).Board = Solved_Board then
Put ("Solved in " & Top'Image & " moves: ");
for R in 1 .. Top loop
Put (String'(Stack (R).Move'Image) (1));
end loop;
New_Line;
return True;
end if;
if Stack (Top).Cost <= Iteration_Count then
return Test_Moves;
end if;
return False;
end Is_Solution;
procedure Solve (Row : in Row_Type;
Col : in Col_Type;
Board : in Board_Type) is
begin
pragma Assert (Board (Row, Col) = 0);
Top := 0;
Iteration_Count := 0;
Stack (Top) := (Board => Board,
Row => Row,
Col => Col,
Move => Down,
Cost => 0);
while not Is_Solution loop
Iteration_Count := Iteration_Count + 1;
end loop;
end Solve;
begin
Solve (Row => 2,
Col => 0,
Board => ((15, 14, 1, 6),
(9, 11, 4, 12),
(0, 10, 7, 3),
(13, 8, 5, 2)));
end Puzzle_15;

41
Task/15-puzzle-solver/C++/15-puzzle-solver-1.cpp Normal file
View file

@ -0,0 +1,41 @@
// Solve Random 15 Puzzles : Nigel Galloway - October 18th., 2017
class fifteenSolver{
const int Nr[16]{3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3}, Nc[16]{3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2};
int n{},_n{}, N0[100]{},N3[100]{},N4[100]{};
unsigned long N2[100]{};
const bool fY(){
if (N4[n]<_n) return fN();
if (N2[n]==0x123456789abcdef0) {std::cout<<"Solution found in "<<n<<" moves :"; for (int g{1};g<=n;++g) std::cout<<(char)N3[g]; std::cout<<std::endl; return true;};
if (N4[n]==_n) return fN(); else return false;
}
const bool fN(){
if (N3[n]!='u' && N0[n]/4<3){fI(); ++n; if (fY()) return true; --n;}
if (N3[n]!='d' && N0[n]/4>0){fG(); ++n; if (fY()) return true; --n;}
if (N3[n]!='l' && N0[n]%4<3){fE(); ++n; if (fY()) return true; --n;}
if (N3[n]!='r' && N0[n]%4>0){fL(); ++n; if (fY()) return true; --n;}
return false;
}
void fI(){
const int g = (11-N0[n])*4;
const unsigned long a = N2[n]&((unsigned long)15<<g);
N0[n+1]=N0[n]+4; N2[n+1]=N2[n]-a+(a<<16); N3[n+1]='d'; N4[n+1]=N4[n]+(Nr[a>>g]<=N0[n]/4?0:1);
}
void fG(){
const int g = (19-N0[n])*4;
const unsigned long a = N2[n]&((unsigned long)15<<g);
N0[n+1]=N0[n]-4; N2[n+1]=N2[n]-a+(a>>16); N3[n+1]='u'; N4[n+1]=N4[n]+(Nr[a>>g]>=N0[n]/4?0:1);
}
void fE(){
const int g = (14-N0[n])*4;
const unsigned long a = N2[n]&((unsigned long)15<<g);
N0[n+1]=N0[n]+1; N2[n+1]=N2[n]-a+(a<<4); N3[n+1]='r'; N4[n+1]=N4[n]+(Nc[a>>g]<=N0[n]%4?0:1);
}
void fL(){
const int g = (16-N0[n])*4;
const unsigned long a = N2[n]&((unsigned long)15<<g);
N0[n+1]=N0[n]-1; N2[n+1]=N2[n]-a+(a>>4); N3[n+1]='l'; N4[n+1]=N4[n]+(Nc[a>>g]>=N0[n]%4?0:1);
}
public:
fifteenSolver(int n, unsigned long g){N0[0]=n; N2[0]=g;}
void Solve(){for(;not fY();++_n);}
};

4
Task/15-puzzle-solver/C++/15-puzzle-solver-2.cpp Normal file
View file

@ -0,0 +1,4 @@
int main (){
fifteenSolver start(8,0xfe169b4c0a73d852);
start.Solve();
}

4
Task/15-puzzle-solver/C++/15-puzzle-solver-3.cpp Normal file
View file

@ -0,0 +1,4 @@
int main (){
fifteenSolver start(0,0x0c9dfbae37254861);
start.Solve();
}

1466
Task/15-puzzle-solver/C-sharp/15-puzzle-solver.cs Normal file
View file

File diff suppressed because it is too large Load diff

285
Task/15-puzzle-solver/C/15-puzzle-solver.c Normal file
View file

@ -0,0 +1,285 @@
/**@file HybridIDA.c
* @brief solve 4x4 sliding puzzle with IDA* algorithm
* by RMM 2021-feb-22
* The Interative Deepening A* is relatively easy to code in 'C' since
* it does not need Queues and Lists to manage memory. Instead the
* search space state is held on the LIFO stack frame of recursive
* search function calls. Millions of nodes may be created but they
* are automatically deleted during backtracking.
* Run-time is a disadvantage with complex puzzles. Also it struggles
* to solve puzzles with depth g>50. I provided a test puzzle of g=52
* that works with ordinary search but the Rosetta challenge puzzle
* cycles forever. The HybridIDA solves it in 18 seconds.
* The HybridIDA solution has two phases.
* 1. It stops searching when a permutation begins with 1234.
* 2. Phase2 begins a regular search with the output of phase 1.
* (But an regular one time search can be done with phase 2
* only). Phase 1 is optional.)
* Pros: Hybrid IDA* is faster and solves more puzzles.
* Cons: May not find shortest path.
*/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
typedef unsigned char u8t;
typedef unsigned short u16t;
enum { NR=4, NC=4, NCELLS = NR*NC };
enum { UP, DOWN, LEFT, RIGHT, NDIRS };
enum { OK = 1<<8, XX = 1<<9, FOUND = 1<<10, zz=0x80 };
enum { MAX_INT=0x7E, MAX_NODES=(16*65536)*90};
enum { BIT_HDR=1<<0, BIT_GRID=1<<1, BIT_OTHER=1<<2 };
enum { PHASE1,PHASE2 }; // solution phase
typedef struct { u16t dn; u16t hn; }HSORT_T;
typedef struct {
u8t data[NCELLS]; unsigned id; unsigned src;
u8t h; u8t g; u8t udlr;
}NODE_T; // contains puzzle data and metadata
NODE_T goal44={
{1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0},0,0,0,0,0};
NODE_T work; // copy of puzzle with run-time changes
NODE_T G34={ //g=34; n=248,055; (1phase)
{13,9,5,4, 15,6,1,8, 0,10,2,11, 14,3,7,12},0,0,0,0,0};
NODE_T G52={ // g=52; n=34,296,567; (1phase)
{15,13,9,5, 14,6,1,4, 10,12,0,8, 3,7,11,2},0,0,0,0,0};
NODE_T G99={ // formidable Rosetta challenge (2phases)
{15,14,1,6, 9,11,4,12, 0,10,7,3, 13,8,5,2},0,0,0,0,0};
struct {
unsigned nodes;
unsigned gfound;
unsigned root_visits;
unsigned verbose;
unsigned locks;
unsigned phase;
}my;
u16t HybridIDA_star(NODE_T *pNode);
u16t make_node(NODE_T *pNode, NODE_T *pNew, u8t udlr );
u16t search(NODE_T *pNode, u16t bound);
u16t taxi_dist( NODE_T *pNode);
u16t tile_home( NODE_T *p44);
void print_node( NODE_T *pN, const char *pMsg, short force );
u16t goal_found(NODE_T *pNode);
char udlr_to_char( char udlr );
void idx_to_rc( u16t idx, u16t *row, u16t *col );
void sort_nodes(HSORT_T *p);
int main( )
{
my.verbose = 0; // minimal print node
// my.verbose |= BIT_HDR; // node header
// my.verbose |= BIT_GRID; // node 4x4 data
memcpy(&work, &G99, sizeof(NODE_T)); // select puzzle here
if(1){ // phase1 can skipped for easy puzzles
printf("Phase1: IDA* search for 1234 permutation..\n");
my.phase = PHASE1;
(void) HybridIDA_star(&work);
}
printf("Phase2: IDA* search phase1 seed..\n");
my.phase = PHASE2;
(void)HybridIDA_star(&work);
return 0;
}
/// \brief driver for Iterative Deepining A*
u16t HybridIDA_star(NODE_T *pN){
my.nodes = 1;
my.gfound = 0;
my.root_visits = 0;
pN->udlr = NDIRS;
pN->g = 0;
pN->h = taxi_dist(pN);
pN->id = my.nodes;
pN->src = 0;
const char *pr = {"Start"}; // for g++
print_node( pN,pr,1 );
u16t depth = pN->h;
while(1){
depth = search(pN,depth);
if( depth & FOUND){
return FOUND; // goodbye
}
if( depth & 0xFF00 ){
printf("..error %x\n",depth);
return XX;
}
my.root_visits++;
printf("[root visits: %u, depth %u]\n",my.root_visits,depth);
}
return 0;
}
/// \brief search is recursive. nodes are instance variables
u16t search(NODE_T *pN, u16t bound){
if(bound & 0xff00){ return bound; }
u16t f = pN->g + pN->h;
if( f > bound){ return f; }
if(goal_found(pN)){
my.gfound = pN->g;
memcpy(&work,pN,sizeof(NODE_T));
printf("total nodes=%d, g=%u \n", my.nodes, my.gfound);
const char *pr = {"Found.."}; // for g++
print_node( &work,pr,1 );
return FOUND;
}
NODE_T news;
// Sort successor nodes so that the lowest heuristic is visited
// before the less promising at the same level. This reduces the
// number of searches and finds more solutions
HSORT_T hlist[NDIRS];
for( short i=0; i<NDIRS; i++ ){
u16t rv = make_node(pN,&news, i );
hlist[i].dn = i;
if( rv & OK ){
hlist[i].hn = news.h;
continue;
}
hlist[i].hn = XX;
}
sort_nodes(&hlist[0]);
u16t temp, min = MAX_INT;
for( short i=0; i<NDIRS; i++ ){
if( hlist[i].hn > 0xff ) continue;
temp = make_node(pN,&news, hlist[i].dn );
if( temp & XX ) return XX;
if( temp & OK ){
news.id = my.nodes++;
print_node(&news," succ",0 );
temp = search(&news, bound);
if(temp & 0xff00){ return temp;}
if(temp < min){ min = temp; }
}
}
return min;
}
/// \brief sort nodes to prioitize heuristic low
void sort_nodes(HSORT_T *p){
for( short s=0; s<NDIRS-1; s++ ){
HSORT_T tmp = p[0];
if( p[1].hn < p[0].hn ){tmp=p[0]; p[0]=p[1]; p[1]=tmp; }
if( p[2].hn < p[1].hn ){tmp=p[1]; p[1]=p[2]; p[2]=tmp; }
if( p[3].hn < p[2].hn ){tmp=p[2]; p[2]=p[3]; p[3]=tmp; }
}
}
/// \brief return index of blank tile
u16t tile_home(NODE_T *pN ){
for( short i=0; i<NCELLS; i++ ){
if( pN->data[i] == 0 ) return i;
}
return XX;
}
/// \brief print node (or not) depending upon flags
void print_node( NODE_T *pN, const char *pMsg, short force ){
const int tp1 = 0;
if( my.verbose & BIT_HDR || force || tp1){
char ch = udlr_to_char(pN->udlr);
printf("id:%u src:%u; h=%d, g=%u, udlr=%c, %s\n",
pN->id, pN->src, pN->h, pN->g, ch, pMsg);
}
if(my.verbose & BIT_GRID || force || tp1){
for(u16t i=0; i<NR; i++ ){
for( u16t j=0; j<NC; j++ ){
printf("%3d",pN->data[i*NR+j]);
}
printf("\n");
}
printf("\n");
}
//putchar('>'); getchar();
}
/// \brief return true if selected tiles are settled
u16t goal_found(NODE_T *pN) {
if(my.phase==PHASE1){
short tags = 0;
for( short i=0; i<(NC); i++ ){
if( pN->data[i] == i+1 ) tags++;
}
if( tags==4 ) return 1; // Permutation starts with 1234
}
for( short i=0; i<(NR*NC); i++ ){
if( pN->data[i] != goal44.data[i] ) return 0;
}
return 1;
}
/// \brief convert UDLR index to printable char
char udlr_to_char( char udlr ){
char ch = '?';
switch(udlr){
case UP: ch = 'U'; break;
case DOWN: ch = 'D'; break;
case LEFT: ch = 'L'; break;
case RIGHT: ch = 'R'; break;
default: break;
}
return ch;
}
/// \brief convert 1-D array index to 2-D row-column
void idx_to_rc( u16t idx, u16t *row, u16t *col ){
*row = idx/NR; *col = abs( idx - (*row * NR));
}
/// \brief make successor node with blank tile moved UDRL
/// \return success or error
u16t make_node(NODE_T *pSrc, NODE_T *pNew, u8t udlr ){
u16t row,col,home_idx,idx2;
if(udlr>=NDIRS||udlr<0 ){ printf("invalid udlr %u\n",udlr); return XX; }
if(my.nodes > MAX_NODES ){ printf("excessive nodes %u\n",my.nodes);
return XX; }
memcpy(pNew,pSrc,sizeof(NODE_T));
home_idx = tile_home(pNew);
idx_to_rc(home_idx, &row, &col );
if( udlr == LEFT) { if( col < 1 ) return 0; col--; }
if( udlr == RIGHT ){ if( col >= (NC-1) ) return 0; col++; }
if( udlr == DOWN ) { if(row >= (NR-1)) return 0; row++; }
if( udlr == UP ){ if(row < 1) return 0; row--; }
idx2 = row * NR + col;
if( idx2 < NCELLS ){
u8t *p = &pNew->data[0];
p[home_idx] = p[idx2];
p[idx2] = 0; // swap
pNew->src = pSrc->id;
pNew->g = pSrc->g + 1;
pNew->h = taxi_dist(pNew);
pNew->udlr = udlr; // latest move;
return OK;
}
return 0;
}
/// \brief sum of 'manhattan taxi' distance between tile locations
u16t taxi_dist( NODE_T *pN){
u16t tile,sum = 0, r1,c1,r2,c2;
u8t *p44 = &pN->data[0];
for( short i=0; i<(NR*NC); i++ ){
tile = p44[i];
if( tile==0 ) continue;
idx_to_rc(i, &r2, &c2 );
idx_to_rc(tile-1, &r1, &c1 );
sum += abs(r1-r2) + abs(c1-c2);
}
}
return sum;
}

331
Task/15-puzzle-solver/Common-Lisp/15-puzzle-solver.lisp Normal file
View file

@ -0,0 +1,331 @@
;;; Using a priority queue for the A* search
(eval-when (:load-toplevel :compile-toplevel :execute)
(ql:quickload "pileup"))
;; * The package definition
(defpackage :15-solver
(:use :common-lisp :pileup)
(:export "15-puzzle-solver" "*initial-state*" "*goal-state*"))
(in-package :15-solver)
;; * Data types
(defstruct (posn (:constructor posn))
"A posn is a pair struct containing two integer for the row/col indices."
(row 0 :type fixnum)
(col 0 :type fixnum))
(defstruct (state (:constructor state))
"A state contains a vector and a posn describing the position of the empty slot."
(matrix '#(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0) :type simple-vector)
(empty-slot (posn :row 3 :col 3) :type posn))
(defparameter directions '(up down left right)
"The possible directions shifting the empty slot.")
(defstruct (node (:constructor node))
"A node contains a state, a reference to the previous node, a g value (actual
costs until this node, and a f value (g value + heuristics)."
(state (state) :type state)
(prev nil)
(cost 0 :type fixnum)
(f-value 0 :type fixnum))
;; * Some constants
(defparameter *side-size* 4 "The size of the puzzle.")
(defvar *initial-state*
(state :matrix #(15 14 1 6
9 11 4 12
0 10 7 3
13 8 5 2)
:empty-slot (posn :row 2 :col 0)))
(defvar *initial-state-2*
(state :matrix #( 0 12 9 13
15 11 10 14
3 7 2 5
4 8 6 1)
:empty-slot (posn :row 0 :col 0)))
(defvar *goal-state*
(state :matrix #( 1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0)
:empty-slot (posn :row 3 :col 3)))
;; * The functions
;; ** Accessing the elements of the puzzle
(defun matrix-ref (matrix row col)
"Matrices are simple vectors, abstracted by following functions."
(svref matrix (+ (* row *side-size*) col)))
(defun (setf matrix-ref) (val matrix row col)
(setf (svref matrix (+ (* row *side-size*) col)) val))
;; ** The final predicate
(defun target-state-p (state goal-state)
"Returns T if STATE is the goal state."
(equalp state goal-state))
(defun valid-movement-p (direction empty-slot)
"Returns T if direction is allowed for the current empty slot position."
(case direction
(up (< (posn-row empty-slot) (1- *side-size*)))
(down (> (posn-row empty-slot) 0))
(left (< (posn-col empty-slot) (1- *side-size*)))
(right (> (posn-col empty-slot) 0))))
;; ** Pretty print the state
(defun print-state (state)
"Helper function to pretty-print a state."
(format t " ====================~%")
(loop
with matrix = (state-matrix state)
for i from 0 below *side-size*
do
(loop
for j from 0 below *side-size*
do (format t "| ~2,D " (matrix-ref matrix i j)))
(format t " |~%"))
(format t " ====================~%"))
;; ** Move the empty slot
(defun move (state direction)
"Returns a new state after moving STATE's empty-slot in DIRECTION assuming a
valid direction."
(let* ((matrix (copy-seq (state-matrix state)))
(empty-slot (state-empty-slot state))
(r (posn-row empty-slot))
(c (posn-col empty-slot))
(new-empty-slot
(ccase direction
(up (setf (matrix-ref matrix r c) (matrix-ref matrix (1+ r) c)
(matrix-ref matrix (1+ r) c) 0)
(posn :row (1+ r) :col c))
(down (setf (matrix-ref matrix r c) (matrix-ref matrix (1- r) c)
(matrix-ref matrix (1- r) c) 0)
(posn :row (1- r) :col c))
(left (setf (matrix-ref matrix r c) (matrix-ref matrix r (1+ c))
(matrix-ref matrix r (1+ c)) 0)
(posn :row r :col (1+ c)))
(right (setf (matrix-ref matrix r c) (matrix-ref matrix r (1- c))
(matrix-ref matrix r (1- c)) 0)
(posn :row r :col (1- c))))))
(state :matrix matrix :empty-slot new-empty-slot)))
;; ** The heuristics
(defun l1-distance (posn0 posn1)
"Returns the L1 distance between two positions."
(+ (abs (- (posn-row posn0) (posn-row posn1)))
(abs (- (posn-col posn0) (posn-col posn1)))))
(defun element-cost (val current-posn)
"Returns the L1 distance between the current position and the goal-position
for VAL."
(if (zerop val)
(l1-distance current-posn (posn :row 3 :col 3))
(multiple-value-bind (target-row target-col)
(floor (1- val) *side-size*)
(l1-distance current-posn (posn :row target-row :col target-col)))))
(defun distance-to-goal (state)
"Returns the L1 distance from STATE to the goal state."
(loop
with matrix = (state-matrix state)
with sum = 0
for i below *side-size*
do (loop
for j below *side-size*
for val = (matrix-ref matrix i j)
for cost = (element-cost val (posn :row i :col j))
unless (zerop val)
do (incf sum cost))
finally (return sum)))
(defun out-of-order-values (list)
"Returns the number of values out of order."
(flet ((count-values (list)
(loop
with a = (first list)
with rest = (rest list)
for b in rest
when (> b a)
count b)))
(loop
for candidates = list then (rest candidates)
while candidates
summing (count-values candidates) into result
finally (return (* 2 result)))))
(defun row-conflicts (row state0 state1)
"Returns the number of conflicts in the given row, i.e. value in the right row
but in the wrong order. For each conflicted pair add 2 to the value, but a
maximum of 6 to avoid over-estimation."
(let* ((goal-row (loop
with matrix1 = (state-matrix state1)
for j below *side-size*
collect (matrix-ref matrix1 row j)))
(in-goal-row (loop
with matrix0 = (state-matrix state0)
for j below *side-size*
for val = (matrix-ref matrix0 row j)
when (member val goal-row)
collect val)))
(min 6 (out-of-order-values
;; 0 does not lead to a linear conflict
(remove 0 (nreverse in-goal-row))))))
(defun col-conflicts (col state0 state1)
"Returns the number of conflicts in the given column, i.e. value in the right
row but in the wrong order. For each conflicted pair add 2 to the value, but a
maximum of 6 to avoid over-estimation."
(let* ((goal-col (loop
with matrix1 = (state-matrix state1)
for i below *side-size*
collect (matrix-ref matrix1 i col)))
(in-goal-col (loop
with matrix0 = (state-matrix state0)
for i below *side-size*
for val = (matrix-ref matrix0 i col)
when (member val goal-col)
collect val)))
(min 6 (out-of-order-values
;; 0 does not lead to a linear conflict
(remove 0 (nreverse in-goal-col))))))
(defun linear-conflicts (state0 state1)
"Returns the linear conflicts for state1 with respect to state0."
(loop
for i below *side-size*
for row-conflicts = (row-conflicts i state0 state1)
for col-conflicts = (col-conflicts i state0 state1)
summing row-conflicts into all-row-conflicts
summing col-conflicts into all-col-conflicts
finally (return (+ all-row-conflicts all-col-conflicts))))
(defun state-heuristics (state)
"Using the L1 distance and the number of linear conflicts as heuristics."
(+ (distance-to-goal state)
(linear-conflicts state *goal-state*)))
;; ** Generate the next possible states.
(defun next-state-dir-pairs (current-node)
"Returns a list of pairs containing the next states and the direction for the
movement of the empty slot."
(let* ((state (node-state current-node))
(empty-slot (state-empty-slot state))
(valid-movements (remove-if-not (lambda (dir) (valid-movement-p dir empty-slot))
directions)))
(map 'list (lambda (dir) (cons (move state dir) dir)) valid-movements)))
;; ** Searching the shortest paths and reconstructing the movements
(defun reconstruct-movements (leaf-node)
"Traverse all nodes until the initial state and return a list of symbols
describing the path."
(labels ((posn-diff (p0 p1)
;; Compute a pair describing the last move
(posn :row (- (posn-row p1) (posn-row p0))
:col (- (posn-col p1) (posn-col p0))))
(find-movement (prev-state state)
;; Describe the last movement of the empty slot with R, L, U or D.
(let* ((prev-empty-slot (state-empty-slot prev-state))
(this-empty-slot (state-empty-slot state))
(delta (posn-diff prev-empty-slot this-empty-slot)))
(cond ((equalp delta (posn :row 1 :col 0)) 'u)
((equalp delta (posn :row -1 :col 0)) 'd)
((equalp delta (posn :row 0 :col 1)) 'l)
((equalp delta (posn :row 0 :col -1)) 'r))))
(iter (node path)
(if (or (not node) (not (node-prev node)))
path
(iter (node-prev node)
(cons (find-movement (node-state node)
(node-state (node-prev node)))
path)))))
(iter leaf-node '())))
(defun A* (initial-state
&key (goal-state *goal-state*) (heuristics #'state-heuristics)
(information 0))
"An A* search for the shortest path to *GOAL-STATE*"
(let ((visited (make-hash-table :test #'equalp))) ; All states visited so far
;; Some internal helper functions
(flet ((pick-next-node (queue)
;; Get the next node from the queue
(heap-pop queue))
(expand-node (node queue)
;; Expand the next possible nodes from node and add them to the
;; queue if not already visited.
(loop
with costs = (node-cost node)
with successors = (next-state-dir-pairs node)
for (state . dir) in successors
for succ-cost = (1+ costs)
for f-value = (+ succ-cost (funcall heuristics state))
;; Check if this state was already looked at
unless (gethash state visited)
do
;; Insert the next node into the queue
(heap-insert
(node :state state :prev node :cost succ-cost
:f-value f-value)
queue))))
;; The actual A* search
(loop
;; The priority queue
with queue = (make-heap #'<= :name "queue" :size 1000 :key #'node-f-value)
with initial-state-cost = (funcall heuristics initial-state)
initially (heap-insert (node :state initial-state :prev nil :cost 0
:f-value initial-state-cost)
queue)
for counter from 1
for current-node = (pick-next-node queue)
for current-state = (node-state current-node)
;; Output some information each counter or nothing if information
;; equals 0.
when (and (not (zerop information))
(zerop (mod counter information)))
do (format t "~Dth State, heap size: ~D, current costs: ~D~%"
counter (heap-count queue)
(node-cost current-node))
;; If the target is not reached continue
until (target-state-p current-state goal-state)
do
;; Add the current state to the hash of visited states
(setf (gethash current-state visited) t)
;; Expand the current node and continue
(expand-node current-node queue)
finally (return (values (reconstruct-movements current-node) counter))))))
;; ** Pretty print the path
(defun print-path (path)
"Prints the directions of PATH and its length."
(format t "~{~A~} ~D moves~%" path (length path)))
;; ** Get some timing information
(defmacro timing (&body forms)
"Return both how much real time was spend in body and its result"
(let ((start (gensym))
(end (gensym))
(result (gensym)))
`(let* ((,start (get-internal-real-time))
(,result (progn ,@forms))
(,end (get-internal-real-time)))
(values ,result (/ (- ,end ,start) internal-time-units-per-second)))))
;; ** The main function
(defun 15-puzzle-solver (initial-state &key (goal-state *goal-state*))
"Solves a given and valid 15 puzzle and returns the shortest path to reach the
goal state."
(print-state initial-state)
(multiple-value-bind (result time)
(timing (multiple-value-bind (path steps)
(a* initial-state :goal-state goal-state)
(print-path path)
steps))
(format t "Found the shortest path in ~D steps and ~3,2F seconds~%" result time))
(print-state goal-state))

22
Task/15-puzzle-solver/F-Sharp/15-puzzle-solver-1.fs Normal file
View file

@ -0,0 +1,22 @@
// A Naive 15 puzzle solver using no memory. Nigel Galloway: October 6th., 2017
let Nr,Nc = [|3;0;0;0;0;1;1;1;1;2;2;2;2;3;3;3|],[|3;0;1;2;3;0;1;2;3;0;1;2;3;0;1;2|]
type G= |N |I |G |E |L
type N={i:uint64;g:G list;e:int;l:int}
let fN n=let g=(11-n.e)*4 in let a=n.i&&&(15UL<<<g)
{i=n.i-a+(a<<<16);g=N::n.g;e=n.e+4;l=n.l+(if Nr.[int(a>>>g)]<=n.e/4 then 0 else 1)}
let fI i=let g=(19-i.e)*4 in let a=i.i&&&(15UL<<<g)
{i=i.i-a+(a>>>16);g=I::i.g;e=i.e-4;l=i.l+(if Nr.[int(a>>>g)]>=i.e/4 then 0 else 1)}
let fG g=let l=(14-g.e)*4 in let a=g.i&&&(15UL<<<l)
{i=g.i-a+(a<<<4) ;g=G::g.g;e=g.e+1;l=g.l+(if Nc.[int(a>>>l)]<=g.e%4 then 0 else 1)}
let fE e=let l=(16-e.e)*4 in let a=e.i&&&(15UL<<<l)
{i=e.i-a+(a>>>4) ;g=E::e.g;e=e.e-1;l=e.l+(if Nc.[int(a>>>l)]>=e.e%4 then 0 else 1)}
let fL=let l=[|[I;E];[I;G;E];[I;G;E];[I;G];[N;I;E];[N;I;G;E];[N;I;G;E];[N;I;G];[N;I;E];[N;I;G;E];[N;I;G;E];[N;I;G];[N;E];[N;G;E];[N;G;E];[N;G];|]
(fun n g->List.except [g] l.[n] |> List.map(fun n->match n with N->fI |I->fN |G->fE |E->fG))
let solve n g l=let rec solve n=match n with // n is board, g is pos of 0, l is max depth
|n when n.i =0x123456789abcdef0UL->Some(n.g)
|n when n.l>l ->None
|g->let rec fN=function h::t->match solve h with None->fN t |n->n
|_->None
fN (fL g.e (List.head n.g)|>List.map(fun n->n g))
solve {i=n;g=[L];e=g;l=0}
let n = Seq.collect fN n

4
Task/15-puzzle-solver/F-Sharp/15-puzzle-solver-2.fs Normal file
View file

@ -0,0 +1,4 @@
let test n g=match [1..15]|>Seq.tryPick(solve n g) with
Some n->n|>List.rev|>List.iter(fun n->printf "%c" (match n with N->'d'|I->'u'|G->'r'|E->'l'|L->'\u0000'));printfn " (%n moves)" (List.length n)
|_ ->printfn "No solution found"
test 0xfe169b4c0a73d852UL 8

65
Task/15-puzzle-solver/Forth/15-puzzle-solver.fth Normal file
View file

@ -0,0 +1,65 @@
#! /usr/bin/gforth
cell 8 <> [if] s" 64-bit system required" exception throw [then]
\ In the stack comments below,
\ "h" stands for the hole position (0..15),
\ "s" for a 64-bit integer representing a board state,
\ "t" a tile value (0..15, 0 is the hole),
\ "b" for a bit offset of a position within a state,
\ "m" for a masked value (4 bits selected out of a 64-bit state),
\ "w" for a weight of a current path,
\ "d" for a direction constant (0..3)
\ Utility
: 3dup 2 pick 2 pick 2 pick ;
: 4dup 2over 2over ;
: shift dup 0 > if lshift else negate rshift then ;
hex 123456789abcdef0 decimal constant solution
: row 2 rshift ; : col 3 and ;
: up-valid? ( h -- f ) row 0 > ;
: down-valid? ( h -- f ) row 3 < ;
: left-valid? ( h -- f ) col 0 > ;
: right-valid? ( h -- f ) col 3 < ;
: up-cost ( h t -- 0|1 ) 1 - row swap row < 1 and ;
: down-cost ( h t -- 0|1 ) 1 - row swap row > 1 and ;
: left-cost ( h t -- 0|1 ) 1 - col swap col < 1 and ;
: right-cost ( h t -- 0|1 ) 1 - col swap col > 1 and ;
\ To iterate over all possible directions, put direction-related functions into arrays:
: ith ( u addr -- w ) swap cells + @ ;
create valid? ' up-valid? , ' left-valid? , ' right-valid? , ' down-valid? , does> ith execute ;
create cost ' up-cost , ' left-cost , ' right-cost , ' down-cost , does> ith execute ;
create step -4 , -1 , 1 , 4 , does> ith ;
\ Advance from a single state to another:
: bits ( h -- b ) 15 swap - 4 * ;
: tile ( s b -- t ) rshift 15 and ;
: new-state ( s h d -- s' ) step dup >r + bits 2dup tile ( s b t ) swap lshift tuck - swap r> 4 * shift + ;
: new-weight ( w s h d -- w' ) >r tuck r@ step + bits tile r> cost + ;
: advance ( w s h d -- w s h w' s' h' ) 4dup new-weight >r 3dup new-state >r step over + 2r> rot ;
\ Print a solution:
: rollback 2drop drop ;
: .dir ( u -- ) s" d..r.l..u" drop 4 + swap + c@ emit ;
: .dirs ( .. -- ) 0 begin >r 3 pick -1 <> while 3 pick over - .dir rollback r> 1+ repeat r> ;
: win cr ." solved (read right-to-left!): " .dirs ." - " . ." moves" bye ;
\ The main recursive function for depth-first search:
create limit 1 , : deeper 1 limit +! ;
: u-turn ( .. h2 w1 s1 h1 ) 4 pick 2 pick - ;
: search ( .. h2 w1 s1 h1 )
over solution = if win then
2 pick limit @ > if exit then
4 0 do dup i valid? if i step u-turn <> if i advance recurse rollback then then loop ;
\ Iterative-deepening search:
: solve 1 limit ! begin search deeper again ;
\ -1 0 hex 0c9dfbae37254861 decimal 0 solve \ uhm.
-1 0 hex fe169b4c0a73d852 decimal 8 solve \ the 52 moves case
\ -1 0 hex 123456789afbde0c decimal 14 solve \ some trivial case, 3 moves
bye

5
Task/15-puzzle-solver/Fortran/15-puzzle-solver-1.f Normal file
View file

@ -0,0 +1,5 @@
IF (NR.EQ.4) THEN
code specialised for NR = 4
ELSE IF (NR.EQ.3) THEN
code specialised for NR = 3
END IF

529
Task/15-puzzle-solver/Fortran/15-puzzle-solver-2.f Normal file
View file

@ -0,0 +1,529 @@
SUBROUTINE PROUST(T) !Remembrance of time passed.
DOUBLE PRECISION T !The time, in seconds. Positive only, please.
DOUBLE PRECISION S !A copy I can mess with.
TYPE TIMEWARP !Now prepare a whole lot of trickery for expressing the wait time.
INTEGER LIMIT !The upper limit for the usage.
INTEGER STEP !Conversion to the next unit.
CHARACTER*4 NAME !A suitable abbreviated name for the accepted unit.
END TYPE TIMEWARP !Enough of this.
INTEGER CLOCKCRACK !How many different units might I play with?
PARAMETER (CLOCKCRACK = 5) !This should so.
TYPE(TIMEWARP) TIME(CLOCKCRACK) !One set, please.
PARAMETER (TIME = (/ !The mention of times lost has multiple registers.
1 TIMEWARP(99, 60,"secs"), !Beware 99.5+ rounding up to 100.
2 TIMEWARP(99, 60,"mins"), !Likewise with minutes.
3 TIMEWARP(66, 24,"hrs!"), !More than a few days might as well be in days.
4 TIMEWARP(99,365,"days"), !Too many days, and we will speak of years.
5 TIMEWARP(99,100,"yrs!")/)) !And the last gasp converts to centuries.
INTEGER CC !A stepper for these selections.
CHARACTER*4 U !The selected unit.
INTEGER MSG !The mouthpiece.
COMMON/IODEV/ MSG !Used in common.
S = T !A working copy.
DO CC = 1,CLOCKCRACK !Now re-assess DT, with a view to announcing a small number.
IF (S.LE.TIME(CC).LIMIT) THEN !Too big a number?
U = TIME(CC).NAME !No, this unit will suffice.
GO TO 10 !Make off to use it.
END IF !But if the number is too big,
S = S/TIME(CC).STEP !Escalate to the next larger unit.
END DO !And see if that will suffice.
U = "Cys!!" !In case there are too many years, this is the last gasp.
10 WRITE (MSG,11) S,U !Say it.
11 FORMAT (F7.1,A4,$) !But don't finish the line.
END SUBROUTINE PROUST !A sigh.
CHARACTER*15 FUNCTION HMS(T) !Report the time of day.
Careful! Finite precision and binary/decimal/sexagesimal conversion could cause 2:30:00am. to appear as 2:29:60am.
DOUBLE PRECISION S,T !Seconds (completed) into the day.
INTEGER H,M !More traditional units are to be extracted.
INTEGER SECONDSINDAY !A canonical day.
PARAMETER (SECONDSINDAY = 24*60*60) !Of nominal seconds.
CHARACTER*15 TEXT !A scratchpad.
H = T !Truncate into an integer.
S = T - (H - 1)/SECONDSINDAY*SECONDSINDAY !Thus allow for midnight = hour 24.
IF (S.EQ.SECONDSINDAY/2) THEN !This might happen.
TEXT = "High Noon!" !Though the chances are thin.
ELSE IF (S.EQ.SECONDSINDAY) THEN !This is synonymous with the start of the next day.
TEXT = "Midnight!" !So this presumably won't happen.
ELSE !But more likely are miscellaneous values.
H = S/3600 !Convert seconds into whole hours completed.
S = S - H*3600 !The remaining time.
M = S/60 !Seconds into minutes completed.
S = S - M*60 !Remove them.
IF (S .GE. 59.9995D0) THEN !Via format F6.3, will this round up to 60?
S = 0 !Yes. Curse recurring binary sequences for decimal.
M = M + 1 !So, up the minute count.
IF (M.GE.60) THEN !Is there an overflow here too?
M = 0 !Yes.
H = H + 1 !So might appear 24:00:00.000 though it not be Midnight!
END IF !So much for twiddling the minutes.
END IF !And twiddling the hours.
IF (H.LT.12) THEN !A plague on the machine mentality.
WRITE (TEXT,1) H,M,S,"am." !Ante-meridian.
1 FORMAT (I2,":",I2,":",F6.3,A3) !Thus.
ELSE !For the post-meridian, H >= 12.
IF (H.GT.12) H = H - 12 !Adjust to civil usage. NB! 12 appears.
WRITE (TEXT,1) H,M,S,"pm." !Thus. Post-meridian.
END IF !So much for those fiddles.
IF (TEXT(4:4).EQ." ") TEXT(4:4) = "0" !Now help hint that the
IF (TEXT(7:7).EQ." ") TEXT(7:7) = "0" ! character string is one entity.
END IF !So much for preparation.
HMS = TEXT !The result.
END FUNCTION HMS !Possible compiler confusion if HMS is invoked in a WRITE statement.
DOUBLE PRECISION FUNCTION NOWWAS(WOT) !Ascertain the local time for interval assessment.
Compute with whole day numbers, to avoid day rollover annoyances.
Can't use single precision and expect much discrimination within a day.
C I'd prefer a TIMESTAMP(Local) and a TIMESTAMP(GMT) system function.
C Quite likely, the system separates its data to deliver the parameters, which I then re-glue.
INTEGER WOT !What sort of time do I want?
REAL*8 TIME !A real good time.
INTEGER MARK(8) !The computer's clock time will appear here, but fragmented.
IF (WOT.LE.0) THEN !Just the CPU time for this.
CALL CPU_TIME(TIME) !Apparently in seconds since starting.
ELSE !But normally, I want a time-of-day now.
CALL DATE_AND_TIME(VALUES = MARK) !Unpack info that I will repack.
c WRITE (6,1) MARK
c 1 FORMAT ("The computer clock system reports:",
c 1 /"Year",I5,", Month",I3,", Day",I3,
c 2 /" Minutes from GMT",I5,
c 3 /" Hour",I3,", Minute",I3,",Seconds",I3,".",I3)
TIME = (MARK(5)*60 + MARK(6))*60 + MARK(7) + MARK(8)/1000D0 !By the millisecond, to seconds.
IF (WOT.GT.1) TIME = TIME - MARK(4)*60 !Shift back to GMT, which may cross a day boundary.
c TIME = DAYNUM(MARK(1),MARK(2),MARK(3)) + TIME/SECONDSINDAY !The fraction of a day is always less than 1 as MARK(5) is declared < 24.
TIME = MARK(3)*24*60*60 + TIME !Not bothering with DAYNUM, and converting to use seconds rather than days as the unit.
END IF !A simple number, but, multiple trickeries. The GMT shift includes daylight saving's shift...
NOWWAS = TIME !Thus is the finger of time found.
END FUNCTION NOWWAS !But the Hand of Time has already moved on.
MODULE SLIDESOLVE !Collect the details for messing with the game board.
INTEGER NR,NC,N !Give names to some sizes.
PARAMETER (NR = 4, NC = 4, N = NR*NC) !The shape of the board.
INTEGER*1 BOARD(N),TARGET(N),ZERO(N) !Some scratchpads.
INTEGER BORED(4) !A re-interpretation of the storage containing the BOARD.
CHARACTER*(N) BOAR !Another, since the INDEX function only accepts these.
EQUIVALENCE (BORED,BOARD,BOAR) !All together now!
CHARACTER*1 DIGIT(0:35) !This will help to translate numbers to characters.
PARAMETER (DIGIT = (/"0","1","2","3","4","5","6","7","8","9",
1 "A","B","C","D","E","F","G","H","I","J", !I don't anticipate going beyond 15.
2 "K","L","M","N","O","P","Q","R","S","T", !But, for completeness...
3 "U","V","W","X","Y","Z"/)) !Add a few more.
CONTAINS
SUBROUTINE SHOW(NR,NC,BOARD) !The layout won't work for NC > 99...
INTEGER NR,NC !Number of rows and columns.
INTEGER*1 BOARD(NC,NR) !The board is stored transposed, in Furrytran!
INTEGER R,C !Steppers.
INTEGER MSG !Keep the compiler quiet.
COMMON/IODEV/ MSG !I talk to the trees...
WRITE (MSG,1) (C,C = 1,NC) !Prepare a heading.
1 FORMAT ("Row|",9("__",I1,:),90("_",I2,:)) !This should suffice.
DO R = 1,NR !Chug down the rows, for each showing a succession of columns.
WRITE (MSG,2) R,BOARD(1:NC,R) !Thus, successive elements of storage. Storage style is BOARD(column,row).
2 FORMAT (I3,"|",99I3) !Could use parameters, but enough.
END DO !Show columns across and rows down, despite the storage order.
END SUBROUTINE SHOW !Remember to transpose the array an odd number of times.
SUBROUTINE UNCRAM(IT,BOARD) !Recover the board layout..
INTEGER IT(2) !Two 32-bit integers hold 16 four-bit fields in a peculiar order.
INTEGER*1 BOARD(*) !This is just a simple, orderly sequence of integers.
INTEGER I,HIT !Assistants.
DO I = 0,8,8 !Unpack into the work BOARD.
HIT = IT(I/8 + 1) !Grab eight positions, in four bits each..
BOARD(I + 5) = IAND(HIT,15) !The first is position 5.
HIT = ISHFT(HIT,-4); BOARD(I + 1) = IAND(HIT,15) !Hex 48372615
HIT = ISHFT(HIT,-4); BOARD(I + 6) = IAND(HIT,15) !and C0BFAE9D
HIT = ISHFT(HIT,-4); BOARD(I + 2) = IAND(HIT,15) !For BOARD(1) = 1, BOARD(2) = 2,...
HIT = ISHFT(HIT,-4); BOARD(I + 7) = IAND(HIT,15) !This computer is (sigh) little-endian.
HIT = ISHFT(HIT,-4); BOARD(I + 3) = IAND(HIT,15) !Rather than mess with more loops,
HIT = ISHFT(HIT,-4); BOARD(I + 8) = IAND(HIT,15) !Explicit code is less of a brain strain.
HIT = ISHFT(HIT,-4); BOARD(I + 4) = IAND(HIT,15) !And it should run swiftly, too...
END DO !Only two of them.
END SUBROUTINE UNCRAM !A different-sized board would be a problem too.
INTEGER*8 FUNCTION ZDIST(BOARD) !Encode the board's positions against the ZERO sequence.
INTEGER*1 BOARD(N) !The values of the squares.
LOGICAL*1 AVAIL(N) !The numbers will be used one-by-one to produce ZC.
INTEGER BASE !This is not a constant, such as ten.
INTEGER M,IT !Assistants.
AVAIL = .TRUE. !All numbers are available.
BASE = N !The first square has all choices.
ZDIST = 0 !Start the encodement of choices.
DO M = 1,N !Step through the board's squares.
IT = BOARD(M) !Grab the square's number. It is the index into ZERO.
IF (IT.EQ.0) IT = N !But in ZERO, the zero is at the end, damnit.
AVAIL(IT) = .FALSE. !This number is now used.
ZDIST = ZDIST*BASE + COUNT(AVAIL(1:IT - 1)) !The number of available values to skip to reach it.
BASE = BASE - 1 !Option count for the next time around.
END DO !On to the next square.
END FUNCTION ZDIST !ZDIST(ZERO) = 0.
SUBROUTINE REPORT(R,WHICH,MOVE,BRD) !Since this is invoked in two places.
INTEGER R !The record number of the position.
CHARACTER*(*) WHICH !In which stash.
CHARACTER*1 MOVE !The move code.
INTEGER BRD(2) !The crammed board position.
INTEGER*1 BOARD(N) !Uncrammed for nicer presentation.
INTEGER*8 ZC !Encodes the position in a mixed base.
INTEGER ZM,ZS !Alternate forms of distance.
DOUBLE PRECISION ZE !This is Euclidean.
INTEGER MSG !Being polite about usage,
COMMON/IODEV/MSG !Rather than mysterious constants.
CALL UNCRAM(BRD,BOARD) !Isolate the details.
ZM = MAXVAL(ABS(BOARD - ZERO)) !A norm. |(x,y)| = r gives a square shape.
ZS = SUM(ABS(BOARD - ZERO)) !A norm. |(x,y)| = r gives a diamond shape.
ZE = SQRT(DFLOAT(SUM((BOARD - ZERO)**2))) !A norm. |(x,y)| = r gives a circle.
ZC = ZDIST(BOARD) !Encodement against ZERO.
WRITE (MSG,1) R,WHICH,MOVE,DIGIT(BOARD),ZM,ZS,ZE,ZC !After all that,
1 FORMAT (I11,A6,A5,1X,"|",<NR - 1>(<NC>A1,"/"),<NC>A1,"|", !Show the move and the board
1 2I8,F12.3,I18) !Plus four assorted distances.
END SUBROUTINE REPORT !Just one line is produced.
SUBROUTINE PURPLE HAZE(BNAME) !Spreads a red and a blue tide.
CHARACTER*(*) BNAME !Base name for the work files.
CHARACTER*(N) BRAND !Name part based on the board sequence.
CHARACTER*(LEN(BNAME) + 1 + N + 4) FNAME !The full name.
Collect the details for messing with the game board.
CHARACTER*4 TIDE(2) !Two tides will spread forth.
PARAMETER (TIDE = (/" Red","Blue"/)) !With these names.
INTEGER LZ,LOCZ(2),LOCI(2),ZR,ZC !Location via row and column.
EQUIVALENCE(LOCZ(1),ZR),(LOCZ(2),ZC) !Sometimes separate, sometimes together.
INTEGER WAY(4),HENCE,W,M,D,WAYS(2,4) !Direction codes.
PARAMETER (WAY = (/ +1, -NC, -1, +NC/)) !Directions for the zero square, in one dimension.
PARAMETER (WAYS = (/0,+1, -1,0, 0,-1, +1,0/)) !The same, but in (row,column) style.
CHARACTER*1 WNAMEZ(0:4),WNAMEF(0:4) !Names for the directions.
PARAMETER (WNAMEZ = (/" ","R","U","L","D"/)) !The zero square's WAYS.
PARAMETER (WNAMEF = (/" ","L","D","R","U"/)) !The moved square's ways are opposite.
Create two hashed stashes. A stash file and its index file, twice over.
INTEGER APRIME !Determines the size of the index.
PARAMETER (APRIME = 199 999 991) !Prime 11078917. Prime 6666666 = 116 743 349. Perhaps 1999999973?
INTEGER HCOUNT(2),NINDEX(2) !Counts the entries in the stashes and their indices.
INTEGER P,HIT !Fingers to entries in the stash.
INTEGER SLOSH,HNEXT !Advances from one surge to the next.
INTEGER IST(2),LST(2),SURGE(2) !Define the perimeter of a surge.
INTEGER HEAD,LOOK !For chasing along a linked-list of records.
TYPE AREC !Stores the board position, and helpful stuff.
INTEGER NEXT !Links to the next entry that has the same hash value.
INTEGER PREV !The entry from which this position was reached.
INTEGER MOVE !By moving the zero in this WAY.
INTEGER BRD(2) !Squeezed representation of the board position.
END TYPE AREC !Greater compaction (especially of MOVE) would require extra crunching.
INTEGER LREC !Record length, in INTEGER-size units. I do some counting.
PARAMETER (LREC = 5) !For the OPEN statement.
TYPE(AREC) ASTASH,APROBE !I need two scratchpads.
INTEGER NCHECK !Number of new positions considered.
INTEGER NLOOK(2),PROBES(2),NP(2),MAXP(2)!Statistics for the primary and secondary searches resulting.
LOGICAL SURGED(2) !A SLOSH might not result in a SURGE.
Catch the red/blue meetings, if any.
INTEGER MANY,LONG !They may be many, and, long.
PARAMETER (MANY = 666,LONG = 66) !This should do.
INTEGER NMET,MET(2,MANY) !Identify the meeting positions, in their own stash.
INTEGER NTRAIL,TRAIL(LONG) !Needed to follow the moves.
INTEGER NS,LS(MANY) !Count the shove sequences.
CHARACTER*128 SHOVE(MANY) !Record them.
Conglomeration of support stuff.
LOGICAL EXIST !For testing the presence of a disc file.
INTEGER I,IT !Assistants.
DOUBLE PRECISION T1,T2,E1,E2,NOWWAS !Time details.
CHARACTER*15 HMS !A clock.
INTEGER MSG,KBD,WRK(2),NDX(2) !I/O unit numbers.
COMMON/IODEV/ MSG,KBD,WRK,NDX !I talk to the trees...
NS = 0 !No shove sequences have been found.
Concoct some disc files for storage areas, reserving the first record of each as a header.
10 BOARD = ZERO !The red tide spreads from "zero".
DO W = 1,2 !Two work files are required.
WRITE(MSG,11) TIDE(W) !Which one this time?
11 FORMAT (/,"Tide ",A) !Might as well supply a name.
DO I = 1,N !Produce a text sequence for the board layout.
BRAND(I:I) = DIGIT(BOARD(I)) !One by one...
END DO !BRAND = DIGIT(BOARD)
FNAME = BNAME//"."//BRAND//".dat" !It contains binary stuff, so what else but data?
INQUIRE (FILE = FNAME, EXIST = EXIST) !Perhaps it is lying about.
20 IF (EXIST) THEN !Well?
WRITE (MSG,*) "Restarting from file ",FNAME !One hopes its content is good.
OPEN (WRK(W),FILE = FNAME,STATUS = "OLD",ACCESS = "DIRECT", !Random access is intended.
1 FORM = "UNFORMATTED",BUFFERED = "YES",RECL = LREC) !Using record numbers as the key.
FNAME = BNAME//"."//BRAND//".ndx" !Now go for the accomplice.
INQUIRE (FILE = FNAME, EXIST = EXIST) !That contains the index.
IF (.NOT.EXIST) THEN !Well?
WRITE (MSG,*) " ... except, no file ",FNAME !Oh dear.
CLOSE(WRK(W)) !So, no index for the work file. Abandon it.
GO TO 20 !And thus jump into the ELSE clause below.
END IF !Seeing as an explicit GO TO would be regarded as improper...
READ (WRK(W),REC = 1) HCOUNT(W),SURGE(W),IST(W),LST(W)!Get the header information.
WRITE (MSG,22) HCOUNT(W),SURGE(W),IST(W),LST(W) !Reveal.
22 FORMAT (" Stashed ",I0,". At surge ",I0, !Perhaps it will be corrupt.
1 " with the boundary stashed in elements ",I0," to ",I0) !If so, this might help the reader.
OPEN (NDX(W),FILE = FNAME,STATUS = "OLD",ACCESS="DIRECT", !Now for the accomplice.
1 FORM = "UNFORMATTED",BUFFERED = "YES",RECL = 1) !One INTEGER per record.
READ(NDX(W), REC = 1) NINDEX(W) !This count is maintained, to avoid a mass scan.
WRITE (MSG,23) NINDEX(W),APRIME !Exhibit the count.
23 FORMAT (" Its index uses ",I0," of ",I0," entries.") !Simple enough.
ELSE !But, if there is no stash, create a new one.
WRITE (MSG,*) "Preparing a stash in file ",FNAME !Start from scratch.
OPEN (WRK(W),FILE = FNAME,STATUS="REPLACE",ACCESS="DIRECT", !I intend non-sequential access...
1 FORM = "UNFORMATTED",BUFFERED = "YES",RECL = LREC) !And, not text.
HCOUNT(W) = 1 !Just one position is known, the final position.
SURGE(W) = 0 !It has not been clambered away from.
IST(W) = 1 !The first to inspect at the current level.
LST(W) = 1 !The last.
WRITE (WRK(W),REC = 1) HCOUNT(W),SURGE(W),IST(W),LST(W),0 !The header.
FNAME = BNAME//"."//BRAND//".ndx" !Now for the associated index file..
WRITE (MSG,*) "... with an index in file ",FNAME !Announce before attempting access.
OPEN (NDX(W),FILE = FNAME,STATUS = "REPLACE",ACCESS= !Lest there be a mishap.
1 "DIRECT",FORM = "UNFORMATTED",BUFFERED = "YES",RECL = 1) !Yep. Just one value per record.
WRITE (MSG,*) APRIME," zero values for an empty index." !This may cause a pause.
NINDEX(W) = 1 !The index will start off holding one used entry.
WRITE (NDX(W),REC = 1) NINDEX(W) !Save this count in the header record.
WRITE (NDX(W),REC = 1 + APRIME) 0 !Zero values will also appear in the gap!
ASTASH.NEXT = 0 !The first index emtry can never collide with another in an empty index.
ASTASH.PREV = 0 !And it is created sufficient unto itself.
ASTASH.MOVE = 0 !Thus, it is not a descendant, but immaculate.
ASTASH.BRD(1) = BORED(1)*16 + BORED(2) !Only four bits of the eight supplied are used.
ASTASH.BRD(2) = BORED(3)*16 + BORED(4) !So interleave them, pairwise.
SLOSH = ASTASH.BRD(1)*ASTASH.BRD(2) !Mash the bits together.
HIT = ABS(MOD(SLOSH,APRIME)) + 2 !Make a hash. Add one since MOD starts with zero.
WRITE (NDX(W),REC = HIT) HCOUNT(W) !Adding another one to dodge the header as well.
WRITE (MSG,24) BOARD,BORED,ASTASH.BRD, !Reveal the stages.
1 SLOSH,SLOSH,SLOSH,APRIME,HIT !Of the mostly in-place reinterpretations.
24 FORMAT (<N>Z2," is the board layout in INTEGER*1",/, !Across the columns and down the rows.
1 4Z8," is the board layout in INTEGER*4",/, !Reinterpret as four integers.
2 2(8X,Z8)," ..interleaved into two INTEGER*4",/, !Action: Interleaved into two.
3 Z32," multiplied together in INTEGER*4",/, !Action: Their product.
4 I32," as a decimal integer.",/, !Abandoning hexadecimal.
5 "ABS(MOD(",I0,",",I0,")) + 2 = ",I0, !The final step.
6 " is the record number for the first index entry.") !The result.
WRITE (WRK(W),REC = HCOUNT(W) + 1) ASTASH !Record one is reserved as a header...
END IF !Either way, a workfile should be ready now.
IF (W.EQ.1) BOARD = TARGET !Thus go for the other work file.
END DO !Only two iterations, but a lot of blather.
SLOSH = MINVAL(SURGE,DIM = 1) !Find the laggard.
Cast forth a heading for the progress table to follow..
WRITE (MSG,99)
99 FORMAT (/,7X,"|",3X,"Tidewrack Boundary Positions |",
1 6X,"Positions",5X,"|",7X,"Primary Probes",9X,"Index Use",
2 4X,"|",5X,"Secondary Probes",3X,"|"," Memory of Time Passed",/,
3 "Surge",2X,"|",6X,"First",7X,"Last",6X,"Count|",
4 4X,"Checked Deja vu%|",7X,"Made Max.L Avg.L| Used%",
5 5X,"Load%|",7X,"Made Max.L Avg.L|",6X,"CPU",8X,"Clock")
Chase along the boundaries of the red and the blue tides, each taking turns as primary and secondary interests.
100 SLOSH = SLOSH + 1 !Another advance begins.
WW:DO W = 1,2 !The advance is made in two waves, each with its own statistics.
M = 3 - W !Finger the other one.
NMET = 0 !No meetings have happened yet.
IF (SURGE(W).GE.SLOSH) CYCLE WW !Prefer to proceed with matched surges.
WRITE (MSG,101) SLOSH,TIDE(W),IST(W),LST(W),LST(W)-IST(W)+1 !The boundary to be searched.
101 FORMAT (I2,1X,A4,"|",3I11,"|",$) !This line will be continued.
NCHECK = 0 !No new positions have been prepared.
NLOOK = 0 !So the stashes have not been searched for any of them.
PROBES = 0 !And no probes have been made in any such searches.
MAXP = 0 !So the maximum length of all probe chains is zero so far.
HNEXT = LST(W) + 1 !This will be where the first new position will be stashed.
T1 = NOWWAS(0) !Note the accumulated CPU time at the start of the boundary ride..
E1 = NOWWAS(2) !Time of day, in seconds. GMT style (thus not shifted by daylight saving)
PP:DO P = IST(W),LST(W) !These are on the edge of the tide. Spreading proceeds.
READ (WRK(W),REC = P + 1) ASTASH !Obtain a position, remembering to dodge the header record.
HENCE = ASTASH.MOVE !The move (from ASTASH.PREV) that reached this position.
IF (HENCE.NE.0) HENCE = MOD(HENCE + 1,4) + 1 !The reverse of that direction. Only once zero. Sigh.
CALL UNCRAM(ASTASH.BRD,BOARD) !Unpack into the work BOARD.
LZ = INDEX(BOAR,CHAR(0)) !Find the BOARD square with zero.
ZR = (LZ - 1)/NC + 1 !Convert to row and column in LOCZ to facilitate bound checking.
ZC = MOD(LZ - 1,NC) + 1 !Two divisions, sigh. Add a special /\ syntax? (ZR,ZC) = (LZ - 1)/\NC + 1
Consider all possible moves from position P, If a new position is unknown, add it to the stash.
DD:DO D = 1,4 !Step through the possible directions in which the zero square might move.
IF (D.EQ.HENCE) CYCLE DD !Don't try going back whence this came.
LOCI = LOCZ + WAYS(1:2,D) !Finger the destination of the zero square, (row,column) style.
IF (ANY(LOCI.LE.0)) CYCLE DD !No wrapping left/right or top/bottom.
IF (ANY(LOCI.GT.(/NR,NC/))) CYCLE DD !No .OR. to avoid the possibility of non-shortcut full evaluation.
NCHECK = NCHECK + 1 !So, here is another position to inspect.
NP = 0 !No probes of stashes W or M for it have been made.
IT = WAY(D) + LZ !Finger the square that is to move to the adjacent zero.
BOARD(LZ) = BOARD(IT) !Move that square's content to the square holding the zero.
BOARD(IT) = 0 !It having departed.
ASTASH.BRD(1) = BORED(1)*16 + BORED(2) !Pack the position list
ASTASH.BRD(2) = BORED(3)*16 + BORED(4) !Without fussing over adjacency,
HIT = ABS(MOD(ASTASH.BRD(1)*ASTASH.BRD(2),APRIME)) + 2 !Crunch the hash index.
READ (NDX(W),REC = HIT) HEAD !Refer to the index, which fingers the first place to look.
LOOK = HEAD !This may be the start of a linked-list.
IF (LOOK.EQ.0) NINDEX(W) = NINDEX(W) + 1 !Or, a new index entry will be made.
IF (LOOK.NE.0) NLOOK(1) = NLOOK(1) + 1 !Otherwise, we're looking at a linked-list, hopefully short.
DO WHILE (LOOK.NE.0) !Is there a stash entry to look at?
NP(1) = NP(1) + 1 !Yes. Count a probe of the W stash.
READ (WRK(W),REC = LOOK + 1) APROBE !Do it. (Dodging the header record)
IF (ALL(ASTASH.BRD.EQ.APROBE.BRD)) GO TO 109 !Already seen? Ignore all such as previously dealt with.
LOOK = APROBE.NEXT !Perhaps there follows another entry having the same index.
END DO !And eventually, if there was no matching entry,
HCOUNT(W) = HCOUNT(W) + 1 !A new entry is to be added to stash W, linked from its index.
IF (HCOUNT(W).LE.0) STOP "HCOUNT overflows!" !Presuming the usual two's complement style.
WRITE (NDX(W),REC = HIT) HCOUNT(W) !The index now fingers the new entry in ASTASH.
ASTASH.NEXT = HEAD !Its follower is whatever the index had fingered before.
ASTASH.PREV = P !This is the position that led to it.
ASTASH.MOVE = D !Via this move.
WRITE (WRK(W),REC = HCOUNT(W) + 1) ASTASH !Place the new entry, dodging the header.
Check the other stash for this new position. Perhaps there, a meeting will be found!
READ (NDX(M),REC = HIT) LOOK !The other stash uses the same hash function but has its own index.
IF (LOOK.NE.0) NLOOK(2) = NLOOK(2) + 1 !Perhaps stash M has something to look at.
DO WHILE(LOOK.NE.0) !Somewhere along a linked-list.
NP(2) = NP(2) + 1 !A thorough look may involve multiple probes.
READ(WRK(M),REC = LOOK + 1) APROBE !Make one.
IF (ALL(ASTASH.BRD.EQ.APROBE.BRD)) THEN!A match?
IF (NMET.LT.MANY) THEN !Yes! Hopefully, not too many already.
NMET = NMET + 1 !Count another.
MET(W,NMET) = HCOUNT(W) !Save a finger to the new entry.
MET(M,NMET) = LOOK !And to its matching counterparty.
ELSE !But if too numerous for my list,
WRITE (MSG,108) TIDE(W),HCOUNT(W),TIDE(M),LOOK !Announce each.
108 FORMAT ("Can't save ",A,1X,I0," matching ",A,1X,I0)!Also wrecking my tabular layout.
END IF !So much for recording a match.
GO TO 109 !Look no further for the new position; it is found..
END IF !So much for a possible match.
LOOK = APROBE.NEXT !Chase along the linked-list.
END DO !Thus checking all those hashing to the same index.
Completed the probe.
109 MAXP = MAX(MAXP,NP) !Track the maximum number of probes in any search..
PROBES = PROBES + NP !As well as their count.
BOARD(IT) = BOARD(LZ) !Finally, undo the move.
BOARD(LZ) = 0 !To be ready for the next direction.
END DO DD !Consider another direction.
END DO PP !Advance P to the next spreading possibility.
Completed one perimeter sequence. Cast forth some statistics.
110 T2 = NOWWAS(0) !A boundary patrol has been completed.
E2 = NOWWAS(2) !And time has passed.
HIT = HCOUNT(W) - HNEXT + 1 !The number of new positions to work from in the next layer.
WRITE (MSG,111) NCHECK,100.0*(NCHECK - HIT)/NCHECK, !Tested, and %already seen
1 NLOOK(1),MAXP(1),FLOAT(PROBES(1))/MAX(NLOOK(1),1), !Search statistics.
2 100.0*NINDEX(W)/APRIME,100.0*HCOUNT(W)/APRIME, !Index occupancy: used entries, and load.
3 NLOOK(2),MAXP(2),FLOAT(PROBES(2))/MAX(NLOOK(2),1) !Other stash's search statistics.
111 FORMAT (I11,F9.2,"|",I11,I6,F7.3,"|",F8.3,F10.3,"|", !Attempt to produce regular columns.
1 I11,I6,F7.3,"|"$) !To be continued...
T1 = T2 - T1 !Thus, how much CPU time was used perusing the perimeter.
E1 = E2 - E1 !Over the elapsed time.
CALL PROUST(T1) !Muse over the elapsed CPU time, in seconds.
CALL PROUST(E1) !And likewise the elapsed clock time.
E2 = NOWWAS(1) !Civil clock, possibly adjusted for daylight saving.
IF (E1.LE.0) THEN !The offered timing may be too coarse.
WRITE (MSG,112) HMS(E2) !So, just finish the line.
112 FORMAT (8X,A) !With a time of day.
ELSE !But if some (positive) clock time was measured as elapsing,
WRITE (MSG,113) T1/E1*100,HMS(E2) !Offer a ratio as well.
113 FORMAT (F6.2,"%",1X,A) !Percentages are usual.
END IF !Enough annotation.
Could there be new positions to check? HCOUNT will have been increased if so.
SURGED(W) = HCOUNT(W).GE.HNEXT !The boundary has been extended to new positions.
IF (SURGED(W)) THEN !But, are there any new positions?
IST(W) = HNEXT !Yes. The first new position would have been placed here.
LST(W) = HCOUNT(W) !This is where the last position was placed.
SURGE(W) = SLOSH !The new surge is ready.
WRITE (WRK(W),REC = 1) HCOUNT(W),SURGE(W),IST(W),LST(W) !Update the headers correspondingly..
WRITE (NDX(W), REC = 1) NINDEX(W) !Otherwise, a rescan would be needed on a restart.
ELSE IF (SURGE(W) + 1 .EQ. SLOSH) THEN !No new positions. First encounter?
LOOK = LST(W) - IST(W) + 1 !Yes. How many dead ends are there?
WRITE (MSG,114) LOOK !Announce.
114 FORMAT (/,"The boundary has not surged to new positions!",/
1 "The now-static boundary has ",I0)
LOOK = LOOK/666 + 1 !If there are many, don't pour forth every one.
IF (LOOK.GT.1) WRITE (MSG,115) LOOK!Some restraint.
115 FORMAT (6X,"... Listing step: ",I0)!Rather than rolling forth a horde.
WRITE (MSG,121) !Re-use the heading for the REPORT.
DO P = IST(W),LST(W),LOOK !Step through the dead ends, possibly sampling every one.
READ (WRK(W),REC = P + 1) ASTASH !Grab a position.
CALL REPORT(P,TIDE(W),WNAMEF(ASTASH.MOVE),ASTASH.BRD) !Describe it.
END DO !On to the next dead end.
END IF !Perhaps the universe has been filled.
Could the clouds have touched? If so, two trails have met.
120 ML:DO P = 1,NMET !Step through the meeting list.
IF (NS.LT.MANY) NS = NS + 1!Note another shove sequence.
LS(NS) = 0 !Details to be determined.
WRITE (MSG,121) !Announce, via a heading.
121 FORMAT (/,5X,"Record Stash Move |Board layout by row|", !Various details
1 2X,"Max|d| Sum|d| Euclidean Encoded vs Zero") !Will be attached.
NTRAIL = 1 !Every trail starts with its first step.
TRAIL(1) = MET(2,P) !This is the blue trail's position that met the red tide..
122 READ(WRK(2),REC = TRAIL(NTRAIL) + 1) ASTASH !Obtain details
IF (ASTASH.PREV.NE.0) THEN !Had this step arrived from somewhere?
IF (NTRAIL.GE.LONG) STOP "The trail is too long!" !Yes.
NTRAIL = NTRAIL + 1 !Count another step.
TRAIL(NTRAIL) = ASTASH.PREV !Finger the preceding step.
GO TO 122 !And investigate it in turn.
END IF !Thus follow the blue trail back to its origin.
130 DO LOOK = NTRAIL,1,-1 !The end of the blue trail is the position in TARGET, the start position.
READ(WRK(2),REC = TRAIL(LOOK) + 1) ASTASH !Grab a position, dodging the header.
CALL REPORT(TRAIL(LOOK),"Blue",WNAMEF(ASTASH.MOVE), !Backwards*backwards = forwards.
1 ASTASH.BRD) !The board layout is always straightforward...
IF (LOOK.NE.NTRAIL) THEN !The start position has no move leading to it.
IF (LS(NS).LT.LEN(SHOVE(1))) LS(NS) = LS(NS) + 1 !But count all subsequent ssociated moves.
SHOVE(NS)(LS(NS):LS(NS)) = WNAMEF(ASTASH.MOVE) !Place it.
END IF !So much for that move.
END DO !On to the next move away from the start position.
140 HEAD = 0 !Syncopation. Prevent the first position of the red trail from being listed.
LOOK = MET(1,P) !It is the same position as the first in the TRAIL, but in the primary stash.
DO WHILE(LOOK.NE.0) !The red chain runs back to its starting position, which is the "solution" state..
READ(WRK(1),REC = LOOK + 1) ASTASH !Which is in the direction I want to list.
IF (HEAD.NE.0) THEN !Except that the moves are one step behind for this list.
CALL REPORT(LOOK,"Red",WNAMEZ(HEAD),ASTASH.BRD) !As this sequence is not being reversed.
IF (LS(NS).LT.LEN(SHOVE(1))) LS(NS) = LS(NS) + 1 !This lists the moves in forwards order.
SHOVE(NS)(LS(NS):LS(NS)) = WNAMEZ(HEAD) !But the directions are reversed....
END IF !This test avoids listing the "Red" position that is the same as the last "Blue" position.
HEAD = ASTASH.MOVE !This is the move that led to this position.
LOOK = ASTASH.PREV !From the next position, which will be listed next.
END DO !Thus, the listed position was led to by the previous position's move.
150 DO I = 1,NS - 1 !Perhaps the move sequence has been found already.
IF (SHOVE(I)(1:LS(I)).EQ.SHOVE(NS)(1:LS(NS))) THEN !So, compare agains previous shoves.
WRITE (MSG,151) I !It has been seen.
151 FORMAT (6X,"... same as for sequence ",I0) !Humm.
NS = NS - 1 !Eject the arriviste.
GO TO 159 !And carry on.
END IF !This shouldn't happen...
END DO !On to the next comparison.
WRITE (MSG,152) LS(NS),SHOVE(NS)(1:LS(NS)) !Show the moves along a line.
152 FORMAT (I4," moves: ",A) !Surely plural? One-steps wouldn't be tried?
159 END DO ML !Perhaps another pair of snakes have met.
END DO WW !Advance W to the other one. M will be swapped correspondingly.
Could there be an end to it all?
IF (.NOT.ANY(SURGED)) STOP "No progress!" !Oh dear.
IF (NMET.LE.0) GO TO 100 !Keep right on to the end of the road...
END SUBROUTINE PURPLE HAZE !That was fun!
END MODULE SLIDESOLVE
PROGRAM POKE
USE SLIDESOLVE
CHARACTER*(19) FNAME !A base name for some files.
INTEGER I,R,C !Some steppers.
INTEGER MSG,KBD,WRK(2),NDX(2) !I/O unit numbers.
COMMON/IODEV/ MSG,KBD,WRK,NDX !I talk to the trees..
KBD = 5 !Standard input. (Keyboard)
MSG = 6 !Standard output.(Display screen)
WRK = (/10,12/) !I need two work files,
NDX = WRK + 1 !Each with its associated index.
WRITE (FNAME,1) NR,NC !Now prepare the file name.
1 FORMAT ("SlideSolveR",I1,"C",I1,".txt") !Allowing for variation, somewhat.
WRITE (MSG,2) NR,NC,FNAME !Announce.
2 FORMAT ("To play 'slide-square' with ",I0," rows and ",
1 I0," columns.",/,"An initial layout will be read from file ",
2 A,/,"The objective is to attain the nice orderly layout"
3 " as follows:",/)
FORALL(I = 1:N - 1) ZERO(I) = I !Regard the final or "solution" state as ZERO.
ZERO(N) = 0 !The zero sqiuare is at the end, damnit!
CALL SHOW(NR,NC,ZERO) !Show the squares in their "solved" arrangement: the "Red" stash.
OPEN(WRK(1),FILE=FNAME,STATUS="OLD",ACTION="READ") !For formatted input.
DO R = 1,NR !Chug down the rows, reading successive columns across a row..
READ (WRK(1),*) (TARGET((R - 1)*NC + C), C = 1,NC) !Into successive storage locations.
END DO !Furrytran's storage order is (column,row) for that, alas.
CLOSE (WRK(1)) !A small input, but much effort follows.
WRITE (MSG,3) !Now show the supplied layout.
3 FORMAT (/,"The starting position:") !The target, working backwards.
CALL SHOW(NR,NC,TARGET) !This will be the starting point for the "Blue" stash.
IF (ALL(TARGET.EQ.BOARD)) STOP "Huh? They're the same!" !Surely not.
WRITE (MSG,4)
4 FORMAT (/'The plan is to spread a red tide from the "solved" ',
1 "layout and a blue tide from the specified starting position.",/
2 "The hope is that these floods will meet at some position,",
3 " and the blue moves plus the red moves in reverse order,",/
4 "will be the shortest sequence from the given starting",
5 " position to the solution.")
CALL PURPLE HAZE(FNAME(1:14))
END

242
Task/15-puzzle-solver/Go/15-puzzle-solver.go Normal file
View file

@ -0,0 +1,242 @@
package main
import "fmt"
var (
Nr = [16]int{3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3}
Nc = [16]int{3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2}
)
var (
n, _n int
N0, N3, N4 [85]int
N2 [85]uint64
)
const (
i = 1
g = 8
e = 2
l = 4
)
func fY() bool {
if N2[n] == 0x123456789abcdef0 {
return true
}
if N4[n] <= _n {
return fN()
}
return false
}
func fZ(w int) bool {
if w&i > 0 {
fI()
if fY() {
return true
}
n--
}
if w&g > 0 {
fG()
if fY() {
return true
}
n--
}
if w&e > 0 {
fE()
if fY() {
return true
}
n--
}
if w&l > 0 {
fL()
if fY() {
return true
}
n--
}
return false
}
func fN() bool {
switch N0[n] {
case 0:
switch N3[n] {
case 'l':
return fZ(i)
case 'u':
return fZ(e)
default:
return fZ(i + e)
}
case 3:
switch N3[n] {
case 'r':
return fZ(i)
case 'u':
return fZ(l)
default:
return fZ(i + l)
}
case 1, 2:
switch N3[n] {
case 'l':
return fZ(i + l)
case 'r':
return fZ(i + e)
case 'u':
return fZ(e + l)
default:
return fZ(l + e + i)
}
case 12:
switch N3[n] {
case 'l':
return fZ(g)
case 'd':
return fZ(e)
default:
return fZ(e + g)
}
case 15:
switch N3[n] {
case 'r':
return fZ(g)
case 'd':
return fZ(l)
default:
return fZ(g + l)
}
case 13, 14:
switch N3[n] {
case 'l':
return fZ(g + l)
case 'r':
return fZ(e + g)
case 'd':
return fZ(e + l)
default:
return fZ(g + e + l)
}
case 4, 8:
switch N3[n] {
case 'l':
return fZ(i + g)
case 'u':
return fZ(g + e)
case 'd':
return fZ(i + e)
default:
return fZ(i + g + e)
}
case 7, 11:
switch N3[n] {
case 'd':
return fZ(i + l)
case 'u':
return fZ(g + l)
case 'r':
return fZ(i + g)
default:
return fZ(i + g + l)
}
default:
switch N3[n] {
case 'd':
return fZ(i + e + l)
case 'l':
return fZ(i + g + l)
case 'r':
return fZ(i + g + e)
case 'u':
return fZ(g + e + l)
default:
return fZ(i + g + e + l)
}
}
}
func fI() {
g := (11 - N0[n]) * 4
a := N2[n] & uint64(15<<uint(g))
N0[n+1] = N0[n] + 4
N2[n+1] = N2[n] - a + (a << 16)
N3[n+1] = 'd'
N4[n+1] = N4[n]
cond := Nr[a>>uint(g)] <= N0[n]/4
if !cond {
N4[n+1]++
}
n++
}
func fG() {
g := (19 - N0[n]) * 4
a := N2[n] & uint64(15<<uint(g))
N0[n+1] = N0[n] - 4
N2[n+1] = N2[n] - a + (a >> 16)
N3[n+1] = 'u'
N4[n+1] = N4[n]
cond := Nr[a>>uint(g)] >= N0[n]/4
if !cond {
N4[n+1]++
}
n++
}
func fE() {
g := (14 - N0[n]) * 4
a := N2[n] & uint64(15<<uint(g))
N0[n+1] = N0[n] + 1
N2[n+1] = N2[n] - a + (a << 4)
N3[n+1] = 'r'
N4[n+1] = N4[n]
cond := Nc[a>>uint(g)] <= N0[n]%4
if !cond {
N4[n+1]++
}
n++
}
func fL() {
g := (16 - N0[n]) * 4
a := N2[n] & uint64(15<<uint(g))
N0[n+1] = N0[n] - 1
N2[n+1] = N2[n] - a + (a >> 4)
N3[n+1] = 'l'
N4[n+1] = N4[n]
cond := Nc[a>>uint(g)] >= N0[n]%4
if !cond {
N4[n+1]++
}
n++
}
func fifteenSolver(n int, g uint64) {
N0[0] = n
N2[0] = g
N4[0] = 0
}
func solve() {
if fN() {
fmt.Print("Solution found in ", n, " moves: ")
for g := 1; g <= n; g++ {
fmt.Printf("%c", N3[g])
}
fmt.Println()
} else {
n = 0
_n++
solve()
}
}
func main() {
fifteenSolver(8, 0xfe169b4c0a73d852)
solve()
}

214
Task/15-puzzle-solver/Julia/15-puzzle-solver.julia Normal file
View file

@ -0,0 +1,214 @@
const Nr = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
const Nc = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]
const N0 = zeros(Int, 85)
const N2 = zeros(UInt64, 85)
const N3 = zeros(UInt8, 85)
const N4 = zeros(Int, 85)
const i = 1
const g = 8
const ee = 2
const l = 4
const _n = Vector{Int32}([0])
function fY(n::Int)
if N2[n + 1] == UInt64(0x123456789abcdef0)
return true, n
end
if N4[n + 1] <= _n[1]
return fN(n)
end
false, n
end
function fZ(w, n)
if w & i > 0
n = fI(n)
(y, n) = fY(n)
if y return (true, n) end
n -= 1
end
if w & g > 0
n = fG(n)
(y, n) = fY(n)
if y return (true, n) end
n -= 1
end
if w & ee > 0
n = fE(n)
(y, n) = fY(n)
if y return (true, n) end
n -= 1
end
if w & l > 0
n = fL(n)
(y, n) = fY(n)
if y return (true, n) end
n -= 1
end
false, n
end
function fN(n::Int)
x = N0[n + 1]
y = UInt8(N3[n + 1])
if x == 0
if y == UInt8('l')
return fZ(i, n)
elseif y == UInt8('u')
return fZ(ee, n)
else
return fZ(i + ee, n)
end
elseif x == 3
if y == UInt8('r')
return fZ(i, n)
elseif y == UInt8('u')
return fZ(l, n)
else
return fZ(i + l, n)
end
elseif x == 1 || x == 2
if y == UInt8('l')
return fZ(i + l, n)
elseif y == UInt8('r')
return fZ(i + ee, n)
elseif y == UInt8('u')
return fZ(ee + l, n)
else
return fZ(l + ee + i, n)
end
elseif x == 12
if y == UInt8('l')
return fZ(g, n)
elseif y == UInt8('d')
return fZ(ee, n)
else
return fZ(ee + g, n)
end
elseif x == 15
if y == UInt8('r')
return fZ(g, n)
elseif y == UInt8('d')
return fZ(l, n)
else
return fZ(g + l, n)
end
elseif x == 13 || x == 14
if y == UInt8('l')
return fZ(g + l, n)
elseif y == UInt8('r')
return fZ(ee + g, n)
elseif y == UInt8('d')
return fZ(ee + l, n)
else
return fZ(g + ee + l, n)
end
elseif x == 4 || x == 8
if y == UInt8('l')
return fZ(i + g, n)
elseif y == UInt8('u')
return fZ(g + ee, n)
elseif y == UInt8('d')
return fZ(i + ee, n)
else
return fZ(i + g + ee, n)
end
elseif x == 7 || x == 11
if y == UInt8('d')
return fZ(i + l, n)
elseif y == UInt8('u')
return fZ(g + l, n)
elseif y == UInt8('r')
return fZ(i + g, n)
else
return fZ(i + g + l, n)
end
else
if y == UInt8('d')
return fZ(i + ee + l, n)
elseif y == UInt8('l')
return fZ(i + g + l, n)
elseif y == UInt8('r')
return fZ(i + g + ee, n)
elseif y == UInt8('u')
return fZ(g + ee + l, n)
else
return fZ(i + g + ee + l, n)
end
end
end
function fI(n)
gg = (11 - N0[n + 1]) * 4
a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
N0[n + 2] = N0[n + 1] + 4
N2[n + 2] = N2[n + 1] - a + (a << 16)
N3[n + 2] = UInt8('d')
N4[n + 2] = N4[n + 1]
cond = Nr[(a >> gg) + 1] <= div(N0[n + 1], 4)
if !cond
N4[n + 2] += 1
end
n += 1
n
end
function fG(n)
gg = (19 - N0[n + 1]) * 4
a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
N0[n + 2] = N0[n + 1] - 4
N2[n + 2] = N2[n + 1] - a + (a >> 16)
N3[n + 2] = UInt8('u')
N4[n + 2] = N4[n + 1]
cond = Nr[(a >> gg) + 1] >= div(N0[n + 1], 4)
if !cond
N4[n + 2] += 1
end
n += 1
n
end
function fE(n)
gg = (14 - N0[n + 1]) * 4
a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
N0[n + 2] = N0[n + 1] + 1
N2[n + 2] = N2[n + 1] - a + (a << 4)
N3[n + 2] = UInt8('r')
N4[n + 2] = N4[n + 1]
cond = Nc[(a >> gg) + 1] <= N0[n + 1] % 4
if !cond
N4[n + 2] += 1
end
n += 1
n
end
function fL(n)
gg = (16 - N0[n + 1]) * 4
a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
N0[n + 2] = N0[n + 1] - 1
N2[n + 2] = N2[n + 1] - a + (a >> 4)
N3[n + 2] = UInt8('l')
N4[n + 2] = N4[n + 1]
cond = Nc[(a >> gg) + 1] >= N0[n + 1] % 4
if !cond
N4[n + 2] += 1
end
n += 1
n
end
function solve(n)
ans, n = fN(n)
if ans
println("Solution found in $n moves: ")
for ch in N3[2:n+1] print(Char(ch)) end; println()
else
println("next iteration, _n[1] will be $(_n[1] + 1)...")
n = 0; _n[1] += 1; solve(n)
end
end
run() = (N0[1] = 8; _n[1] = 1; N2[1] = 0xfe169b4c0a73d852; solve(0))
run()

224
Task/15-puzzle-solver/Lua/15-puzzle-solver-1.lua Normal file
View file

@ -0,0 +1,224 @@
#!/usr/bin/lua
--[[
Solve 3X3 sliding tile puzzle using Astar on Lua. Requires 3mb and
millions of recursions.
by RMM 2020-may-1
]]--
local SOLUTION_LIMIT, MAX_F_VALUE = 100,100
local NR, NC, RCSIZE = 4,4,4*4
local Up, Down, Right, Left = 'u','d','r','l'
local G_cols = {} -- goal columns
local G_rows = {} -- goal rows
local C_cols = {} -- current cols
local C_rows = {} -- current rows
local Goal = {}
local Tiles = {} -- the puzzle
local Solution = {} -- final path is instance of desc
local desc = {} -- descending path
desc[0] = 0 -- override Lua default "1" index
-- @brief create C compatible array for Lua
local function Amake( list )
array = {}
for i=0, #list do
array[i] = list[i+1] -- simulate "C" array in Lua
end
return array
end
G_cols= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
G_rows= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
C_cols= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
C_rows= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
Tiles = Amake({ 15,14,1,6, 9,11,4,12, 0,10,7,3, 13,8,5,2,} )
Goal = Amake({1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0,} )
local m1 = {recursions=0, found=0, threshold=0, times=0, steps=0,}
-- ---------------------------------------------------------------
-- return 1D array index given 2D row,column
local function rcidx( row, col )
return (row * NR + col)
end
-- @brief recursive search
-- @return f_score
local function search( depth, x_row, x_col, h_score)
local move, go_back_move, last_move_by_current
local f_score, ix, min, temp, hscore2, idx1
local N_minus_one = NR - 1;
local rc1 = {row=0,col=0}
local rc2 = {row=0,col=0}
local gtmp = {row=0,col=0}
f_score = depth + h_score;
if f_score > m1.threshold then return f_score end
if h_score == 0 then do
m1.found = 1
Solution = table.concat(desc)
return f_score end end
m1.recursions = m1.recursions+1
m1.times = m1.times + 1
if m1.times > 200000 then do
print("Recursions ",m1.recursions)
m1.times = 0
end end
min = 999999
last_move_by_current = desc[depth];
rc1.row = x_row;
rc1.col = x_col;
for ix = 0,3 do
if ix==0 then do
move = Up;
go_back_move = Down;
rc2.row = x_row - 1;
rc2.col = x_col;
end
elseif ix==1 then do
move = Down;
go_back_move = Up;
rc2.row = x_row + 1;
rc2.col = x_col;
end
elseif ix==2 then do
move = Left;
go_back_move = Right;
rc2.row = x_row;
rc2.col = x_col - 1;
end
elseif ix==3 then do
move = Right;
go_back_move = Left;
rc2.row = x_row;
rc2.col = x_col + 1;
end end
if move==Up and x_row==0 then goto next end
if move==Down and x_row==N_minus_one then goto next end
if move==Left and x_col==0 then goto next end
if move==Right and x_col==N_minus_one then goto next end
if last_move_by_current==go_back_move then goto next end
hscore2 = h_score
idx1 = Tiles[rcidx(rc2.row,rc2.col)]
gtmp.row = G_rows[idx1]
gtmp.col = G_cols[idx1]
local h_adj=0
if go_back_move==Up then do
if gtmp.row < C_rows[idx1] then
h_adj = -1 else h_adj = 1 end end
end
if go_back_move==Down then do
if gtmp.row > C_rows[idx1] then
h_adj = -1 else h_adj = 1 end end
end
if go_back_move==Left then do
if gtmp.col < C_cols[idx1] then
h_adj = -1 else h_adj = 1 end end
end
if go_back_move==Right then do
if gtmp.col > C_cols[idx1] then
h_adj = -1 else h_adj = 1 end end
end
hscore2 = hscore2 + h_adj
C_rows[0] = rc2.row;
C_cols[0] = rc2.col;
C_rows[idx1] = rc1.row;
C_cols[idx1] = rc1.col;
Tiles[rcidx(rc1.row,rc1.col)] = idx1;
Tiles[rcidx(rc2.row,rc2.col)] = 0;
desc[depth+1] = move
desc[depth+2] = '\0'
temp = search(depth+1, rc2.row, rc2.col, hscore2); -- descend
-- regress
Tiles[rcidx(rc1.row,rc1.col)] = 0
Tiles[rcidx(rc2.row,rc2.col)] = idx1
desc[depth+1] = '\0'
C_rows[0] = rc1.row;
C_cols[0] = rc1.col;
C_rows[idx1] = rc2.row;
C_cols[idx1] = rc2.col;
if m1.found == 1 then return temp end
if temp < min then min = temp end
::next:: -- Lua does not have "continue;" so uses goto
end -- end for
m1.found = 0;
-- return the minimum f_score greater than m1.threshold
return min;
end
-- @brief Run solver using A-star algorithm
-- @param Tiles .. 3X3 sliding tile puzzle
local function solve(Tiles)
local temp, i,j
local x_row, x_col, h_score = 0,0,0
m1.found = 0;
for i=0,(NR-1) do
for j=0, (NC-1) do
G_rows[ Goal[rcidx(i,j)] ] = i;
G_cols[ Goal[rcidx(i,j)] ] = j;
C_rows[ Tiles[rcidx(i,j)] ] = i;
C_cols[ Tiles[rcidx(i,j)] ] = j;
end
end
for i=0,(NR-1) do
for j=0, (NC-1) do
if Tiles[rcidx(i,j)] == 0 then do
x_row = i;
x_col = j;
break;
end
end
end
end
desc[0] = '$'
desc[1] = '\0'
h_score = 0; -- Manhattan/Taxicab heuristic
for i = 1,(RCSIZE-1) do
h_score = h_score + (math.abs(C_rows[i] - G_rows[i]) +
math.abs(C_cols[i] - G_cols[i]))
end
m1.threshold = h_score
print("solve -> search")
while true do
temp = search( 0, x_row, x_col, h_score);
if m1.found == 1 then do
print("Gound solution of length",#Solution-1)
print(Solution)
break;
end end
if temp > MAX_F_VALUE then do
print("Maximum f value reached! terminating! \n");
break; end
end
m1.threshold = temp;
end -- while
return 0
end
-- show sliding tile puzzle rows and columns
local function print_tiles( pt)
local i,j,num
for i=0,(NR-1) do
for j=0, (NC-1) do
num = pt[rcidx(i,j)]
io.write(string.format("%02d ", num))
end
print("")
end
print("")
end
-- main(void) {
print("Solve sliding 15 tile puzzle");
m1.recursions = 0
m1.times=0
print_tiles(Tiles);
print_tiles(Goal)
solve(Tiles);

203
Task/15-puzzle-solver/Lua/15-puzzle-solver-2.lua Normal file
View file

@ -0,0 +1,203 @@
----------
-- SOLVER
----------
local table_concat = table.concat -- local alias
local function Solver(root, h, successors)
local pathlist, pathhash, iters
-- it is required that "h(node)" returns:
-- 0 when "is_goal(node)==true"
-- >0 when "is_goal(node)==false"
-- (because it allows for some simplification herein)
local FOUND = 0 -- ie: "is_goal(node)==true"
local NOT_FOUND = 1e9 -- some number larger than largest possible f
local function hash(node)
return table_concat(node,",")
end
local function search(g, bound)
iters = iters + 1
--if ((iters % 1000000) == 0) then print("iterations:", iters) end
local node = pathlist[#pathlist]
local h = h(node)
local f = g + h
if (f > bound) then return f end
if (h == FOUND) then return FOUND end
local min = NOT_FOUND
for succ, cost in successors(node) do
local succhash = hash(succ)
if (not pathhash[succhash]) then
pathlist[#pathlist+1], pathhash[succhash] = succ, true
local t = search(g+cost, bound)
if (t == FOUND) then return FOUND end
if (t < min) then min = t end
pathlist[#pathlist], pathhash[succhash] = nil, nil
end
end
return min
end
return {
solve = function()
pathlist = { root }
pathhash = { [hash(root)] = true }
iters = 0
local bound = h(root)
while true do
bound = search(0, bound)
if (bound == FOUND) then return bound, iters, pathlist end
if (bound == NOT_FOUND) then return bound, iters, nil end
end
end
}
end
------------------
-- DOMAIN SUPPORT
------------------
local i2c = { [0]=0, 1,2,3,4, 1,2,3,4, 1,2,3,4, 1,2,3,4 } -- convert index to column
local i2r = { [0]=0, 1,1,1,1, 2,2,2,2, 3,3,3,3, 4,4,4,4 } -- convert index to row
local R, U, L, D = 1, -4, -1, 4 -- move indexing values
local movenames = { -- move names
[0]="", [R]="r", [U]="u", [L]="l", [D]="d"
}
local succmoves = { -- successor directions
{R,D}, {R,L,D}, {R,L,D}, {L,D},
{R,U,D}, {R,U,L,D}, {R,U,L,D}, {U,L,D},
{R,U,D}, {R,U,L,D}, {R,U,L,D}, {U,L,D},
{R,U}, {R,U,L}, {R,U,L}, {U,L}
}
local manhdists = { -- manhattan distances
{ [0]=0, 0, 1, 2, 3, 1, 2, 3, 4, 2, 3, 4, 5, 3, 4, 5, 6 },
{ [0]=0, 1, 0, 1, 2, 2, 1, 2, 3, 3, 2, 3, 4, 4, 3, 4, 5 },
{ [0]=0, 2, 1, 0, 1, 3, 2, 1, 2, 4, 3, 2, 3, 5, 4, 3, 4 },
{ [0]=0, 3, 2, 1, 0, 4, 3, 2, 1, 5, 4, 3, 2, 6, 5, 4, 3 },
{ [0]=0, 1, 2, 3, 4, 0, 1, 2, 3, 1, 2, 3, 4, 2, 3, 4, 5 },
{ [0]=0, 2, 1, 2, 3, 1, 0, 1, 2, 2, 1, 2, 3, 3, 2, 3, 4 },
{ [0]=0, 3, 2, 1, 2, 2, 1, 0, 1, 3, 2, 1, 2, 4, 3, 2, 3 },
{ [0]=0, 4, 3, 2, 1, 3, 2, 1, 0, 4, 3, 2, 1, 5, 4, 3, 2 },
{ [0]=0, 2, 3, 4, 5, 1, 2, 3, 4, 0, 1, 2, 3, 1, 2, 3, 4 },
{ [0]=0, 3, 2, 3, 4, 2, 1, 2, 3, 1, 0, 1, 2, 2, 1, 2, 3 },
{ [0]=0, 4, 3, 2, 3, 3, 2, 1, 2, 2, 1, 0, 1, 3, 2, 1, 2 },
{ [0]=0, 5, 4, 3, 2, 4, 3, 2, 1, 3, 2, 1, 0, 4, 3, 2, 1 },
{ [0]=0, 3, 4, 5, 6, 2, 3, 4, 5, 1, 2, 3, 4, 0, 1, 2, 3 },
{ [0]=0, 4, 3, 4, 5, 3, 2, 3, 4, 2, 1, 2, 3, 1, 0, 1, 2 },
{ [0]=0, 5, 4, 3, 4, 4, 3, 2, 3, 3, 2, 1, 2, 2, 1, 0, 1 },
{ [0]=0, 6, 5, 4, 3, 5, 4, 3, 2, 4, 3, 2, 1, 3, 2, 1, 0 },
}
--- create a state from a pattern, optionally applying a move
local function state(patt, move)
local node = {}
for k,v in pairs(patt) do node[k] = v end
if (move) then
local e = node.e
local ep = e + move
node[e], node[ep] = node[ep], 0
node.e, node.m = ep, move
end
return node
end
--- iterator for successors of node
local function successors(node)
local moves = succmoves[node.e]
local i, n = 0, #moves
return function()
i = i + 1
if (i <= n) then
return state(node, moves[i]), 1
end
end
end
--- hueristic estimate of travel cost from node to goal
local function h(node)
local sum, ijx, jix, t = 0, 1, 1
for i = 1, 4 do
local colmax, rowmax = 0, 0
for j = 1, 4 do
t = node[ijx]
sum = sum + manhdists[ijx][t] -- manhattan
if (i2r[t] == i) then -- row conflicts
if (t > rowmax) then rowmax=t else sum=sum+2 end
end
t = node[jix]
if (i2c[t] == i) then -- col conflicts
if (t > colmax) then colmax=t else sum=sum+2 end
end
ijx, jix = ijx+1, jix+4
end
jix = jix - 15
end
return sum
end
------------------
-- PRINT SUPPORT:
------------------
local function printnode(node)
print("+--+--+--+--+")
for i = 0, 12, 4 do
print( string.format("|%2d|%2d|%2d|%2d|", node[i+1], node[i+2], node[i+3], node[i+4]) )
print("+--+--+--+--+")
end
end
local function printpath(path)
-- note that #path is 1 longer than solution due to root node at path[1]
-- concatenated result will be correct length since movenames[root.m]==""
local t = {}
for i, node in ipairs(path) do
t[i] = movenames[node.m]
end
local pathstr = table_concat(t)
print("SOLUTION: " .. pathstr .. " (length: " .. #pathstr .. ")")
end
---------
-- TASKS:
---------
-- goal is implied by h(), never actually used (see solver's notes)
-- local goal = state({ 1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0, e=16, m=0 })
do
print("PRIMARY TASK (OPTIMALLY)")
local sclock = os.clock()
local root = state({ 15,14,1,6, 9,11,4,12, 0,10,7,3, 13,8,5,2, e=9, m=0 })
printnode(root)
local solver = Solver(root, h, successors)
local bound, iters, path = solver:solve()
printpath(path)
printnode(path[#path])
print("ITERATIONS: " .. iters)
print("ELAPSED: " .. (os.clock()-sclock) .. "s")
end
print()
do
print("EXTRA CREDIT TASK (APPROXIMATELY, NON-OPTIMALLY)")
-- only primary task specifies "fewest possible moves"
-- extra credit task only specifies "solve", so..
local sclock = os.clock()
local root = state({ 0,12,9,13, 15,11,10,14, 3,7,2,5, 4,8,6,1, e=1, m=0 })
printnode(root)
local function hec(node)
-- overweighting h makes it not admissible,
-- causing solver to favor g when minimizing,
-- leading to non-optimal (but much easier to find!) solutions
return h(node)*1.5
end
local solver = Solver(root, hec, successors)
local bound, iters, path = solver:solve()
printpath(path) --> 86, optimal solution is known to be 80
printnode(path[#path])
print("ITERATIONS: " .. iters)
print("ELAPSED: " .. (os.clock()-sclock) .. "s")
end

140
Task/15-puzzle-solver/Nim/15-puzzle-solver-1.nim Normal file
View file

@ -0,0 +1,140 @@
# 15 puzzle.
import strformat
import times
const
Nr = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
Nc = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]
type
Solver = object
n: int
np: int
n0: array[100, int]
n2: array[100, uint64]
n3: array[100, char]
n4: array[100, int]
Value = range[0..15]
# Forward definition.
proc fN(s: var Solver): bool
#---------------------------------------------------------------------------------------------------
proc fI(s: var Solver) =
let n = s.n
let g = (11 - s.n0[n]) * 4
let a = s.n2[n] and uint(15 shl g)
s.n0[n + 1] = s.n0[n] + 4
s.n2[n + 1] = s.n2[n] - a + a shl 16
s.n3[n + 1] = 'd'
s.n4[n + 1] = s.n4[n] + ord(Nr[a shr g] > s.n0[n] div 4)
#---------------------------------------------------------------------------------------------------
proc fG(s: var Solver) =
let n = s.n
let g = (19 - s.n0[n]) * 4
let a = s.n2[n] and uint(15 shl g)
s.n0[n + 1] = s.n0[n] - 4
s.n2[n + 1] = s.n2[n] - a + a shr 16
s.n3[n + 1] = 'u'
s.n4[n + 1] = s.n4[n] + ord(Nr[a shr g] < s.n0[n] div 4)
#---------------------------------------------------------------------------------------------------
proc fE(s: var Solver) =
let n = s.n
let g = (14 - s.n0[n]) * 4
let a = s.n2[n] and uint(15 shl g)
s.n0[n + 1] = s.n0[n] + 1
s.n2[n + 1] = s.n2[n] - a + a shl 4
s.n3[n + 1] = 'r'
s.n4[n + 1] = s.n4[n] + ord(Nc[a shr g] > s.n0[n] mod 4)
#---------------------------------------------------------------------------------------------------
proc fL(s: var Solver) =
let n = s.n
let g = (16 - s.n0[n]) * 4
let a = s.n2[n] and uint(15 shl g)
s.n0[n + 1] = s.n0[n] - 1
s.n2[n + 1] = s.n2[n] - a + a shr 4
s.n3[n + 1] = 'l'
s.n4[n + 1] = s.n4[n] + ord(Nc[a shr g] < s.n0[n] mod 4)
#---------------------------------------------------------------------------------------------------
proc fY(s: var Solver): bool =
if s.n2[s.n] == 0x123456789abcdef0'u:
return true
if s.n4[s.n] <= s.np:
return s.fN()
#---------------------------------------------------------------------------------------------------
proc fN(s: var Solver): bool =
let n = s.n
if s.n3[n] != 'u' and s.n0[n] div 4 < 3:
s.fI
inc s.n
if s.fY(): return true
dec s.n
if s.n3[n] != 'd' and s.n0[n] div 4 > 0:
s.fG()
inc s.n
if s.fY(): return true
dec s.n
if s.n3[n] != 'l' and s.n0[n] mod 4 < 3:
s.fE()
inc s.n
if s.fY(): return true
dec s.n
if s.n3[n] != 'r' and s.n0[n] mod 4 > 0:
s.fL()
inc s.n
if s.fY(): return true
dec s.n
#---------------------------------------------------------------------------------------------------
proc initSolver(values: array[16, Value]): Solver {.noInit.} =
result.n = 0
result.np = 0
result.n0[0] = values.find(0)
result.n2[0] = (var tmp = 0'u; for val in values: tmp = tmp shl 4 or uint(val); tmp)
result.n4[0] = 0
#---------------------------------------------------------------------------------------------------
proc run(s: var Solver) =
while not s.fY():
inc s.np
stdout.write(fmt"Solution found with {s.n} moves: ")
for g in 1..s.n:
stdout.write(s.n3[g])
stdout.write(".\n")
#---------------------------------------------------------------------------------------------------
proc toString(d: Duration): string =
# Custom representation of a duration.
const Plural: array[bool, string] = ["", "s"]
var ms = d.inMilliseconds
for (label, d) in {"hour": 3_600_000, "minute": 60_000, "second": 1_000, "millisecond": 1}:
let val = ms div d
if val > 0:
result.add($val & ' ' & label & Plural[val > 1])
ms = ms mod d
if ms > 0: result.add(' ')

7
Task/15-puzzle-solver/Nim/15-puzzle-solver-2.nim Normal file
View file

@ -0,0 +1,7 @@
let start = getTime()
var solver = initSolver([Value 15, 14, 1, 6,
9, 11, 4, 12,
0, 10, 7, 3,
13, 8, 5, 2])
solver.run()
echo fmt"Execution time: {(getTime() - start).toString}."

7
Task/15-puzzle-solver/Nim/15-puzzle-solver-3.nim Normal file
View file

@ -0,0 +1,7 @@
let start = getTime()
var solver = initSolver([Value 0, 12, 9, 13,
15, 11, 10, 14,
3, 7, 2, 5,
4, 8, 6, 1])
solver.run()
echo fmt"Execution time: {(getTime() - start).toString}."

31
Task/15-puzzle-solver/Pascal/15-puzzle-solver-1.pas Normal file
View file

@ -0,0 +1,31 @@
unit FifteenSolverT;
\\ Solve 15 Puzzle. Nigel Galloway; February 1st., 2019.
interface
type TN=record n:UInt64; i,g,e,l:shortint; end;
type TG=record found:boolean; path:array[0..99] of TN; end;
function solve15(const board : UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
const endPos:UInt64=$123456789abcdef0;
implementation
const N:array[0..15] of shortint=(3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3);
const I:array[0..15] of shortint=(3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2);
const G:array[0..15] of shortint=(5,13,13,9,7,15,15,11,7,15,15,11,6,14,14,10);
const E:array[0..15] of shortint=(0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4);
const L:array[0..4 ] of shortint=(0,11,19,14,16);
function solve15(const board:UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
var path:TG; P:^TN; Q:^TN; _g:shortint; _n:UInt64;
begin P:=@path.path; P^.n:=board; P^.i:=0; P^.g:=0; P^.e:=ng; P^.l:=bPos;
while true do begin
if P<@path.path then begin path.found:=false; exit(path); end;
if P^.n=endPos then begin path.found:=true; exit(path); end;
if (P^.e=0) or (P^.i>d) then begin P-=1; continue; end else begin Q:=P+1; Q^.g:=E[P^.e]; end;
Q^.i:=P^.i; _g:=(L[Q^.g]-P^.l)*4; _n:=P^.n and (UInt64($F)<<_g);
case Q^.g of
1:begin Q^.l:=P^.l+4; Q^.e:=G[Q^.l]-2; P^.e-=1; Q^.n:=P^.n-_n+(_n<<16); if N[_n>>_g]>=(Q^.l div 4) then Q^.i+=1; end;
2:begin Q^.l:=P^.l-4; Q^.e:=G[Q^.l]-1; P^.e-=2; Q^.n:=P^.n-_n+(_n>>16); if N[_n>>_g]<=(Q^.l div 4) then Q^.i+=1; end;
3:begin Q^.l:=P^.l+1; Q^.e:=G[Q^.l]-8; P^.e-=4; Q^.n:=P^.n-_n+(_n<< 4); if I[_n>>_g]>=(Q^.l mod 4) then Q^.i+=1; end;
4:begin Q^.l:=P^.l-1; Q^.e:=G[Q^.l]-4; P^.e-=8; Q^.n:=P^.n-_n+(_n>> 4); if I[_n>>_g]<=(Q^.l mod 4) then Q^.i+=1; end;
end;
P+=1;
end;
end;
end.

31
Task/15-puzzle-solver/Pascal/15-puzzle-solver-2.pas Normal file
View file

@ -0,0 +1,31 @@
// Threaded use of 15 solver Unit. Nigel Galloway; February 1st., 2019.
program testFifteenSolver;
uses {$IFDEF UNIX}cthreads,{$ENDIF}sysutils,strutils,FifteenSolverT;
var Tz:array[0..5] of TThreadID; Tr:array[0..5] of TG; Tc:array[0..5] of shortint; Tw:array[0..5] of shortint;
const N:array[0..4 ] of string=('','d','u','r','l');
const G:array[0..15] of string=('41','841','841','81','421','8421','8421','821','421','8421','8421','821','42','842','842','82');
var ip:string; x,y:UInt64; P,Q:^TN; bPos,v,w,z,f:shortint; time1, time2: TDateTime; c:char;
function T(a:pointer):ptrint;
begin
Tr[uint32(a)]:=solve15(x,bPos,Tw[uint32(a)],Tc[uint32(a)]);
if Tr[uint32(a)].found then f:=uint32(a);
T:=0;
end;
begin
ReadLn(ip);
bPos:=Npos('0',ip,1)-1; w:=0; z:=0; f:=-1;
y:=(UInt64(Hex2Dec(ip[9..17]))<<32)>>32; x:=UInt64(Hex2Dec(ip[1..8]))<<32+y;
time1:=Now;
for w:=0 to $7f do begin
for c in G[bpos] do begin v:=z mod 6; Tc[v]:=integer(c)-48; Tw[v]:=w;
Tz[v]:=BeginThread(@T,pointer(v));
z+=1; if z>5 then waitforthreadterminate(Tz[z mod 6],$7fff);
end;
if f>=0 then break;
end;
for bpos:=0 to 5 do if Tw[bpos]>=Tw[f] then killthread(Tz[bpos]) else waitforthreadterminate(Tz[bpos],$7fff);
time2:=Now; WriteLn('Solution(s) found in ' + FormatDateTime('hh.mm.ss.zzz', time2-time1) + ' seconds');
for bpos:=0 to 5 do if Tr[bpos].found then begin
P:=@Tr[bpos].path; repeat Q:=P; Write(N[Q^.g]); P+=1; until Q^.n=endpos; WriteLn();
end;
end.

62
Task/15-puzzle-solver/Perl/15-puzzle-solver.pl Normal file
View file

@ -0,0 +1,62 @@
use strict;
no warnings;
use enum qw(False True);
use constant Nr => <3 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3>;
use constant Nc => <3 0 1 2 3 0 1 2 3 0 1 2 3 0 1 2>;
my ($n, $m) = (0, 0);
my(@N0, @N2, @N3, @N4);
sub fY {
printf "Solution found in $n moves: %s\n", join('', @N3) and exit if $N2[$n] == 0x123456789abcdef0;
$N4[$n] <= $m ? fN() : False;
}
sub fN {
sub common { ++$n; return True if fY(); --$n }
if ($N3[$n] ne 'u' and int($N0[$n] / 4) < 3) { fI(); common() }
if ($N3[$n] ne 'd' and int($N0[$n] / 4) > 0) { fG(); common() }
if ($N3[$n] ne 'l' and ($N0[$n] % 4) < 3) { fE(); common() }
if ($N3[$n] ne 'r' and ($N0[$n] % 4) > 0) { fL(); common() }
return False;
}
sub fI {
my $g = (11-$N0[$n])*4;
my $a = $N2[$n] & (15 << $g);
$N0[$n+1] = $N0[$n]+4;
$N2[$n+1] = $N2[$n]-$a+($a<<16);
$N4[$n+1] = $N4[$n]+((Nr)[$a>>$g] <= int($N0[$n] / 4) ? 0 : 1);
$N3[$n+1] = 'd';
}
sub fG {
my $g = (19-$N0[$n])*4;
my $a = $N2[$n] & (15 << $g);
$N0[$n+1] = $N0[$n]-4;
$N2[$n+1] = $N2[$n]-$a+($a>>16);
$N4[$n+1] = $N4[$n]+((Nr)[$a>>$g] >= int($N0[$n] / 4) ? 0 : 1);
$N3[$n+1] = 'u';
}
sub fE {
my $g = (14-$N0[$n])*4;
my $a = $N2[$n] & (15 << $g);
$N0[$n+1] = $N0[$n]+1;
$N2[$n+1] = $N2[$n]-$a+($a<<4);
$N4[$n+1] = $N4[$n]+((Nc)[$a>>$g] <= $N0[$n]%4 ? 0 : 1);
$N3[$n+1] = 'r';
}
sub fL {
my $g = (16-$N0[$n])*4;
my $a = $N2[$n] & (15 << $g);
$N0[$n+1] = $N0[$n]-1;
$N2[$n+1] = $N2[$n]-$a+($a>>4);
$N4[$n+1] = $N4[$n]+((Nc)[$a>>$g] >= $N0[$n]%4 ? 0 : 1);
$N3[$n+1] = 'l';
}
($N0[0], $N2[0]) = (8, 0xfe169b4c0a73d852); # initial state
while () { fY() or ++$m }

152
Task/15-puzzle-solver/Phix/15-puzzle-solver-1.phix Normal file
View file

@ -0,0 +1,152 @@
-->
<span style="color: #000080;font-style:italic;">-- demo\rosetta\Solve15puzzle.exw</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">STM</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- single-tile metrics.</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">MTM</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- multi-tile metrics.</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">STM</span> <span style="color: #008080;">and</span> <span style="color: #000000;">MTM</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?<span style="color: #000000;">9<span style="color: #0000FF;">/<span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- both prohibited
-- 0 0 -- fastest, but non-optimal
-- 1 0 -- optimal in STM
-- 0 1 -- optimal in MTM (slowest by far)
--Note: The fast method uses an inadmissible heuristic - see "not STM" in iddfs().
-- It explores mtm-style using the higher stm heuristic and may therefore
-- fail badly in some cases.</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">SIZE</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">4</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">goal</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">,</span>
<span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,</span>
<span style="color: #000000;">9<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span>
<span style="color: #000000;">13<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">,<span style="color: #000000;">15<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}</span>
<span style="color: #000080;font-style:italic;">--
-- multi-tile-metric walking distance heuristic lookup (mmwd).
-- ==========================================================
-- Uses patterns of counts of tiles in/from row/col, eg the solved state
-- (ie goal above) could be represented by the following:
-- {{4,0,0,0},
-- {0,4,0,0},
-- {0,0,4,0},
-- {0,0,0,3}}
-- ie row/col 1 contains 4 tiles from col/row 1, etc. In this case
-- both are identical, but you can count row/col or col/row, and then
-- add them together. There are up to 24964 possible patterns. The
-- blank space is not counted. Note that a vertical move cannot change
-- a vertical pattern, ditto horizontal, and basic symmetry means that
-- row/col and col/row patterns will match (at least, that is, if they
-- are calculated sympathetically), halving the setup cost.
-- The data is just the number of moves made before this pattern was
-- first encountered, in a breadth-first search, backwards from the
-- goal state, until all patterns have been enumerated.
-- (The same ideas/vars are now also used for stm metrics when MTM=0)
--</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">wdkey</span> <span style="color: #000080;font-style:italic;">-- one such 4x4 pattern</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">mmwd</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- lookup table, data is walking distance.
--
-- We use two to-do lists: todo is the current list, and everything
-- of walkingdistance+1 ends up on tdnx. Once todo is exhausted, we
-- swap the dictionary-ids, so tdnx automatically becomes empty.
-- Key is an mmwd pattern as above, and data is {distance,space_idx}.
--</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">todo</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tdnx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">--</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">UP</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">DOWN</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-<span style="color: #000000;">1</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">explore<span style="color: #0000FF;">(<span style="color: #004080;">integer</span> <span style="color: #000000;">space_idx<span style="color: #0000FF;">,</span> <span style="color: #000000;">walking_distance<span style="color: #0000FF;">,</span> <span style="color: #000000;">direction<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">--
-- Given a space index, explore all the possible moves in direction,
-- setting the distance and extending the tdnx table.
--</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tile_idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">space_idx<span style="color: #0000FF;">+<span style="color: #000000;">direction</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">group<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">SIZE</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">wdkey<span style="color: #0000FF;">[<span style="color: #000000;">tile_idx<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">group<span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000080;font-style:italic;">-- ie: check row tile_idx for tiles belonging to rows 1..4
-- Swap one of those tiles with the space</span>
<span style="color: #000000;">wdkey<span style="color: #0000FF;">[<span style="color: #000000;">tile_idx<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">group<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">wdkey<span style="color: #0000FF;">[<span style="color: #000000;">space_idx<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">group<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">getd_index<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000080;font-style:italic;">-- save the walking distance value</span>
<span style="color: #7060A8;">setd<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">walking_distance<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- and add to the todo next list:</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">getd_index<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">tdnx<span style="color: #0000FF;">)<span style="color: #0000FF;">!=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?<span style="color: #000000;">9<span style="color: #0000FF;">/<span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #7060A8;">setd<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #0000FF;">{<span style="color: #000000;">walking_distance<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">tile_idx<span style="color: #0000FF;">}<span style="color: #0000FF;">,<span style="color: #000000;">tdnx<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">MTM</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">tile_idx<span style="color: #0000FF;">><span style="color: #000000;">1</span> <span style="color: #008080;">and</span> <span style="color: #000000;">tile_idx<span style="color: #0000FF;"><<span style="color: #000000;">SIZE</span> <span style="color: #008080;">then</span>
<span style="color: #000080;font-style:italic;">-- mtm: same direction means same distance:</span>
<span style="color: #000000;">explore<span style="color: #0000FF;">(<span style="color: #000000;">tile_idx<span style="color: #0000FF;">,</span> <span style="color: #000000;">walking_distance<span style="color: #0000FF;">,</span> <span style="color: #000000;">direction<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000080;font-style:italic;">-- Revert the swap so we can look at the next candidate.</span>
<span style="color: #000000;">wdkey<span style="color: #0000FF;">[<span style="color: #000000;">tile_idx<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">group<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">wdkey<span style="color: #0000FF;">[<span style="color: #000000;">space_idx<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">group<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">generate_mmwd<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- Perform a breadth-first search begining with the solved puzzle state
-- and exploring from there until no more new patterns emerge.</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">walking_distance</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">space</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">4</span>
<span style="color: #000000;">wdkey</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #0000FF;">{<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- \</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- } 4 tiles in correct row positions</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- /</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">3<span style="color: #0000FF;">}<span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- 3 tiles in correct row position</span>
<span style="color: #7060A8;">setd<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">walking_distance<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">space<span style="color: #0000FF;"><<span style="color: #000000;">4</span> <span style="color: #008080;">then</span> <span style="color: #000000;">explore<span style="color: #0000FF;">(<span style="color: #000000;">space<span style="color: #0000FF;">,</span> <span style="color: #000000;">walking_distance<span style="color: #0000FF;">,</span> <span style="color: #000000;">UP<span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">space<span style="color: #0000FF;">><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">explore<span style="color: #0000FF;">(<span style="color: #000000;">space<span style="color: #0000FF;">,</span> <span style="color: #000000;">walking_distance<span style="color: #0000FF;">,</span> <span style="color: #000000;">DOWN<span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">dict_size<span style="color: #0000FF;">(<span style="color: #000000;">todo<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">dict_size<span style="color: #0000FF;">(<span style="color: #000000;">tdnx<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #0000FF;">{<span style="color: #000000;">todo<span style="color: #0000FF;">,<span style="color: #000000;">tdnx<span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #000000;">tdnx<span style="color: #0000FF;">,<span style="color: #000000;">todo<span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">wdkey</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd_partial_key<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">todo<span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">{<span style="color: #000000;">walking_distance<span style="color: #0000FF;">,<span style="color: #000000;">space<span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">todo<span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">deld<span style="color: #0000FF;">(<span style="color: #000000;">wdkey<span style="color: #0000FF;">,<span style="color: #000000;">todo<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">walking_distance<span style="color: #0000FF;">(<span style="color: #004080;">sequence</span> <span style="color: #000000;">puzzle<span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">rkey</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">SIZE<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">SIZE<span style="color: #0000FF;">)<span style="color: #0000FF;">,</span>
<span style="color: #000000;">ckey</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">SIZE<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">SIZE<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">SIZE</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- rows</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">SIZE</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- columns</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tile</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">k<span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">tile<span style="color: #0000FF;">!=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">row</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor<span style="color: #0000FF;">(<span style="color: #0000FF;">(<span style="color: #000000;">tile<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">)<span style="color: #0000FF;">/<span style="color: #000000;">4<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">,</span>
<span style="color: #000000;">col</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mod<span style="color: #0000FF;">(<span style="color: #000000;">tile<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">4<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1</span>
<span style="color: #000000;">rkey<span style="color: #0000FF;">[<span style="color: #000000;">i<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">row<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">ckey<span style="color: #0000FF;">[<span style="color: #000000;">j<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">col<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">getd_index<span style="color: #0000FF;">(<span style="color: #000000;">rkey<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0</span>
<span style="color: #008080;">or</span> <span style="color: #7060A8;">getd_index<span style="color: #0000FF;">(<span style="color: #000000;">ckey<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?<span style="color: #000000;">9<span style="color: #0000FF;">/<span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- sanity check</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">rwd</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd<span style="color: #0000FF;">(<span style="color: #000000;">rkey<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)<span style="color: #0000FF;">,</span>
<span style="color: #000000;">cwd</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd<span style="color: #0000FF;">(<span style="color: #000000;">ckey<span style="color: #0000FF;">,<span style="color: #000000;">mmwd<span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">rwd<span style="color: #0000FF;">+<span style="color: #000000;">cwd</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">puzzle</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">t0</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">,</span>
<span style="color: #000000;">t1</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">tries</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ok</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #0000FF;">{<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- left</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- up</span>
<span style="color: #0000FF;">{<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- down</span>
<span style="color: #0000FF;">{<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- right
<!--

142
Task/15-puzzle-solver/Phix/15-puzzle-solver-2.phix Normal file
View file

@ -0,0 +1,142 @@
-->
<span style="color: #008080;">function</span> <span style="color: #000000;">iddfs<span style="color: #0000FF;">(<span style="color: #004080;">integer</span> <span style="color: #000000;">step<span style="color: #0000FF;">,</span> <span style="color: #000000;">lim<span style="color: #0000FF;">,</span> <span style="color: #000000;">space<span style="color: #0000FF;">,</span> <span style="color: #000000;">prevmv<span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">><span style="color: #000000;">t1</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"working... (depth=%d, tries=%d, time=%3ds)\r"<span style="color: #0000FF;">,<span style="color: #0000FF;">{<span style="color: #000000;">lim<span style="color: #0000FF;">,<span style="color: #000000;">tries<span style="color: #0000FF;">,<span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">-<span style="color: #000000;">t0<span style="color: #0000FF;">}<span style="color: #0000FF;">)</span>
<span style="color: #000000;">t1</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">tries</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">d</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">step<span style="color: #0000FF;">==<span style="color: #000000;">lim<span style="color: #0000FF;">?<span style="color: #000000;">0<span style="color: #0000FF;">:<span style="color: #000000;">walking_distance<span style="color: #0000FF;">(<span style="color: #000000;">puzzle<span style="color: #0000FF;">)<span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">d<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(<span style="color: #000000;">puzzle<span style="color: #0000FF;">==<span style="color: #000000;">goal<span style="color: #0000FF;">)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">step<span style="color: #0000FF;">+<span style="color: #000000;">d<span style="color: #0000FF;"><=<span style="color: #000000;">lim</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">mv<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">4</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- l/u/d/r</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">prevmv<span style="color: #0000FF;">!=<span style="color: #0000FF;">(<span style="color: #000000;">5<span style="color: #0000FF;">-<span style="color: #000000;">mv<span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- not l after r or vice versa, ditto u/d</span>
<span style="color: #008080;">and</span> <span style="color: #000000;">ok<span style="color: #0000FF;">[<span style="color: #000000;">mv<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">nspace</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">space<span style="color: #0000FF;">+<span style="color: #0000FF;">{<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #0000FF;">-<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #0000FF;">+<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">}<span style="color: #0000FF;">[<span style="color: #000000;">mv<span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tile</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">nspace<span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]<span style="color: #0000FF;">!=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?<span style="color: #000000;">9<span style="color: #0000FF;">/<span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- sanity check </span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tile</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">nspace<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">iddfs<span style="color: #0000FF;">(<span style="color: #000000;">step<span style="color: #0000FF;">+<span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">MTM</span> <span style="color: #008080;">or</span> <span style="color: #008080;">not</span> <span style="color: #000000;">STM<span style="color: #0000FF;">?<span style="color: #0000FF;">(<span style="color: #000000;">prevmv<span style="color: #0000FF;">!=<span style="color: #000000;">mv<span style="color: #0000FF;">)<span style="color: #0000FF;">:<span style="color: #000000;">1<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">lim<span style="color: #0000FF;">,<span style="color: #000000;">nspace<span style="color: #0000FF;">,<span style="color: #000000;">mv<span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #008000;">"ludr"<span style="color: #0000FF;">[<span style="color: #000000;">mv<span style="color: #0000FF;">]</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">nspace<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tile</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">pack<span style="color: #0000FF;">(<span style="color: #004080;">string</span> <span style="color: #000000;">s<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length<span style="color: #0000FF;">(<span style="color: #000000;">s<span style="color: #0000FF;">)<span style="color: #0000FF;">,</span> <span style="color: #000000;">n0</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">4</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"lrud"<span style="color: #0000FF;">[<span style="color: #000000;">i<span style="color: #0000FF;">]<span style="color: #0000FF;">,</span> <span style="color: #000000;">k</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">match<span style="color: #0000FF;">(<span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #000000;">ch<span style="color: #0000FF;">,<span style="color: #000000;">3<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">s<span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">s<span style="color: #0000FF;">[<span style="color: #000000;">k<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">..<span style="color: #000000;">k<span style="color: #0000FF;">+<span style="color: #000000;">2<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"3"</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">2</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">match<span style="color: #0000FF;">(<span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #000000;">ch<span style="color: #0000FF;">,<span style="color: #000000;">2<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">s<span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k<span style="color: #0000FF;">=<span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">s<span style="color: #0000FF;">[<span style="color: #000000;">k<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'2'</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{<span style="color: #000000;">n<span style="color: #0000FF;">,<span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">MTM<span style="color: #0000FF;">?<span style="color: #7060A8;">sprintf<span style="color: #0000FF;">(<span style="color: #008000;">"%d"<span style="color: #0000FF;">,<span style="color: #000000;">n<span style="color: #0000FF;">)<span style="color: #0000FF;">:<span style="color: #7060A8;">sprintf<span style="color: #0000FF;">(<span style="color: #008000;">"%d(%d)"<span style="color: #0000FF;">,<span style="color: #0000FF;">{<span style="color: #000000;">n<span style="color: #0000FF;">,<span style="color: #000000;">n0<span style="color: #0000FF;">}<span style="color: #0000FF;">)<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">s<span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">apply_moves<span style="color: #0000FF;">(<span style="color: #004080;">string</span> <span style="color: #000000;">moves<span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">space<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">move<span style="color: #0000FF;">,</span> <span style="color: #000000;">ch<span style="color: #0000FF;">,</span> <span style="color: #000000;">nspace</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length<span style="color: #0000FF;">(<span style="color: #000000;">moves<span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">moves<span style="color: #0000FF;">[<span style="color: #000000;">i<span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch<span style="color: #0000FF;">><span style="color: #008000;">'3'</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">move</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find<span style="color: #0000FF;">(<span style="color: #000000;">ch<span style="color: #0000FF;">,<span style="color: #008000;">"ulrd"<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000080;font-style:italic;">-- (hint: "r" -> the 'r' does 1
-- "r2" -> the 'r' does 1, the '2' does 1
-- "r3" -> the 'r' does 1, the '3' does 2!)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1<span style="color: #0000FF;">+<span style="color: #0000FF;">(<span style="color: #000000;">ch<span style="color: #0000FF;">=<span style="color: #008000;">'3'<span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">nspace</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">space<span style="color: #0000FF;">+<span style="color: #0000FF;">{<span style="color: #0000FF;">-<span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">4<span style="color: #0000FF;">}<span style="color: #0000FF;">[<span style="color: #000000;">move<span style="color: #0000FF;">]</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">nspace<span style="color: #0000FF;">]</span>
<span style="color: #000000;">space</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">nspace</span>
<span style="color: #000000;">puzzle<span style="color: #0000FF;">[<span style="color: #000000;">nspace<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">solvable<span style="color: #0000FF;">(<span style="color: #004080;">sequence</span> <span style="color: #000000;">board<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length<span style="color: #0000FF;">(<span style="color: #000000;">board<span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">positions</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">n<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- prepare the mapping from each tile to its position</span>
<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #7060A8;">find<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">board<span style="color: #0000FF;">)<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">positions<span style="color: #0000FF;">[<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">i<span style="color: #0000FF;">]<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000080;font-style:italic;">-- check whether this is an even or odd state</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">row</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor<span style="color: #0000FF;">(<span style="color: #0000FF;">(<span style="color: #000000;">positions<span style="color: #0000FF;">[<span style="color: #000000;">16<span style="color: #0000FF;">]<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">)<span style="color: #0000FF;">/<span style="color: #000000;">4<span style="color: #0000FF;">)<span style="color: #0000FF;">,</span>
<span style="color: #000000;">col</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(<span style="color: #000000;">positions<span style="color: #0000FF;">[<span style="color: #000000;">16<span style="color: #0000FF;">]<span style="color: #0000FF;">-<span style="color: #000000;">1<span style="color: #0000FF;">)<span style="color: #0000FF;">-<span style="color: #000000;">row<span style="color: #0000FF;">*<span style="color: #000000;">4</span>
<span style="color: #004080;">bool</span> <span style="color: #000000;">even_state</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(<span style="color: #000000;">positions<span style="color: #0000FF;">[<span style="color: #000000;">16<span style="color: #0000FF;">]<span style="color: #0000FF;">==<span style="color: #000000;">16<span style="color: #0000FF;">)</span> <span style="color: #008080;">or</span> <span style="color: #0000FF;">(<span style="color: #7060A8;">mod<span style="color: #0000FF;">(<span style="color: #000000;">row<span style="color: #0000FF;">,<span style="color: #000000;">2<span style="color: #0000FF;">)<span style="color: #0000FF;">==<span style="color: #7060A8;">mod<span style="color: #0000FF;">(<span style="color: #000000;">col<span style="color: #0000FF;">,<span style="color: #000000;">2<span style="color: #0000FF;">)<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- count the even cycles</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">even_count</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">visited</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat<span style="color: #0000FF;">(<span style="color: #004600;">false<span style="color: #0000FF;">,<span style="color: #000000;">16<span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i<span style="color: #0000FF;">=<span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">visited<span style="color: #0000FF;">[<span style="color: #000000;">i<span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000080;font-style:italic;">-- a new cycle starts at i. Count its length..</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">cycle_length</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span>
<span style="color: #000000;">next_tile</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span>
<span style="color: #008080;">while</span> <span style="color: #008080;">not</span> <span style="color: #000000;">visited<span style="color: #0000FF;">[<span style="color: #000000;">next_tile<span style="color: #0000FF;">]</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">cycle_length</span> <span style="color: #0000FF;">+=<span style="color: #000000;">1</span>
<span style="color: #000000;">visited<span style="color: #0000FF;">[<span style="color: #000000;">next_tile<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #000000;">next_tile</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">positions<span style="color: #0000FF;">[<span style="color: #000000;">next_tile<span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">even_count</span> <span style="color: #0000FF;">+=</span> <span style="color: #0000FF;">(<span style="color: #7060A8;">mod<span style="color: #0000FF;">(<span style="color: #000000;">cycle_length<span style="color: #0000FF;">,<span style="color: #000000;">2<span style="color: #0000FF;">)<span style="color: #0000FF;">==<span style="color: #000000;">0<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">even_state</span> <span style="color: #0000FF;">==</span> <span style="color: #0000FF;">(<span style="color: #7060A8;">mod<span style="color: #0000FF;">(<span style="color: #000000;">even_count<span style="color: #0000FF;">,<span style="color: #000000;">2<span style="color: #0000FF;">)<span style="color: #0000FF;">==<span style="color: #000000;">0<span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">main<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #000000;">puzzle</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #000000;">15<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">,</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span>
<span style="color: #000000;">9<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span>
<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">,</span>
<span style="color: #000000;">13<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,</span> <span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">}</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">solvable<span style="color: #0000FF;">(<span style="color: #000000;">puzzle<span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?<span style="color: #000000;">puzzle</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"puzzle is not solveable\n"<span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">generate_mmwd<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">original</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">puzzle</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">space</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">puzzle<span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">lim<span style="color: #0000FF;">=<span style="color: #000000;">walking_distance<span style="color: #0000FF;">(<span style="color: #000000;">puzzle<span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">MTM<span style="color: #0000FF;">?<span style="color: #000000;">43<span style="color: #0000FF;">:<span style="color: #000000;">80<span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">iddfs<span style="color: #0000FF;">(<span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">lim<span style="color: #0000FF;">,</span> <span style="color: #000000;">space<span style="color: #0000FF;">,</span> <span style="color: #008000;">'-'<span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #0000FF;">{<span style="color: #004080;">integer</span> <span style="color: #000000;">n<span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">ns<span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">ans<span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pack<span style="color: #0000FF;">(<span style="color: #7060A8;">reverse<span style="color: #0000FF;">(<span style="color: #000000;">res<span style="color: #0000FF;">)<span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"\n\noriginal:"<span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?<span style="color: #000000;">original</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">-<span style="color: #000000;">t0</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"\n%soptimal solution of %s moves found in %s: %s\n\nresult: "<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">MTM<span style="color: #0000FF;">?<span style="color: #008000;">"mtm-"<span style="color: #0000FF;">:<span style="color: #008080;">iff<span style="color: #0000FF;">(<span style="color: #000000;">STM<span style="color: #0000FF;">?<span style="color: #008000;">"stm-"<span style="color: #0000FF;">:<span style="color: #008000;">"non-"<span style="color: #0000FF;">)<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">ns<span style="color: #0000FF;">,<span style="color: #7060A8;">elapsed<span style="color: #0000FF;">(<span style="color: #000000;">t<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">ans<span style="color: #0000FF;">}<span style="color: #0000FF;">)</span>
<span style="color: #000000;">puzzle</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">original</span>
<span style="color: #000000;">apply_moves<span style="color: #0000FF;">(<span style="color: #000000;">ans<span style="color: #0000FF;">,<span style="color: #000000;">space<span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?<span style="color: #000000;">puzzle</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">main<span style="color: #0000FF;">(<span style="color: #0000FF;">)
<!--

129
Task/15-puzzle-solver/Phix/15-puzzle-solver-3.phix Normal file
View file

@ -0,0 +1,129 @@
(phixonline)-->
<span style="color: #000080;font-style:italic;">-- demo/rosetta/Solve15puzzle_simple.exw</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">left<span style="color: #0000FF;">,</span> <span style="color: #000000;">down<span style="color: #0000FF;">,</span> <span style="color: #000000;">up<span style="color: #0000FF;">,</span> <span style="color: #000000;">right</span> <span style="color: #000080;font-style:italic;">-- (nb 5-move flips it, as in down===5-up, etc)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">valid_moves</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #0000FF;">{</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">2<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">3<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">9<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">5<span style="color: #0000FF;">,<span style="color: #000000;">13<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">9<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{<span style="color: #000000;">10<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,<span style="color: #000000;">15<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{<span style="color: #000000;">11<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,<span style="color: #000000;">16<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">9<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{<span style="color: #000000;">13<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">15<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{<span style="color: #000000;">14<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">16<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{<span style="color: #000000;">15<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}<span style="color: #0000FF;">}</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">zero_cost</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #0000FF;">{<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000001111<span style="color: #0000FF;">,<span style="color: #000000;">0b001000100010001<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b110111011101110<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000001111<span style="color: #0000FF;">,<span style="color: #000000;">0b011001100110011<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b100110011001100<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000001111<span style="color: #0000FF;">,<span style="color: #000000;">0b111011101110111<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000100010001000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000001111<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b111111111110000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000011111111<span style="color: #0000FF;">,<span style="color: #000000;">0b001000100010001<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b110111011101110<span style="color: #0000FF;">,<span style="color: #000000;">0b111111111110000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000011111111<span style="color: #0000FF;">,<span style="color: #000000;">0b011001100110011<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b100110011001100<span style="color: #0000FF;">,<span style="color: #000000;">0b111111111110000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000011111111<span style="color: #0000FF;">,<span style="color: #000000;">0b111011101110111<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000100010001000<span style="color: #0000FF;">,<span style="color: #000000;">0b111111111110000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000011111111<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b111111100000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000111111111111<span style="color: #0000FF;">,<span style="color: #000000;">0b001000100010001<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b110111011101110<span style="color: #0000FF;">,<span style="color: #000000;">0b111111100000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000111111111111<span style="color: #0000FF;">,<span style="color: #000000;">0b011001100110011<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b100110011001100<span style="color: #0000FF;">,<span style="color: #000000;">0b111111100000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000111111111111<span style="color: #0000FF;">,<span style="color: #000000;">0b111011101110111<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000100010001000<span style="color: #0000FF;">,<span style="color: #000000;">0b111111100000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000111111111111<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b111000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b001000100010001<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b110111011101110<span style="color: #0000FF;">,<span style="color: #000000;">0b111000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b011001100110011<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b100110011001100<span style="color: #0000FF;">,<span style="color: #000000;">0b111000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b111011101110111<span style="color: #0000FF;">}<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #000000;">0b000100010001000<span style="color: #0000FF;">,<span style="color: #000000;">0b111000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000000<span style="color: #0000FF;">}<span style="color: #0000FF;">}</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">masks</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #000000;">0b000000000000001<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000010<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000000100<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000001000<span style="color: #0000FF;">,</span>
<span style="color: #000000;">0b000000000010000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000000100000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000001000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000000010000000<span style="color: #0000FF;">,</span>
<span style="color: #000000;">0b000000100000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000001000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000010000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b000100000000000<span style="color: #0000FF;">,</span>
<span style="color: #000000;">0b001000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b010000000000000<span style="color: #0000FF;">,<span style="color: #000000;">0b100000000000000<span style="color: #0000FF;">}</span>
<span style="color: #000080;font-style:italic;">-- Or, if you prefer to build those with code (but I really wanted to show the above bitmasks):
--/*
sequence valid_moves = repeat(repeat(0,4),16),
zero_cost = repeat(repeat(0,4),16)
constant masks = sq_power(2,tagset(14,0))
for square=1 to 16 do
integer s_row = floor((square+3)/4),
s_col = remainder((square-1),4)+1
for move=left to right do -- (via up/down)
if (move=left and s_col>1)
or (move=down and s_row>1)
or (move=up and s_row<4)
or (move=right and s_col<4) then
integer origin = square+{-1,-4,+4,+1}[move],
o_row = floor((origin+3)/4),
o_col = remainder((origin-1),4)+1
valid_moves[square][move] = origin
for piece=1 to 15 do -- (aka target)
integer t_row = floor((piece+3)/4),
t_col = remainder((piece-1),4)+1,
p_md = abs(t_row-o_row)+abs(t_col-o_col),
n_md = abs(t_row-s_row)+abs(t_col-s_col)
if n_md<=p_md then
zero_cost[square][move] += masks[piece]
end if
end for
end if
end for
end for
--pp(valid_moves,{pp_IntFmt,"%2d",pp_Maxlen,70})
--pp(zero_cost,{pp_IntFmt,"%015b"})
--pp(masks,{pp_IntFmt,"%015b",pp_IntCh,false})
--*/</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">up</span> <span style="color: #008080;">or</span> <span style="color: #000000;">down</span> <span style="color: #008080;">then</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- (suppress unused warnings, since the above commented out)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">moves</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">board</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{<span style="color: #000000;">15<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">,</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span>
<span style="color: #000000;">9<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span>
<span style="color: #000000;">0<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">,</span>
<span style="color: #000000;">13<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,</span> <span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">}</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">space</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">9</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">goal</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span> <span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">2<span style="color: #0000FF;">,</span> <span style="color: #000000;">3<span style="color: #0000FF;">,</span> <span style="color: #000000;">4<span style="color: #0000FF;">,</span>
<span style="color: #000000;">5<span style="color: #0000FF;">,</span> <span style="color: #000000;">6<span style="color: #0000FF;">,</span> <span style="color: #000000;">7<span style="color: #0000FF;">,</span> <span style="color: #000000;">8<span style="color: #0000FF;">,</span>
<span style="color: #000000;">9<span style="color: #0000FF;">,<span style="color: #000000;">10<span style="color: #0000FF;">,<span style="color: #000000;">11<span style="color: #0000FF;">,<span style="color: #000000;">12<span style="color: #0000FF;">,</span>
<span style="color: #000000;">13<span style="color: #0000FF;">,<span style="color: #000000;">14<span style="color: #0000FF;">,<span style="color: #000000;">15<span style="color: #0000FF;">,</span> <span style="color: #000000;">0<span style="color: #0000FF;">}</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">t1</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">solve<span style="color: #0000FF;">(<span style="color: #004080;">integer</span> <span style="color: #000000;">nfree<span style="color: #0000FF;">,</span> <span style="color: #000000;">space<span style="color: #0000FF;">,</span> <span style="color: #000000;">mdx<span style="color: #0000FF;">=<span style="color: #000000;">1<span style="color: #0000FF;">,</span> <span style="color: #000000;">skip_move<span style="color: #0000FF;">=<span style="color: #000000;">0<span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">--
-- nfree is the number of non-free moves we can yet make
-- space is the location of the space (duh), [1..16]
-- mdx is just the move index for building the solution
-- skip_move significantly narrows search space (1000 or
-- more times faster, believe it or not, simply by not
-- allowing the immediate undoing of the last move)
--</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">move<span style="color: #0000FF;">=<span style="color: #000000;">left</span> <span style="color: #008080;">to</span> <span style="color: #000000;">right</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- (via up/down)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">new_space</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">valid_moves<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">move<span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">move<span style="color: #0000FF;">!=<span style="color: #000000;">skip_move</span> <span style="color: #008080;">and</span> <span style="color: #000000;">new_space</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">piece</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">new_space<span style="color: #0000FF;">]<span style="color: #0000FF;">,</span>
<span style="color: #000000;">zcsmv</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">zero_cost<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]<span style="color: #0000FF;">[<span style="color: #000000;">move<span style="color: #0000FF;">]<span style="color: #0000FF;">,</span>
<span style="color: #000000;">maskp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">masks<span style="color: #0000FF;">[<span style="color: #000000;">piece<span style="color: #0000FF;">]<span style="color: #0000FF;">,</span>
<span style="color: #000000;">zcost</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(<span style="color: #000000;">and_bits<span style="color: #0000FF;">(<span style="color: #000000;">zcsmv<span style="color: #0000FF;">,<span style="color: #000000;">maskp<span style="color: #0000FF;">)<span style="color: #0000FF;">=<span style="color: #000000;">0<span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (0==free, 1==not)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">nfree<span style="color: #0000FF;">>=<span style="color: #000000;">zcost</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">mdx<span style="color: #0000FF;">><span style="color: #7060A8;">length<span style="color: #0000FF;">(<span style="color: #000000;">moves<span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #000000;">moves</span> <span style="color: #0000FF;">&=</span> <span style="color: #008000;">'?'</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000080;font-style:italic;">-- moves[mdx] = "ludr"[move]</span>
<span style="color: #000000;">moves<span style="color: #0000FF;">[<span style="color: #000000;">mdx<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"ludrLUDR"<span style="color: #0000FF;">[<span style="color: #000000;">move<span style="color: #0000FF;">+<span style="color: #000000;">zcost<span style="color: #0000FF;">*<span style="color: #000000;">4<span style="color: #0000FF;">]</span>
<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">piece</span>
<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">new_space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">><span style="color: #000000;">t1</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"%s\r"<span style="color: #0000FF;">,<span style="color: #0000FF;">{<span style="color: #000000;">moves<span style="color: #0000FF;">}<span style="color: #0000FF;">)</span>
<span style="color: #000000;">t1</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">+<span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">space<span style="color: #0000FF;">=<span style="color: #000000;">piece</span> <span style="color: #008080;">and</span> <span style="color: #000000;">board<span style="color: #0000FF;">=<span style="color: #000000;">goal</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">moves</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">moves<span style="color: #0000FF;">[<span style="color: #000000;">1<span style="color: #0000FF;">..<span style="color: #000000;">mdx<span style="color: #0000FF;">]</span> <span style="color: #000080;font-style:italic;">-- (trim)</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">solve<span style="color: #0000FF;">(<span style="color: #000000;">nfree<span style="color: #0000FF;">-<span style="color: #000000;">zcost<span style="color: #0000FF;">,<span style="color: #000000;">new_space<span style="color: #0000FF;">,<span style="color: #000000;">mdx<span style="color: #0000FF;">+<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #000000;">5<span style="color: #0000FF;">-<span style="color: #000000;">move<span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">new_space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">piece</span>
<span style="color: #000000;">board<span style="color: #0000FF;">[<span style="color: #000000;">space<span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">pp<span style="color: #0000FF;">(<span style="color: #000000;">board<span style="color: #0000FF;">,<span style="color: #0000FF;">{<span style="color: #000000;">pp_IntFmt<span style="color: #0000FF;">,<span style="color: #008000;">"%2d"<span style="color: #0000FF;">,<span style="color: #000000;">pp_Maxlen<span style="color: #0000FF;">,<span style="color: #000000;">17<span style="color: #0000FF;">}<span style="color: #0000FF;">)</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">t0</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #008080;">not</span> <span style="color: #000000;">solve<span style="color: #0000FF;">(<span style="color: #000000;">n<span style="color: #0000FF;">,<span style="color: #000000;">space<span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf<span style="color: #0000FF;">(<span style="color: #000000;">1<span style="color: #0000FF;">,<span style="color: #008000;">"solution of %d moves found in %s: %s\n"<span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{<span style="color: #7060A8;">length<span style="color: #0000FF;">(<span style="color: #000000;">moves<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #7060A8;">elapsed<span style="color: #0000FF;">(<span style="color: #7060A8;">time<span style="color: #0000FF;">(<span style="color: #0000FF;">)<span style="color: #0000FF;">-<span style="color: #000000;">t0<span style="color: #0000FF;">)<span style="color: #0000FF;">,<span style="color: #000000;">moves<span style="color: #0000FF;">}<span style="color: #0000FF;">)
<!--

56
Task/15-puzzle-solver/Picat/15-puzzle-solver.picat Normal file
View file

@ -0,0 +1,56 @@
import planner.
main =>
init(InitS),
goal(GoalS),
best_plan((InitS,GoalS),Plan),
println(Plan).
init(InitS) =>
M = {{15, 14, 1, 6},
{9 , 11, 4, 12},
{0, 10, 7, 3},
{13, 8, 5, 2}},
InitS = [(R,C) : T in 0..15, pos(M,T,R,C)].
goal(GoalS) =>
M = {{1, 2, 3, 4},
{5, 6, 7, 8},
{9, 10, 11, 12},
{13,14, 15, 0}},
GoalS = [(R,C) : T in 0..15, pos(M,T,R,C)].
pos(M,T,R,C) =>
N = len(M),
between(1,N,R),
between(1,N,C),
M[R,C] == T,!.
final((S,GoalS)) => S == GoalS.
action((S,GoalS),NextS,Action,Cost) =>
S = [P0|Tiles],
P0 = (R0,C0),
Cost = 1,
(R1 = R0-1, R1 >= 1, C1 = C0, Action = u;
R1 = R0+1, R1 =< 4, C1 = C0, Action = d;
R1 = R0, C1 = C0-1, C1 >= 1, Action = l;
R1 = R0, C1 = C0+1, C1 =< 4, Action = r),
P1 = (R1,C1),
slide(P0,P1,Tiles,Tiles1),
S1 = [P1|Tiles1],
NextS = (S1,GoalS).
% slide the tile at P1 to the empty square at P0
slide(P0,P1,[P1|Tiles],Tiles1) =>
Tiles1 = [P0|Tiles].
slide(P0,P1,[Tile|Tiles],Tiles1) =>
Tiles1=[Tile|Tiles1R],
slide(P0,P1,Tiles,Tiles1R).
% called by the planner
heuristic((S,GoalS)) = Dist =>
S = [_|Tiles],
GoalS = [_|FTiles],
Dist = sum([abs(R-FR)+abs(C-FC) :
{(R,C),(FR,FC)} in zip(Tiles,FTiles)]).

467
Task/15-puzzle-solver/PowerBASIC/15-puzzle-solver.basic Normal file
View file

@ -0,0 +1,467 @@
' The program solve fe169b4c0a73d852 in 4-5 seconds (on Intel Core i7-3770 3.40 GHz, 16 GB RAM, Windows 10 Pro).
' Test not completed with 0c9dfbae37254861 (still running after about 4 hours).
' Most of initialization is done in procedure fifteenSolver(), so it's possible to call it many times from the main function.
' No need to pass to fifteenSolver() the initial position of 0; the procedure determines it.
' Program includes procedure to create new configurations (by shuffling the correct final configuration).
' Program also includes a simple (text only) optional visualization of solving moves; the second (optional) parameter of fifteenSolver() is the pause between each move (in milliseconds).
'
' PowerBASIC compilers (both PBCC and PBWin) are 32 bits and are not that efficient when dealing with 64 bit integers (quad, only signed);
' this is not a problem for additions and subtractions, but left/right shift are quite slow;
' to speed up execution, left/right shift are done by inline X86 assembler (the PB statement is commented).
#compiler pbcc
#dim all
global Nr() as long
global Nc() as long
global n as long
global nn as long ' variable name _n not allowed
global N0() as long
global N3() as long
global N4() as long
global N2() as quad
%Ki=1
%Ke=2
%Kl=4
%Kg=8
%l=108 ' l
%r=114 ' r
%u=117 ' u
%d=100 ' d
function fY() as long
if N2(n) = &h123456789abcdef0 then
function=1
exit function
end if
if N4(n) <= nn then
function = fN()
exit function
end if
function = 0
end function
function fZ(byval w as long) as long
if (w and %Ki) > 0 then
call fI()
if fY() then
function = 1
exit function
end if
decr n
end if
if (w and %Kg) > 0 then
call fG()
if fY() then
function = 1
exit function
end if
decr n
end if
if (w and %Ke) > 0 then
call fE()
if fY() then
function = 1
exit function
end if
decr n
end if
if (w and %Kl) > 0 then
call fL()
if fY() then
function = 1
exit function
end if
decr n
end if
function = 0
end function
function fN() as long
select case N0(n)
case 0
select case N3(n)
case %l
function = fZ(%Ki)
exit function
case %u
function = fZ(%Ke)
exit function
case else
function = fZ(%Ki + %Ke)
exit function
end select
case 3
select case N3(n)
case %r
function = fZ(%Ki)
exit function
case %u
function = fZ(%Kl)
exit function
case else
function = fZ(%Ki + %Kl)
exit function
end select
case 1, 2
select case N3(n)
case %l
function = fZ(%Ki + %Kl)
exit function
case %r
function = fZ(%Ki + %Ke)
exit function
case %u
function = fZ(%Ke + %Kl)
exit function
case else
function = fZ(%Kl + %Ke + %Ki)
exit function
end select
case 12
select case N3(n)
case %l
function = fZ(%Kg)
exit function
case %d
function = fZ(%Ke)
exit function
case else
function = fZ(%Ke + %Kg)
exit function
end select
case 15
select case N3(n)
case %r
function = fZ(%Kg)
exit function
case %d
function = fZ(%Kl)
exit function
case else
function = fZ(%Kg + %Kl)
exit function
end select
case 13, 14
select case N3(n)
case %l
function = fZ(%Kg + %Kl)
exit function
case %r
function = fZ(%Ke + %Kg)
exit function
case %d
function = fZ(%Ke + %Kl)
exit function
case else
function = fZ(%Kg + %Ke + %Kl)
exit function
end select
case 4, 8
select case N3(n)
case %l
function = fZ(%Ki + %Kg)
exit function
case %u
function = fZ(%Kg + %Ke)
exit function
case %d
function = fZ(%Ki + %Ke)
exit function
case else
function = fZ(%Ki + %Kg + %Ke)
exit function
end select
case 7, 11
select case N3(n)
case %d
function = fZ(%Ki + %Kl)
exit function
case %u
function = fZ(%Kg + %Kl)
exit function
case %r
function = fZ(%Ki + %Kg)
exit function
case else
function = fZ(%Ki + %Kg + %Kl)
exit function
end select
case else
select case N3(n)
case %d
function = fZ(%Ki + %Ke + %Kl)
exit function
case %l
function = fZ(%Ki + %Kg + %Kl)
exit function
case %r
function = fZ(%Ki + %Kg + %Ke)
exit function
case %u
function = fZ(%Kg + %Ke + %Kl)
exit function
case else
function = fZ(%Ki + %Kg + %Ke + %Kl)
exit function
end select
end select
end function
sub fI()
local g as long
local a as quad
g = (11 - N0(n)) * 4
a = (N2(n) and lshift(15,g))
N0(n + 1) = N0(n) + 4
N2(n + 1) = N2(n) - a + lshift(a, 16)
N3(n + 1) = %d
N4(n + 1) = N4(n)
if isfalse(Nr(rshift(a,g)) <= N0(n)\4) then
incr N4(n + 1)
end if
incr n
end sub
sub fG()
local g as long
local a as quad
g = (19 - N0(n)) * 4
a = (N2(n) and lshift(15,g))
N0(n + 1) = N0(n) - 4
N2(n + 1) = N2(n) - a + rshift(a, 16)
N3(n + 1) = %u
N4(n + 1) = N4(n)
if isfalse(Nr(rshift(a,g)) >= N0(n)\4) then
incr N4(n + 1)
end if
incr n
end sub
sub fE()
local g as long
local a as quad
g = (14 - N0(n)) * 4
a = (N2(n) and lshift(15,g))
N0(n + 1) = N0(n) + 1
N2(n + 1) = N2(n) - a + lshift(a,4)
N3(n + 1) = %r
N4(n + 1) = N4(n)
if isfalse(Nc(rshift(a,g)) <= (N0(n) mod 4)) then
incr N4(n + 1)
end if
incr n
end sub
sub fL()
local g as long
local a as quad
g = (16 - N0(n)) * 4
a = (N2(n) and lshift(15,g))
N0(n + 1) = N0(n) - 1
N2(n + 1) = N2(n) - a + rshift(a,4)
N3(n + 1) = %l
N4(n + 1) = N4(n)
if isfalse(Nc(rshift(a,g)) >= (N0(n) mod 4)) then
incr N4(n + 1)
end if
incr n
end sub
function lshift(byval v as quad, byval s as dword) as quad
'shift left v, s
' inline assembler shift is much faster
!mov edx,v[4]
!mov eax,v
!mov ecx,s
!shld edx,eax,cl
!shl eax,cl
!test ecx,32
!jz skip
!mov edx,eax
!xor eax,eax
skip:
!mov v[4],edx
!mov v,eax
function = v
end function
function rshift(byval v as quad, byval s as dword) as quad
'shift right v, s
' inline assembler shift is much faster
!mov edx,v[4]
!mov eax,v
!mov ecx,s
!shrd eax,edx,cl
!shr edx,cl
!test ecx,32
!jz skip
!mov eax,edx
!xor edx,edx
skip:
!mov v[4],edx
!mov v,eax
function = v
end function
sub fifteenSolver(byval g as quad, optional byval p as long)
local h as string
local j as long
local s as string
local t as single
t=timer
redim Nr(0 to 15)
redim Nc(0 to 15)
redim N0(0 to 99)
redim N3(0 to 100)
redim N4(0 to 99)
redim N2(0 to 99)
array assign Nr()=3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3
array assign Nc()=3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2
n = 0
nn = 0
h = hex$(g, 16)
cls
print "Puzzle: ";lcase$(h)
call ShowConfiguration(h, 2)
print
print
N0(0) = instr(h, "0") - 1
N2(0) = g
call solve()
print using$("Solution found in #### moves: ", n);
for j = 1 to n
s = s + chr$(N3(j))
next
print s
print "Time = ";format$(timer-t, "#####.########");" seconds"
if p then
call showMoves(h, s, n, p)
end if
end sub
sub solve()
if fN() then
exit sub
else
n = 0
incr nn
call solve()
end if
end sub
function createPuzzle(byval j as long) as quad
local q as quad
local h as string
local z as long
local d as long
local r as long
local u as long
randomize timer
q=&h123456789abcdef0
h = hex$(q, 16)
u = 0
while j > 0 ' number of moves to do
do
d = rnd(1, 4) ' -1 +1 -4 +4
loop while d = u
u = -d
r = rnd(1, 3) ' repetitions
while r
z = instr(h, "0")
select case d
case 1 ' -1
if (z mod 4) <> 1 then
mid$(h, z, 1) = mid$(h, z - 1, 1)
mid$(h, z - 1, 1) = "0"
decr j
end if
case 2 ' +1
if (z mod 4) <> 0 then
mid$(h, z , 1) = mid$(h, z + 1, 1)
mid$(h, z + 1, 1) = "0"
decr j
end if
case 3 ' -4
if z >= 5 then
mid$(h, z, 1) = mid$(h, z - 4, 1)
mid$(h, z - 4, 1) = "0"
decr j
end if
case 4 ' +4
if z <= 12 then
mid$(h, z , 1) = mid$(h, z + 4, 1)
mid$(h, z + 4, 1) = "0"
decr j
end if
end select
decr r
wend
wend
function = val("&h"+h)
end function
sub shoWMoves(byval h as string, byval s as string, byval m as long, byval p as long)
local j as long
local z as long
local d as long
cursor off
call ShowConfiguration(h, 12)
for j = 1 to m
d = asc(mid$(s, j, 1))
z = instr(h, "0")
select case d
case %l
if (z mod 4) <> 1 then
mid$(h, z, 1) = mid$(h, z - 1, 1)
mid$(h, z - 1, 1) = "0"
end if
case %r
if (z mod 4) <> 0 then
mid$(h, z , 1) = mid$(h, z + 1, 1)
mid$(h, z + 1, 1) = "0"
end if
case %u
if z >= 5 then
mid$(h, z, 1) = mid$(h, z - 4, 1)
mid$(h, z - 4, 1) = "0"
end if
case %d
if z <= 12 then
mid$(h, z , 1) = mid$(h, z + 4, 1)
mid$(h, z + 4, 1) = "0"
end if
end select
call ShowConfiguration(h, 12)
sleep p
next
locate 20,1
print "Press any key ..."
cursor on
waitkey$
cls
end sub
sub ShowConfiguration(byval h as string, i as long)
local r as long
local c as long
local x as string
for r = 1 to 4
for c = 1 to 4
locate r + i, c + c - 1
x = mid$(h, r * 4 - 4 + c, 1)
if x = "0" then
x = " "
end if
print x;
next
next
end sub
function PBMain() as long
call fifteenSolver(&hfe169b4c0a73d852, 1000)
'call fifteenSolver(createPuzzle(100), 1000)
'call fifteenSolver(&h0c9dfbae37254861, 1000)
end function

186
Task/15-puzzle-solver/Python/15-puzzle-solver-1.py Normal file
View file

@ -0,0 +1,186 @@
import random
class IDAStar:
def __init__(self, h, neighbours):
""" Iterative-deepening A* search.
h(n) is the heuristic that gives the cost between node n and the goal node. It must be admissable, meaning that h(n) MUST NEVER OVERSTIMATE the true cost. Underestimating is fine.
neighbours(n) is an iterable giving a pair (cost, node, descr) for each node neighbouring n
IN ASCENDING ORDER OF COST. descr is not used in the computation but can be used to
efficiently store information about the path edges (e.g. up/left/right/down for grids).
"""
self.h = h
self.neighbours = neighbours
self.FOUND = object()
def solve(self, root, is_goal, max_cost=None):
""" Returns the shortest path between the root and a given goal, as well as the total cost.
If the cost exceeds a given max_cost, the function returns None. If you do not give a
maximum cost the solver will never return for unsolvable instances."""
self.is_goal = is_goal
self.path = [root]
self.is_in_path = {root}
self.path_descrs = []
self.nodes_evaluated = 0
bound = self.h(root)
while True:
t = self._search(0, bound)
if t is self.FOUND: return self.path, self.path_descrs, bound, self.nodes_evaluated
if t is None: return None
bound = t
def _search(self, g, bound):
self.nodes_evaluated += 1
node = self.path[-1]
f = g + self.h(node)
if f > bound: return f
if self.is_goal(node): return self.FOUND
m = None # Lower bound on cost.
for cost, n, descr in self.neighbours(node):
if n in self.is_in_path: continue
self.path.append(n)
self.is_in_path.add(n)
self.path_descrs.append(descr)
t = self._search(g + cost, bound)
if t == self.FOUND: return self.FOUND
if m is None or (t is not None and t < m): m = t
self.path.pop()
self.path_descrs.pop()
self.is_in_path.remove(n)
return m
def slide_solved_state(n):
return tuple(i % (n*n) for i in range(1, n*n+1))
def slide_randomize(p, neighbours):
for _ in range(len(p) ** 2):
_, p, _ = random.choice(list(neighbours(p)))
return p
def slide_neighbours(n):
movelist = []
for gap in range(n*n):
x, y = gap % n, gap // n
moves = []
if x > 0: moves.append(-1) # Move the gap left.
if x < n-1: moves.append(+1) # Move the gap right.
if y > 0: moves.append(-n) # Move the gap up.
if y < n-1: moves.append(+n) # Move the gap down.
movelist.append(moves)
def neighbours(p):
gap = p.index(0)
l = list(p)
for m in movelist[gap]:
l[gap] = l[gap + m]
l[gap + m] = 0
yield (1, tuple(l), (l[gap], m))
l[gap + m] = l[gap]
l[gap] = 0
return neighbours
def slide_print(p):
n = int(round(len(p) ** 0.5))
l = len(str(n*n))
for i in range(0, len(p), n):
print(" ".join("{:>{}}".format(x, l) for x in p[i:i+n]))
def encode_cfg(cfg, n):
r = 0
b = n.bit_length()
for i in range(len(cfg)):
r |= cfg[i] << (b*i)
return r
def gen_wd_table(n):
goal = [[0] * i + [n] + [0] * (n - 1 - i) for i in range(n)]
goal[-1][-1] = n - 1
goal = tuple(sum(goal, []))
table = {}
to_visit = [(goal, 0, n-1)]
while to_visit:
cfg, cost, e = to_visit.pop(0)
enccfg = encode_cfg(cfg, n)
if enccfg in table: continue
table[enccfg] = cost
for d in [-1, 1]:
if 0 <= e + d < n:
for c in range(n):
if cfg[n*(e+d) + c] > 0:
ncfg = list(cfg)
ncfg[n*(e+d) + c] -= 1
ncfg[n*e + c] += 1
to_visit.append((tuple(ncfg), cost + 1, e+d))
return table
def slide_wd(n, goal):
wd = gen_wd_table(n)
goals = {i : goal.index(i) for i in goal}
b = n.bit_length()
def h(p):
ht = 0 # Walking distance between rows.
vt = 0 # Walking distance between columns.
d = 0
for i, c in enumerate(p):
if c == 0: continue
g = goals[c]
xi, yi = i % n, i // n
xg, yg = g % n, g // n
ht += 1 << (b*(n*yi+yg))
vt += 1 << (b*(n*xi+xg))
if yg == yi:
for k in range(i + 1, i - i%n + n): # Until end of row.
if p[k] and goals[p[k]] // n == yi and goals[p[k]] < g:
d += 2
if xg == xi:
for k in range(i + n, n * n, n): # Until end of column.
if p[k] and goals[p[k]] % n == xi and goals[p[k]] < g:
d += 2
d += wd[ht] + wd[vt]
return d
return h
if __name__ == "__main__":
solved_state = slide_solved_state(4)
neighbours = slide_neighbours(4)
is_goal = lambda p: p == solved_state
tests = [
(15, 14, 1, 6, 9, 11, 4, 12, 0, 10, 7, 3, 13, 8, 5, 2),
]
slide_solver = IDAStar(slide_wd(4, solved_state), neighbours)
for p in tests:
path, moves, cost, num_eval = slide_solver.solve(p, is_goal, 80)
slide_print(p)
print(", ".join({-1: "Left", 1: "Right", -4: "Up", 4: "Down"}[move[1]] for move in moves))
print(cost, num_eval)

839
Task/15-puzzle-solver/Python/15-puzzle-solver-2.py Normal file
View file

@ -0,0 +1,839 @@
"""
Python example for this Rosetta Code task:
http://rosettacode.org/wiki/15_puzzle_solver
Using A* Algorithm from Wikkipedia:
https://en.wikipedia.org/wiki/A*_search_algorithm
Need to use heuristic that guarantees a shortest path
solution.
"""
import heapq
import copy
# Hopefully this is larger than any fscore or gscore
integer_infinity = 1000000000
class Position(object):
"""Position class represents one position of a 15 puzzle"""
def __init__(self, tiles):
"""
Takes a tuple of tuples representing the tiles on a 4x4 puzzle board
numbering 1-15 with 0 representing an empty square. For example:
(( 1, 2, 3, 4),
( 5, 6, 7, 8),
( 9, 10, 11, 12),
(13, 14, 15, 0))
Converts list of lists representation into tuple of tuples.
"""
if type(tiles) == type(list()):
t = tiles
self.tiles = ((t[0][0], t[0][1], t[0][2], t[0][3]),
(t[1][0], t[1][1], t[1][2], t[1][3]),
(t[2][0], t[2][1], t[2][2], t[2][3]),
(t[3][0], t[3][1], t[3][2], t[3][3]))
else:
self.tiles = tiles
# fields for A* algorithm
self.fscore = integer_infinity
self.gscore = integer_infinity
self.cameFrom = None
def copy_tiles(self):
""" returns list of lists version """
t = self.tiles
return [[t[0][0], t[0][1], t[0][2], t[0][3]],
[t[1][0], t[1][1], t[1][2], t[1][3]],
[t[2][0], t[2][1], t[2][2], t[2][3]],
[t[3][0], t[3][1], t[3][2], t[3][3]]]
def neighbors(self):
"""
returns a list of neighbors
returns a list position objects with their
directiontomoveto set to the direction that the
empty square moved.
tiles is 4x4 tuple of tuples with
0,0 as top left.
tiles[y][x]
"""
# find 0 - blank square
x0 = None
y0 = None
for i in range(4):
for j in range(4):
if self.tiles[i][j] == 0:
y0 = i
x0 = j
if x0 == None or y0 == None:
return []
neighbor_list = []
# move 0 to the right
if x0 < 3:
new_tiles = self.copy_tiles()
temp = new_tiles[y0][x0+1]
new_tiles[y0][x0+1] = 0
new_tiles[y0][x0] = temp
new_pos = new_position(new_tiles)
neighbor_list.append(new_pos)
# move 0 to the left
if x0 > 0:
new_tiles = self.copy_tiles()
temp = new_tiles[y0][x0-1]
new_tiles[y0][x0-1] = 0
new_tiles[y0][x0] = temp
new_pos = new_position(new_tiles)
neighbor_list.append(new_pos)
# move 0 up
if y0 > 0:
new_tiles = self.copy_tiles()
temp = new_tiles[y0-1][x0]
new_tiles[y0-1][x0] = 0
new_tiles[y0][x0] = temp
new_pos = new_position(new_tiles)
neighbor_list.append(new_pos)
# move 0 down
if y0 < 3:
new_tiles = self.copy_tiles()
temp = new_tiles[y0+1][x0]
new_tiles[y0+1][x0] = 0
new_tiles[y0][x0] = temp
new_pos = new_position(new_tiles)
neighbor_list.append(new_pos)
return neighbor_list
def __repr__(self):
# printable version of self
return str(self.tiles[0])+'\n'+str(self.tiles[1])+'\n'+str(self.tiles[2])+'\n'+str(self.tiles[3])+'\n'
# takes tuple of tuples tiles as key, Position object for that tiles as value
all_positions = dict()
def new_position(tiles):
""" returns a new position or looks up existing one """
global all_positions
if type(tiles) == type(list()):
t = tiles
tuptiles = ((t[0][0], t[0][1], t[0][2], t[0][3]),
(t[1][0], t[1][1], t[1][2], t[1][3]),
(t[2][0], t[2][1], t[2][2], t[2][3]),
(t[3][0], t[3][1], t[3][2], t[3][3]))
else:
tuptiles = tiles
if tuptiles in all_positions:
return all_positions[tuptiles]
else:
new_pos = Position(tiles)
all_positions[tuptiles] = new_pos
return new_pos
def reconstruct_path(current):
"""
Uses the cameFrom members to follow the chain of moves backwards
and then reverses the list to get the path in the correct order.
"""
total_path = [current]
while current.cameFrom != None:
current = current.cameFrom
total_path.append(current)
total_path.reverse()
return total_path
class PriorityQueue(object):
"""
Priority queue using heapq.
elements of queue are (fscore,tiles) for each position.
If element is removed from queue and fscore doesn't match
then that element is discarded.
"""
def __init__(self, object_list):
"""
Save a list in a heapq.
Assume that each object only appears once
in the list.
"""
self.queue_length = 0
self.qheap = []
for e in object_list:
self.qheap.append((e.fscore,e.tiles))
self.queue_length += 1
heapq.heapify(self.qheap)
def push(self, new_object):
""" save object in heapq """
heapq.heappush(self.qheap,(new_object.fscore,new_object.tiles))
self.queue_length += 1
def pop(self):
""" remove object from heap and return """
if self.queue_length < 1:
return None
fscore, tiles = heapq.heappop(self.qheap)
self.queue_length -= 1
global all_positions
pos = all_positions[tiles]
if pos.fscore == fscore:
return pos
else:
return self.pop()
def __repr__(self):
# printable version of self
strrep = ""
for e in self.qheap:
fscore, tiles = e
strrep += str(fscore)+":"+str(tiles)+"\n"
return strrep
conflict_table = None
def build_conflict_table():
global conflict_table
conflict_table = dict()
# assumes goal tuple has up to
# for the given pattern it the start position
# how much to add for linear conflicts
# 2 per conflict - max of 6
# goal tuple is ('g0', 'g1', 'g2', 'g3')
conflict_table[('g0', 'g1', 'g2', 'g3')] = 0
conflict_table[('g0', 'g1', 'g2', 'x')] = 0
conflict_table[('g0', 'g1', 'g3', 'g2')] = 2
conflict_table[('g0', 'g1', 'g3', 'x')] = 0
conflict_table[('g0', 'g1', 'x', 'g2')] = 0
conflict_table[('g0', 'g1', 'x', 'g3')] = 0
conflict_table[('g0', 'g1', 'x', 'x')] = 0
conflict_table[('g0', 'g2', 'g1', 'g3')] = 2
conflict_table[('g0', 'g2', 'g1', 'x')] = 2
conflict_table[('g0', 'g2', 'g3', 'g1')] = 4
conflict_table[('g0', 'g2', 'g3', 'x')] = 0
conflict_table[('g0', 'g2', 'x', 'g1')] = 2
conflict_table[('g0', 'g2', 'x', 'g3')] = 0
conflict_table[('g0', 'g2', 'x', 'x')] = 0
conflict_table[('g0', 'g3', 'g1', 'g2')] = 4
conflict_table[('g0', 'g3', 'g1', 'x')] = 2
conflict_table[('g0', 'g3', 'g2', 'g1')] = 4
conflict_table[('g0', 'g3', 'g2', 'x')] = 2
conflict_table[('g0', 'g3', 'x', 'g1')] = 2
conflict_table[('g0', 'g3', 'x', 'g2')] = 2
conflict_table[('g0', 'g3', 'x', 'x')] = 0
conflict_table[('g0', 'x', 'g1', 'g2')] = 0
conflict_table[('g0', 'x', 'g1', 'g3')] = 0
conflict_table[('g0', 'x', 'g1', 'x')] = 0
conflict_table[('g0', 'x', 'g2', 'g1')] = 2
conflict_table[('g0', 'x', 'g2', 'g3')] = 0
conflict_table[('g0', 'x', 'g2', 'x')] = 0
conflict_table[('g0', 'x', 'g3', 'g1')] = 2
conflict_table[('g0', 'x', 'g3', 'g2')] = 2
conflict_table[('g0', 'x', 'g3', 'x')] = 0
conflict_table[('g0', 'x', 'x', 'g1')] = 0
conflict_table[('g0', 'x', 'x', 'g2')] = 0
conflict_table[('g0', 'x', 'x', 'g3')] = 0
conflict_table[('g1', 'g0', 'g2', 'g3')] = 2
conflict_table[('g1', 'g0', 'g2', 'x')] = 2
conflict_table[('g1', 'g0', 'g3', 'g2')] = 4
conflict_table[('g1', 'g0', 'g3', 'x')] = 2
conflict_table[('g1', 'g0', 'x', 'g2')] = 2
conflict_table[('g1', 'g0', 'x', 'g3')] = 2
conflict_table[('g1', 'g0', 'x', 'x')] = 2
conflict_table[('g1', 'g2', 'g0', 'g3')] = 4
conflict_table[('g1', 'g2', 'g0', 'x')] = 4
conflict_table[('g1', 'g2', 'g3', 'g0')] = 6
conflict_table[('g1', 'g2', 'g3', 'x')] = 0
conflict_table[('g1', 'g2', 'x', 'g0')] = 4
conflict_table[('g1', 'g2', 'x', 'g3')] = 0
conflict_table[('g1', 'g2', 'x', 'x')] = 0
conflict_table[('g1', 'g3', 'g0', 'g2')] = 4
conflict_table[('g1', 'g3', 'g0', 'x')] = 4
conflict_table[('g1', 'g3', 'g2', 'g0')] = 6
conflict_table[('g1', 'g3', 'g2', 'x')] = 0
conflict_table[('g1', 'g3', 'x', 'g0')] = 4
conflict_table[('g1', 'g3', 'x', 'g2')] = 2
conflict_table[('g1', 'g3', 'x', 'x')] = 0
conflict_table[('g1', 'x', 'g0', 'g2')] = 2
conflict_table[('g1', 'x', 'g0', 'g3')] = 2
conflict_table[('g1', 'x', 'g0', 'x')] = 2
conflict_table[('g1', 'x', 'g2', 'g0')] = 4
conflict_table[('g1', 'x', 'g2', 'g3')] = 0
conflict_table[('g1', 'x', 'g2', 'x')] = 0
conflict_table[('g1', 'x', 'g3', 'g0')] = 4
conflict_table[('g1', 'x', 'g3', 'g2')] = 2
conflict_table[('g1', 'x', 'g3', 'x')] = 0
conflict_table[('g1', 'x', 'x', 'g0')] = 2
conflict_table[('g1', 'x', 'x', 'g2')] = 0
conflict_table[('g1', 'x', 'x', 'g3')] = 0
conflict_table[('g2', 'g0', 'g1', 'g3')] = 4
conflict_table[('g2', 'g0', 'g1', 'x')] = 4
conflict_table[('g2', 'g0', 'g3', 'g1')] = 4
conflict_table[('g2', 'g0', 'g3', 'x')] = 2
conflict_table[('g2', 'g0', 'x', 'g1')] = 4
conflict_table[('g2', 'g0', 'x', 'g3')] = 2
conflict_table[('g2', 'g0', 'x', 'x')] = 2
conflict_table[('g2', 'g1', 'g0', 'g3')] = 4
conflict_table[('g2', 'g1', 'g0', 'x')] = 4
conflict_table[('g2', 'g1', 'g3', 'g0')] = 6
conflict_table[('g2', 'g1', 'g3', 'x')] = 2
conflict_table[('g2', 'g1', 'x', 'g0')] = 4
conflict_table[('g2', 'g1', 'x', 'g3')] = 2
conflict_table[('g2', 'g1', 'x', 'x')] = 2
conflict_table[('g2', 'g3', 'g0', 'g1')] = 4
conflict_table[('g2', 'g3', 'g0', 'x')] = 4
conflict_table[('g2', 'g3', 'g1', 'g0')] = 6
conflict_table[('g2', 'g3', 'g1', 'x')] = 4
conflict_table[('g2', 'g3', 'x', 'g0')] = 4
conflict_table[('g2', 'g3', 'x', 'g1')] = 4
conflict_table[('g2', 'g3', 'x', 'x')] = 0
conflict_table[('g2', 'x', 'g0', 'g1')] = 4
conflict_table[('g2', 'x', 'g0', 'g3')] = 2
conflict_table[('g2', 'x', 'g0', 'x')] = 2
conflict_table[('g2', 'x', 'g1', 'g0')] = 4
conflict_table[('g2', 'x', 'g1', 'g3')] = 2
conflict_table[('g2', 'x', 'g1', 'x')] = 2
conflict_table[('g2', 'x', 'g3', 'g0')] = 4
conflict_table[('g2', 'x', 'g3', 'g1')] = 4
conflict_table[('g2', 'x', 'g3', 'x')] = 0
conflict_table[('g2', 'x', 'x', 'g0')] = 2
conflict_table[('g2', 'x', 'x', 'g1')] = 2
conflict_table[('g2', 'x', 'x', 'g3')] = 0
conflict_table[('g3', 'g0', 'g1', 'g2')] = 6
conflict_table[('g3', 'g0', 'g1', 'x')] = 4
conflict_table[('g3', 'g0', 'g2', 'g1')] = 6
conflict_table[('g3', 'g0', 'g2', 'x')] = 4
conflict_table[('g3', 'g0', 'x', 'g1')] = 4
conflict_table[('g3', 'g0', 'x', 'g2')] = 4
conflict_table[('g3', 'g0', 'x', 'x')] = 2
conflict_table[('g3', 'g1', 'g0', 'g2')] = 6
conflict_table[('g3', 'g1', 'g0', 'x')] = 4
conflict_table[('g3', 'g1', 'g2', 'g0')] = 6
conflict_table[('g3', 'g1', 'g2', 'x')] = 4
conflict_table[('g3', 'g1', 'x', 'g0')] = 4
conflict_table[('g3', 'g1', 'x', 'g2')] = 4
conflict_table[('g3', 'g1', 'x', 'x')] = 2
conflict_table[('g3', 'g2', 'g0', 'g1')] = 6
conflict_table[('g3', 'g2', 'g0', 'x')] = 4
conflict_table[('g3', 'g2', 'g1', 'g0')] = 6
conflict_table[('g3', 'g2', 'g1', 'x')] = 4
conflict_table[('g3', 'g2', 'x', 'g0')] = 4
conflict_table[('g3', 'g2', 'x', 'g1')] = 4
conflict_table[('g3', 'g2', 'x', 'x')] = 2
conflict_table[('g3', 'x', 'g0', 'g1')] = 4
conflict_table[('g3', 'x', 'g0', 'g2')] = 4
conflict_table[('g3', 'x', 'g0', 'x')] = 2
conflict_table[('g3', 'x', 'g1', 'g0')] = 4
conflict_table[('g3', 'x', 'g1', 'g2')] = 4
conflict_table[('g3', 'x', 'g1', 'x')] = 2
conflict_table[('g3', 'x', 'g2', 'g0')] = 4
conflict_table[('g3', 'x', 'g2', 'g1')] = 4
conflict_table[('g3', 'x', 'g2', 'x')] = 2
conflict_table[('g3', 'x', 'x', 'g0')] = 2
conflict_table[('g3', 'x', 'x', 'g1')] = 2
conflict_table[('g3', 'x', 'x', 'g2')] = 2
conflict_table[('x', 'g0', 'g1', 'g2')] = 0
conflict_table[('x', 'g0', 'g1', 'g3')] = 0
conflict_table[('x', 'g0', 'g1', 'x')] = 0
conflict_table[('x', 'g0', 'g2', 'g1')] = 2
conflict_table[('x', 'g0', 'g2', 'g3')] = 0
conflict_table[('x', 'g0', 'g2', 'x')] = 0
conflict_table[('x', 'g0', 'g3', 'g1')] = 2
conflict_table[('x', 'g0', 'g3', 'g2')] = 2
conflict_table[('x', 'g0', 'g3', 'x')] = 0
conflict_table[('x', 'g0', 'x', 'g1')] = 0
conflict_table[('x', 'g0', 'x', 'g2')] = 0
conflict_table[('x', 'g0', 'x', 'g3')] = 0
conflict_table[('x', 'g1', 'g0', 'g2')] = 2
conflict_table[('x', 'g1', 'g0', 'g3')] = 2
conflict_table[('x', 'g1', 'g0', 'x')] = 2
conflict_table[('x', 'g1', 'g2', 'g0')] = 4
conflict_table[('x', 'g1', 'g2', 'g3')] = 0
conflict_table[('x', 'g1', 'g2', 'x')] = 0
conflict_table[('x', 'g1', 'g3', 'g0')] = 4
conflict_table[('x', 'g1', 'g3', 'g2')] = 2
conflict_table[('x', 'g1', 'g3', 'x')] = 0
conflict_table[('x', 'g1', 'x', 'g0')] = 2
conflict_table[('x', 'g1', 'x', 'g2')] = 0
conflict_table[('x', 'g1', 'x', 'g3')] = 0
conflict_table[('x', 'g2', 'g0', 'g1')] = 4
conflict_table[('x', 'g2', 'g0', 'g3')] = 2
conflict_table[('x', 'g2', 'g0', 'x')] = 2
conflict_table[('x', 'g2', 'g1', 'g0')] = 4
conflict_table[('x', 'g2', 'g1', 'g3')] = 2
conflict_table[('x', 'g2', 'g1', 'x')] = 2
conflict_table[('x', 'g2', 'g3', 'g0')] = 4
conflict_table[('x', 'g2', 'g3', 'g1')] = 4
conflict_table[('x', 'g2', 'g3', 'x')] = 0
conflict_table[('x', 'g2', 'x', 'g0')] = 2
conflict_table[('x', 'g2', 'x', 'g1')] = 2
conflict_table[('x', 'g2', 'x', 'g3')] = 0
conflict_table[('x', 'g3', 'g0', 'g1')] = 4
conflict_table[('x', 'g3', 'g0', 'g2')] = 4
conflict_table[('x', 'g3', 'g0', 'x')] = 2
conflict_table[('x', 'g3', 'g1', 'g0')] = 4
conflict_table[('x', 'g3', 'g1', 'g2')] = 4
conflict_table[('x', 'g3', 'g1', 'x')] = 2
conflict_table[('x', 'g3', 'g2', 'g0')] = 4
conflict_table[('x', 'g3', 'g2', 'g1')] = 4
conflict_table[('x', 'g3', 'g2', 'x')] = 2
conflict_table[('x', 'g3', 'x', 'g0')] = 2
conflict_table[('x', 'g3', 'x', 'g1')] = 2
conflict_table[('x', 'g3', 'x', 'g2')] = 2
conflict_table[('x', 'x', 'g0', 'g1')] = 0
conflict_table[('x', 'x', 'g0', 'g2')] = 0
conflict_table[('x', 'x', 'g0', 'g3')] = 0
conflict_table[('x', 'x', 'g1', 'g0')] = 2
conflict_table[('x', 'x', 'g1', 'g2')] = 0
conflict_table[('x', 'x', 'g1', 'g3')] = 0
conflict_table[('x', 'x', 'g2', 'g0')] = 2
conflict_table[('x', 'x', 'g2', 'g1')] = 2
conflict_table[('x', 'x', 'g2', 'g3')] = 0
conflict_table[('x', 'x', 'g3', 'g0')] = 2
conflict_table[('x', 'x', 'g3', 'g1')] = 2
conflict_table[('x', 'x', 'g3', 'g2')] = 2
def linear_conflicts(start_list,goal_list):
"""
calculates number of moves to add to the estimate of
the moves to get from start to goal based on the number
of conflicts on a given row or column. start_list
represents the current location and goal_list represnts
the final goal.
"""
# Find which of the tiles in start_list have their goals on this line
# build a pattern to use in a lookup table of this form:
# g0, g1, g3, g3 fill in x where there is no goal for this line
# all 'x' until we file a tile whose goal is in this line
goal_pattern = ['x', 'x', 'x', 'x']
for g in range(4):
for s in range(4):
start_tile_num = start_list[s]
if start_tile_num == goal_list[g] and start_tile_num != 0:
goal_pattern[s] = 'g' + str(g) # i.e. g0
global conflict_table
tup_goal_pattern = tuple(goal_pattern)
if tup_goal_pattern in conflict_table:
return conflict_table[tuple(goal_pattern)]
else:
return 0
class lcmap(dict):
"""
Lets you return 0 if you look for an object that
is not in the dictionary.
"""
def __missing__(self, key):
return 0
def listconflicts(goal_list):
"""
list all possible start lists that will have at least
one linear conflict.
Possible goal tile configurations
g g g g
g g g x
g g x g
g x g g
x g g g
g g x x
g x g x
g x x g
x g g x
x g x g
x x g g
"""
all_tiles = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15]
non_goal_tiles = []
for t in all_tiles:
if t not in goal_list:
non_goal_tiles.append(t)
combinations = lcmap()
# g g g g
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(j)
for k in tile_list3:
tile_list4 = tile_list3[:]
tile_list4.remove(k)
for l in tile_list4:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g g g x
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(j)
for k in tile_list3:
for l in non_goal_tiles:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g g x g
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(j)
for k in non_goal_tiles:
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g x g g
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in non_goal_tiles:
for k in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(k)
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# x g g g
for i in non_goal_tiles:
for j in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(j)
for k in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(k)
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g g x x
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in tile_list2:
tile_list3 = tile_list2[:]
tile_list3.remove(j)
for k in non_goal_tiles:
tile_list4 = non_goal_tiles[:]
tile_list4.remove(k)
for l in tile_list4:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g x g x
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in non_goal_tiles:
tile_list3 = non_goal_tiles[:]
tile_list3.remove(j)
for k in tile_list2:
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# g x x g
for i in goal_list:
tile_list2 = goal_list[:]
tile_list2.remove(i)
for j in non_goal_tiles:
tile_list3 = non_goal_tiles[:]
tile_list3.remove(j)
for k in tile_list2:
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# x g g x
for i in non_goal_tiles:
tile_list2 = non_goal_tiles[:]
tile_list2.remove(i)
for j in goal_list:
tile_list3 = goal_list[:]
tile_list3.remove(j)
for k in tile_list3:
for l in tile_list2:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# x g x g
for i in non_goal_tiles:
tile_list2 = non_goal_tiles[:]
tile_list2.remove(i)
for j in goal_list:
tile_list3 = goal_list[:]
tile_list3.remove(j)
for k in tile_list3:
for l in tile_list2:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
# x x g g
for i in non_goal_tiles:
tile_list2 = non_goal_tiles[:]
tile_list2.remove(i)
for j in tile_list2:
for k in goal_list:
tile_list3 = goal_list[:]
tile_list3.remove(k)
for l in tile_list3:
start_list = (i, j, k, l)
conflictadd = linear_conflicts(start_list,goal_list)
if conflictadd > 0:
combinations[start_list]=conflictadd
return combinations
class HeuristicObj(object):
""" Object used to preprocess goal position for heuristic function """
def __init__(self, goal):
"""
Preprocess goal position to setup internal data structures
that can be used to speed up heuristic.
"""
build_conflict_table()
self.goal_map = []
for i in range(16):
self.goal_map.append(i)
self.goal_lists = goal.tiles
# preprocess for manhattan distance
for row in range(4):
for col in range(4):
self.goal_map[goal.tiles[row][col]] = (row, col)
# make access faster by changing to a tuple
self.goal_map = tuple(self.goal_map)
# preprocess for linear conflicts
self.row_conflicts = []
for row in range(4):
t = goal.tiles[row]
conf_dict = listconflicts([t[0],t[1],t[2],t[3]])
self.row_conflicts.append(conf_dict)
self.col_conflicts = []
for col in range(4):
col_list =[]
for row in range(4):
col_list.append(goal.tiles[row][col])
conf_dict = listconflicts(col_list)
self.col_conflicts.append(conf_dict)
def heuristic(self, start):
"""
Estimates the number of moves from start to goal.
The goal was preprocessed in __init__.
"""
distance = 0
# local variables for instance variables
t = start.tiles
g = self.goal_map
rc = self.row_conflicts
cc = self.col_conflicts
# calculate manhattan distance
for row in range(4):
for col in range(4):
start_tilenum = t[row][col]
if start_tilenum != 0:
(grow, gcol) = g[start_tilenum]
distance += abs(row - grow) + abs(col - gcol)
# add linear conflicts
for row in range(4):
curr_row = t[row]
distance += rc[row][curr_row]
for col in range(4):
col_tuple = (t[0][col], t[1][col], t[2][col], t[3][col])
distance += cc[col][col_tuple]
return distance
# global variable for heuristic object
hob = None
def a_star(start_tiles, goal_tiles):
""" Based on https://en.wikipedia.org/wiki/A*_search_algorithm """
start = new_position(start_tiles)
goal = new_position(goal_tiles)
# Process goal position for use in heuristic
global hob
hob = HeuristicObj(goal)
# The set of currently discovered nodes that are not evaluated yet.
# Initially, only the start node is known.
# For the first node, the fscore is completely heuristic.
start.fscore = hob.heuristic(start)
openSet = PriorityQueue([start])
# The cost of going from start to start is zero.
start.gscore = 0
num_popped = 0
while openSet.queue_length > 0:
current = openSet.pop()
if current == None: # tried to pop but only found old fscore values
break
num_popped += 1
if num_popped % 100000 == 0:
print(str(num_popped)+" positions examined")
if current == goal:
return reconstruct_path(current)
for neighbor in current.neighbors():
# The distance from start to a neighbor
# All nodes are 1 move from their neighbors
tentative_gScore = current.gscore + 1
# update gscore and fscore if this is shorter path
# to the neighbor node
if tentative_gScore < neighbor.gscore:
neighbor.cameFrom = current
neighbor.gscore = tentative_gScore
neighbor.fscore = neighbor.gscore + hob.heuristic(neighbor)
openSet.push(neighbor) # add to open set every time
def find_zero(tiles):
""" file the 0 tile """
for row in range(4):
for col in range(4):
if tiles[row][col] == 0:
return (row, col)
def path_as_0_moves(path):
"""
Takes the path which is a list of Position
objects and outputs it as a string of rlud
directions to match output desired by
Rosetta Code task.
"""
strpath = ""
if len(path) < 1:
return ""
prev_pos = path[0]
p_row, p_col = find_zero(prev_pos.tiles)
for i in range(1,len(path)):
curr_pos = path[i]
c_row, c_col = find_zero(curr_pos.tiles)
if c_row > p_row:
strpath += 'd'
elif c_row < p_row:
strpath += 'u'
elif c_col > p_col:
strpath += 'r'
elif c_col < p_col:
strpath += 'l'
# reset for next loop
prev_pos = curr_pos
p_row = c_row
p_col = c_col
return strpath

38
Task/15-puzzle-solver/Python/15-puzzle-solver-3.py Normal file
View file

@ -0,0 +1,38 @@
"""
Runs one test of the solver passing a
start and goal position.
"""
from astar import *
import time
# Rosetta Code start position
start_tiles = [[ 15, 14, 1, 6],
[ 9, 11, 4, 12],
[ 0, 10, 7, 3],
[13, 8, 5, 2]]
goal_tiles = [[ 1, 2, 3, 4],
[ 5, 6, 7, 8],
[ 9, 10, 11, 12],
[13, 14, 15, 0]]
before = time.perf_counter()
result = a_star(start_tiles,goal_tiles)
after = time.perf_counter()
print(" ")
print("Path length = "+str(len(result) - 1))
print(" ")
print("Path using rlud:")
print(" ")
print(path_as_0_moves(result))
print(" ")
print("Run time in seconds: "+str(after - before))

320
Task/15-puzzle-solver/Racket/15-puzzle-solver.rkt Normal file
View file

@ -0,0 +1,320 @@
#lang racket
;;; Solution to the 15-puzzle game, based on the A* algorithm described
;;; at https://de.wikipedia.org/wiki/A*-Algorithmus
;;; Inspired by the Python solution of the rosetta code:
;;; http://rosettacode.org/wiki/15_puzzle_solver#Python
(require racket/set)
(require data/heap)
;; ----------------------------------------------------------------------------
;; Datatypes
;; A posn is a pair struct containing two integer for the row/col indices.
(struct posn (row col) #:transparent)
;; A state contains a vector and a posn describing the position of the empty slot.
(struct state (matrix empty-slot) #:transparent)
(define directions '(up down left right))
;; A node contains a state, a reference to the previous node, a g value (actual
;; costs until this node, and a f value (g value + heuristics).
(struct node (state prev cost f-value) #:transparent)
;; ----------------------------------------------------------------------------
;; Constants
(define side-size 4)
(define initial-state
(state
#(
15 14 1 6
9 11 4 12
0 10 7 3
13 8 5 2)
(posn 2 0)))
(define goal-state
(state
#( 1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0)
(posn 3 3)))
;; ----------------------------------------------------------------------------
;; Functions
;; Matrices are simple vectors, abstracted by following functions.
(define (matrix-ref matrix row col)
(vector-ref matrix (+ (* row side-size) col)))
(define (matrix-set! matrix row col val)
(vector-set! matrix
(+ (* row side-size) col)
val))
(define (target-state? st)
(equal? st goal-state))
;; Traverse all nodes until the initial state and generate a return a list
;; of symbols describing the path.
(define (reconstruct-movements leaf-node)
;; compute a pair describing the movement.
(define (posn-diff p0 p1)
(posn (- (posn-row p1) (posn-row p0))
(- (posn-col p1) (posn-col p0))))
;; describe a single movement with a symbol (r, l, u d).
(define (find-out-movement prev-st st)
(let ([prev-empty-slot (state-empty-slot prev-st)]
[this-empty-slot (state-empty-slot st)])
(match (posn-diff prev-empty-slot this-empty-slot)
[(posn 1 0) 'u]
[(posn -1 0) 'd]
[(posn 0 1) 'l]
[(posn 0 -1) 'r]
[#f 'invalid])))
(define (iter n path)
(if (or (not n) (not (node-prev n)))
path
(iter (node-prev n)
(cons (find-out-movement (node-state n)
(node-state (node-prev n)))
path))))
(iter leaf-node '()))
(define (print-path path)
(for ([dir (in-list (car path))])
(display dir))
(newline))
;; Return #t if direction is allowed for the given empty slot position.
(define (movement-valid? direction empty-slot)
(match direction
['up (< (posn-row empty-slot) (- side-size 1))]
['down (> (posn-row empty-slot) 0)]
['left (< (posn-col empty-slot) (- side-size 1))]
['right (> (posn-col empty-slot) 0)]))
;; assumes move direction is valid (see movement-valid?).
;; Return a new state in the given direction.
(define (move st direction)
(define m (vector-copy (state-matrix st)))
(define empty-slot (state-empty-slot st))
(define r (posn-row empty-slot))
(define c (posn-col empty-slot))
(define new-empty-slot
(match direction
['up (begin (matrix-set! m r c (matrix-ref m (+ r 1) c))
(matrix-set! m (+ r 1) c 0)
(posn (+ r 1) c))]
['down (begin (matrix-set! m r c (matrix-ref m (- r 1) c))
(matrix-set! m (- r 1) c 0)
(posn (- r 1) c))]
['left (begin (matrix-set! m r c (matrix-ref m r (+ c 1)))
(matrix-set! m r (+ c 1) 0)
(posn r (+ c 1)))]
['right (begin (matrix-set! m r c (matrix-ref m r (- c 1)))
(matrix-set! m r (- c 1) 0)
(posn r (- c 1)))]))
(state m new-empty-slot))
(define (l1-distance posn0 posn1)
(+ (abs (- (posn-row posn0) (posn-row posn1)))
(abs (- (posn-col posn0) (posn-col posn1)))))
;; compute the L1 distance from the current position and the goal position for
;; the given val
(define (element-cost val current-posn)
(if (= val 0)
(l1-distance current-posn (posn 3 3))
(let ([target-row (quotient (- val 1) side-size)]
[target-col (remainder (- val 1) side-size)])
(l1-distance current-posn (posn target-row target-col)))))
;; compute the l1 distance between this state and the goal-state
(define (state-l1-distance-to-goal st)
(define m (state-matrix st))
(for*/fold
([sum 0])
([i (in-range side-size)]
[j (in-range side-size)])
(let ([val (matrix-ref m i j)])
(if (not (= val 0))
(+ sum (element-cost val (posn i j)))
sum))))
;; the heuristic used is the l1 distance to the goal-state + the number of
;; linear conflicts found
(define (state-heuristics st)
(+ (state-l1-distance-to-goal st)
(linear-conflicts st goal-state)))
;; given a list, return the number of values out of order (used for computing
;; linear conflicts).
(define (out-of-order-values lst)
(define (iter val-lst sum)
(if (empty? val-lst)
sum
(let* ([val (car val-lst)]
[rst (cdr val-lst)]
[following-smaller-values
(filter (lambda (val2) (> val2 val))
rst)])
(iter rst (+ sum (length following-smaller-values))))))
(* 2 (iter lst 0)))
;; Number of conflicts in the given row. A conflict happens, when two elements
;; are already in the correct row, but in the wrong order.
;; For each conflicted pair add 2 to the value, but a maximum of 6.
(define (row-conflicts row st0 st1)
(define m0 (state-matrix st0))
(define m1 (state-matrix st1))
(define values-in-correct-row
(for/fold
([lst '()])
([col0 (in-range side-size)])
(let* ([val0 (matrix-ref m0 row col0)]
[in-goal-row?
(for/first ([col1 (in-range side-size)]
#:when (= val0 (matrix-ref m1 row col1)))
#t)])
(if in-goal-row? (cons val0 lst) lst))))
(min 6 (out-of-order-values
; 0 doesn't lead to a linear conflict
(filter positive? values-in-correct-row))))
;; Number of conflicts in the given row. A conflict happens, when two elements
;; are already in the correct column but in the wrong order.
;; For each conflicted pair add 2 to the value, but a maximum of 6, so that
;; the heuristic doesn't overestimate the actual costs.
(define (col-conflicts col st0 st1)
(define m0 (state-matrix st0))
(define m1 (state-matrix st1))
(define values-in-correct-col
(for/fold
([lst '()])
([row0 (in-range side-size)])
(let* ([val0 (matrix-ref m0 row0 col)]
[in-goal-col?
(for/first ([row1 (in-range side-size)]
#:when (= val0 (matrix-ref m1 row1 col)))
#t)])
(if in-goal-col? (cons val0 lst) lst))))
(min 6 (out-of-order-values
; 0 doesn't lead to a linear conflict
(filter positive? values-in-correct-col))))
(define (all-row-conflicts st0 st1)
(for/fold ([sum 0])
([row (in-range side-size)])
(+ (row-conflicts row st0 st1) sum)))
(define (all-col-conflicts st0 st1)
(for/fold ([sum 0])
([col (in-range side-size)])
(+ (col-conflicts col st0 st1) sum)))
(define (linear-conflicts st0 st1)
(+ (all-row-conflicts st0 st1) (all-col-conflicts st0 st1)))
;; Return a list of pairs containing the possible next node and the movement
;; direction needed.
(define (next-state-dir-pairs current-node)
(define st (node-state current-node))
(define empty-slot (state-empty-slot st))
(define valid-movements
(filter (lambda (dir) (movement-valid? dir empty-slot))
directions))
(map (lambda (dir)
(cons (move st dir) dir))
valid-movements))
;; Helper function to pretty-print a state
(define (display-state st)
(define m (state-matrix st))
(begin
(for ([i (in-range 0 side-size 1)])
(newline)
(for ([j (in-range 0 side-size 1)])
(printf "~a\t" (matrix-ref m i j))))
(newline)))
(define (A* initial-st)
(define (compare-nodes n0 n1)
(<= (node-f-value n0) (node-f-value n1)))
(define open-lst (make-heap compare-nodes))
(define initial-st-cost (state-heuristics initial-st))
(heap-add! open-lst (node initial-st #f 0 (state-heuristics initial-st)))
(define closed-set (mutable-set))
(define (pick-next-node!)
(define next-node (heap-min open-lst))
(heap-remove-min! open-lst)
next-node)
(define (sort-lst lst)
(sort lst
(lambda (n0 n1)
(< (node-f-value n0) (node-f-value n1)))))
(define (expand-node n)
(define n-cost (node-cost n))
(define (iter lst)
(if (empty? lst)
'()
(let* ([succ (car lst)]
[succ-st (car succ)]
[succ-dir (cdr succ)]
[succ-cost (+ 1 n-cost)])
(if (set-member? closed-set succ-st)
(iter (cdr lst))
(begin (heap-add! open-lst
(node succ-st
n
succ-cost
(+ (state-heuristics succ-st)
succ-cost)))
(iter (cdr lst)))))))
(let ([successors (next-state-dir-pairs n)])
(iter successors)))
(define counter 0)
(define (loop)
(define current-node (pick-next-node!))
(define current-state (node-state current-node))
(set! counter (+ counter 1))
(if (= (remainder counter 100000) 0)
(printf "~a ~a ~a\n" counter
(heap-count open-lst)
(node-cost current-node))
(void))
(cond [(target-state? current-state)
(let ([path (reconstruct-movements current-node)])
(cons path (length path)))]
[else
(begin (set-add! closed-set (node-state current-node))
(expand-node current-node)
(if (= (heap-count open-lst) 0)
#f
(loop)))]))
(loop))
(module+ main
(print-path (A* initial-state)))

68
Task/15-puzzle-solver/Raku/15-puzzle-solver.raku Normal file
View file

@ -0,0 +1,68 @@
# 20210623 Raku programming solution vCSMt9hkak0
constant \Nr = <3 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3>;
constant \Nc = <3 0 1 2 3 0 1 2 3 0 1 2 3 0 1 2>;
my ($n,$m) = 0,0 ;
my @N0 is default(0);
my @N3 is default(0);
my @N4 is default(0);
my @N2 is default(0);
sub fY() {
if @N2[$n] == 0x123456789abcdef0 {
say "Solution found in ", $n, " moves: ", [~] @N3[1..$n] and exit();
}
return @N4[$n] ≤ $m ?? fN() !! False ;
}
sub fN() {
sub common { ++$n; return True if fY(); --$n }
if (@N3[$n] ne 'u' && @N0[$n] div 4 < 3) { fI() and common }
if (@N3[$n] ne 'd' && @N0[$n] div 4 > 0) { fG() and common }
if (@N3[$n] ne 'l' && @N0[$n] % 4 < 3) { fE() and common }
if (@N3[$n] ne 'r' && @N0[$n] % 4 > 0) { fL() and common }
return False;
}
sub fI() {
my \g = (11-@N0[$n])*4;
my \a = @N2[$n] +& (15 +< g);
@N0[$n+1]=@N0[$n]+4;
@N2[$n+1]=@N2[$n]-a+(a+<16);
@N3[$n+1]='d';
@N4[$n+1]=@N4[$n]+(Nr[a+>g] ≤ @N0[$n] div 4 ?? 0 !! 1);
}
sub fG() {
my \g = (19-@N0[$n])*4;
my \a = @N2[$n] +& (15 +< g);
@N0[$n+1]=@N0[$n]-4;
@N2[$n+1]=@N2[$n]-a+(a+>16);
@N3[$n+1]='u';
@N4[$n+1]=@N4[$n]+(Nr[a+>g] ≥ @N0[$n] div 4 ?? 0 !! 1);
}
sub fE() {
my \g = (14-@N0[$n])*4;
my \a = @N2[$n] +& (15 +< g);
@N0[$n+1]=@N0[$n]+1;
@N2[$n+1]=@N2[$n]-a+(a+<4);
@N3[$n+1]='r';
@N4[$n+1]=@N4[$n]+(Nc[a+>g] ≤ @N0[$n]%4 ?? 0 !! 1);
}
sub fL(){
my \g = (16-@N0[$n])*4;
my \a = @N2[$n] +& (15 +< g);
@N0[$n+1]=@N0[$n]-1;
@N2[$n+1]=@N2[$n]-a+(a+>4);
@N3[$n+1]='l';
@N4[$n+1]=@N4[$n]+(Nc[a+>g] ≥ @N0[$n]%4 ?? 0 !! 1);
}
sub fifteenSolver(\n, \g){@N0[0]=n; @N2[0]=g}
fifteenSolver(8,0xfe169b4c0a73d852);
loop { fY() or ++$m }

202
Task/15-puzzle-solver/Rust/15-puzzle-solver-1.rust Normal file
View file

@ -0,0 +1,202 @@
const NR: [i32; 16] = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3];
const NC: [i32; 16] = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2];
const I: u8 = 1;
const G: u8 = 8;
const E: u8 = 2;
const L: u8 = 4;
struct FifteenSolver {
n: usize,
limit: usize,
n0: [i32; 85],
n3: [u8; 85],
n4: [usize; 85],
n2: [u64; 85],
}
impl FifteenSolver {
fn f_y(&mut self) -> bool {
if self.n2[self.n] == 0x123456789abcdef0 {
return true;
}
if self.n4[self.n] <= self.limit {
return self.f_n();
}
false
}
fn f_z(&mut self, w: u8) -> bool {
if w & I != 0 {
self.f_i();
if self.f_y() {
return true;
}
self.n -= 1;
}
if w & G != 0 {
self.f_g();
if self.f_y() {
return true;
}
self.n -= 1;
}
if w & E != 0 {
self.f_e();
if self.f_y() {
return true;
}
self.n -= 1;
}
if w & L != 0 {
self.f_l();
if self.f_y() {
return true;
}
self.n -= 1;
}
false
}
fn f_n(&mut self) -> bool {
self.f_z(match self.n0[self.n] {
0 => match self.n3[self.n] {
b'l' => I,
b'u' => E,
_ => I + E,
},
3 => match self.n3[self.n] {
b'r' => I,
b'u' => L,
_ => I + L,
},
1 | 2 => match self.n3[self.n] {
b'l' => I + L,
b'r' => I + E,
b'u' => E + L,
_ => L + E + I,
},
12 => match self.n3[self.n] {
b'l' => G,
b'd' => E,
_ => E + G,
},
15 => match self.n3[self.n] {
b'r' => G,
b'd' => L,
_ => G + L,
},
13 | 14 => match self.n3[self.n] {
b'l' => G + L,
b'r' => E + G,
b'd' => E + L,
_ => G + E + L,
},
4 | 8 => match self.n3[self.n] {
b'l' => I + G,
b'u' => G + E,
b'd' => I + E,
_ => I + G + E,
},
7 | 11 => match self.n3[self.n] {
b'd' => I + L,
b'u' => G + L,
b'r' => I + G,
_ => I + G + L,
},
_ => match self.n3[self.n] {
b'd' => I + E + L,
b'l' => I + G + L,
b'r' => I + G + E,
b'u' => G + E + L,
_ => I + G + E + L,
},
})
}
fn f_i(&mut self) {
let g = (11 - self.n0[self.n]) * 4;
let a = self.n2[self.n] & (15u64 << g);
self.n0[self.n + 1] = self.n0[self.n] + 4;
self.n2[self.n + 1] = self.n2[self.n] - a + (a << 16);
self.n3[self.n + 1] = b'd';
self.n4[self.n + 1] = self.n4[self.n];
let cond = NR[(a >> g) as usize] <= self.n0[self.n] / 4;
if !cond {
self.n4[self.n + 1] += 1;;
}
self.n += 1;
}
fn f_g(&mut self) {
let g = (19 - self.n0[self.n]) * 4;
let a = self.n2[self.n] & (15u64 << g);
self.n0[self.n + 1] = self.n0[self.n] - 4;
self.n2[self.n + 1] = self.n2[self.n] - a + (a >> 16);
self.n3[self.n + 1] = b'u';
self.n4[self.n + 1] = self.n4[self.n];
let cond = NR[(a >> g) as usize] >= self.n0[self.n] / 4;
if !cond {
self.n4[self.n + 1] += 1;
}
self.n += 1;
}
fn f_e(&mut self) {
let g = (14 - self.n0[self.n]) * 4;
let a = self.n2[self.n] & (15u64 << g);
self.n0[self.n + 1] = self.n0[self.n] + 1;
self.n2[self.n + 1] = self.n2[self.n] - a + (a << 4);
self.n3[self.n + 1] = b'r';
self.n4[self.n + 1] = self.n4[self.n];
let cond = NC[(a >> g) as usize] <= self.n0[self.n] % 4;
if !cond {
self.n4[self.n + 1] += 1;
}
self.n += 1;
}
fn f_l(&mut self) {
let g = (16 - self.n0[self.n]) * 4;
let a = self.n2[self.n] & (15u64 << g);
self.n0[self.n + 1] = self.n0[self.n] - 1;
self.n2[self.n + 1] = self.n2[self.n] - a + (a >> 4);
self.n3[self.n + 1] = b'l';
self.n4[self.n + 1] = self.n4[self.n];
let cond = NC[(a >> g) as usize] >= self.n0[self.n] % 4;
if !cond {
self.n4[self.n + 1] += 1;
}
self.n += 1;
}
fn new(n: i32, g: u64) -> Self {
let mut solver = FifteenSolver {
n: 0,
limit: 0,
n0: [0; 85],
n3: [0; 85],
n4: [0; 85],
n2: [0; 85],
};
solver.n0[0] = n;
solver.n2[0] = g;
solver
}
fn solve(&mut self) {
while !self.f_n() {
self.n = 0;
self.limit += 1;
}
println!(
"Solution found in {} moves: {}",
self.n,
std::str::from_utf8(&self.n3[1..=self.n]).unwrap()
);
}
}
fn main() {
FifteenSolver::new(8, 0xfe169b4c0a73d852).solve();
}

166
Task/15-puzzle-solver/Rust/15-puzzle-solver-2.rust Normal file
View file

@ -0,0 +1,166 @@
use keyed_priority_queue::KeyedPriorityQueue;
use std::cmp::{Ord, Ordering, PartialOrd, Reverse};
static CORRECT_ORDER: [u8; 16] = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0];
static ROW: [i32; 16] = [0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3];
static COLUMN: [i32; 16] = [0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3];
#[derive(Debug, Clone)]
struct State {
est_tot_moves: u8,
moves: String,
est_moves_rem: u8,
}
impl PartialOrd for State {
fn partial_cmp(&self, other: &Self) -> Option<Ordering> {
Some(self.est_tot_moves.cmp(&other.est_tot_moves))
}
}
impl Eq for State {}
impl PartialEq for State {
fn eq(&self, other: &Self) -> bool {
self.est_tot_moves.cmp(&other.est_tot_moves) == Ordering::Equal
}
}
impl Ord for State {
fn cmp(&self, other: &Self) -> Ordering {
self.est_tot_moves
.partial_cmp(&other.est_tot_moves)
.unwrap()
}
}
impl State {
fn init(order: &[u8; 16]) -> State {
State {
est_tot_moves: State::estimate_moves(&order),
moves: String::from(""),
est_moves_rem: 0,
}
}
fn find_index(order: &[u8; 16], tile: &u8) -> usize {
order.iter().position(|&x| x == *tile).unwrap()
}
fn estimate_moves(current: &[u8; 16]) -> u8 {
let mut h = 0;
for tile in current.iter() {
let current_index = State::find_index(current, &tile);
let correct_index = State::find_index(&CORRECT_ORDER, &tile);
h += ((COLUMN[current_index] - COLUMN[correct_index]).abs()
+ (ROW[current_index] - ROW[correct_index]).abs()) as u8;
}
h
}
fn make_move(
&self,
order: &[u8; 16],
dir: fn(usize, [u8; 16]) -> ([u8; 16], String),
) -> ([u8; 16], State) {
let est_moves_rem = State::estimate_moves(order);
let (new_order, from) = dir(State::find_index(order, &0), *order);
let moves = format!("{}{}", self.moves, from);
let new_state = State {
est_tot_moves: moves.len() as u8 + est_moves_rem,
moves,
est_moves_rem,
};
return (new_order, new_state);
}
fn left(index: usize, mut order: [u8; 16]) -> ([u8; 16], String) {
order.swap(index, index - 1);
return (order, String::from("l"));
}
fn right(index: usize, mut order: [u8; 16]) -> ([u8; 16], String) {
order.swap(index, index + 1);
return (order, String::from("r"));
}
fn up(index: usize, mut order: [u8; 16]) -> ([u8; 16], String) {
order.swap(index, index - 4);
return (order, String::from("u"));
}
fn down(index: usize, mut order: [u8; 16]) -> ([u8; 16], String) {
order.swap(index, index + 4);
return (order, String::from("d"));
}
fn children(&self, order: &[u8; 16]) -> Vec<([u8; 16], State)> {
let index = State::find_index(order, &0);
let mut new_states: Vec<([u8; 16], State)> = Vec::new();
if COLUMN[index] > 0 {
new_states.push(self.make_move(order, State::left))
}
if COLUMN[index] < 3 {
new_states.push(self.make_move(order, State::right))
}
if ROW[index] > 0 {
new_states.push(self.make_move(order, State::up))
}
if ROW[index] < 3 {
new_states.push(self.make_move(order, State::down))
}
new_states
}
}
fn main() {
let mut open_states = KeyedPriorityQueue::<[u8; 16], Reverse<State>>::new();
let start_order = [15, 14, 1, 6, 9, 11, 4, 12, 0, 10, 7, 3, 13, 8, 5, 2];
// let start_order = [0, 1, 2, 3, 5, 6, 7, 4, 9, 10, 11, 8, 13, 14, 15, 12];
open_states.push(start_order, Reverse(State::init(&start_order)));
let mut closed_states = KeyedPriorityQueue::<[u8; 16], Reverse<State>>::new();
'outer: while let Some((parent_order, Reverse(parent_state))) = open_states.pop() {
for (child_order, child_state) in parent_state.children(&parent_order) {
match (
open_states.get_priority(&child_order).as_ref(),
closed_states.get_priority(&child_order).as_ref(),
) {
(None, None) => {
if child_order == CORRECT_ORDER {
println!("There are {} entries in the open list.", open_states.len());
println!(
"There are {} entries in the closed list.",
closed_states.len()
);
println!(
"Reaching the final board took {} moves.",
child_state.moves.len()
);
println!("The moves used were {}.", child_state.moves);
println!(
"The final order is:\n{:?}\n{:?}\n{:?}\n{:?}.",
&child_order[0..4],
&child_order[4..8],
&child_order[8..12],
&child_order[12..16]
);
break 'outer;
}
open_states.push(child_order, Reverse(child_state.clone()));
}
(Some(&Reverse(open_state)), None)
if open_state.moves.len() > child_state.moves.len() =>
{
open_states.set_priority(&child_order, Reverse(child_state.clone()));
}
// (None, Some(&Reverse(closed_state))) if closed_state.moves.len() > child_state.moves.len() => {
// closed_states.remove_item(&child_order);
// open_states.push(child_order, Reverse(child_state.clone()));
// },
_ => {}
};
}
closed_states.push(parent_order, Reverse(parent_state));
}
}

97
Task/15-puzzle-solver/Scala/15-puzzle-solver.scala Normal file
View file

@ -0,0 +1,97 @@
import scala.collection.mutable
case class Board(table: Array[Int], r: Int, c: Int, parent: List[String] = List()) {
def cloneSwap(r: Int, c: Int, rr: Int, cc: Int) = {
val cTable = table.clone
// Fancy way to access table(r)(c) in linear array
// Equivalent with cTable(r*4 + c)
cTable(r << 2 | c) = table(rr << 2 | cc)
cTable(rr << 2 | cc) = table(r << 2 | c)
cTable
}
def up() =
if (r > 0) { Some(Board(cloneSwap(r, c, r - 1, c), r - 1, c, "u" :: parent))
} else None
def down() =
if (r < 3) { Some(Board(cloneSwap(r, c, r + 1, c), r + 1, c, "d" :: parent))
} else None
def left() =
if (c > 0) { Some(Board(cloneSwap(r, c, r, c - 1), r, c - 1, "l" :: parent))
} else None
def right() =
if (c < 3) { Some(Board(cloneSwap(r, c, r, c + 1), r, c + 1, "r" :: parent))
} else None
def format: String = {
table.sliding(4, 4).toList.map(_.map(i ⇒ f"$i%4d").mkString).mkString("\n")
}
// Manhattan distance
def heuristic() = {
val posF = Board.finalBoard.positionMap
val posT = positionMap
var res = 0;
for (i ← 0 to 15) {
val (x, y) = posF(i)
val (xx, yy) = posT(i)
res += (Math.abs(x - xx) + Math.abs(y - yy))
}
res
}
def key = table.mkString(",")
def travelled() = parent.length
// Find children/neighbours, flatten eliminates the empty boundaries
def children: List[Board] = List(this.up(), this.down(), this.right(), this.left()).flatten
// Map number to positions
lazy val positionMap: Map[Int, (Int, Int)] = {
val res = mutable.Map[Int, (Int, Int)]()
for (x ← 0 to 3; y ← 0 to 3) {
res(table(x << 2 | y)) = (x, y)
}
res.toMap
}
}
import Board._
object Solver extends App {
def solve(initBoard: Board, wTravel:Int, wHeuristic: Int ) {
// Setup weights for the heuristic, more weight to heuristic faster but longer solution.
def aStar(b: Board) = wHeuristic * b.heuristic() + wTravel * b.travelled()
implicit val ob = new Ordering[Board] {
override def compare(x: Board, y: Board) = {
aStar(y) - aStar(x)
}
}
val start = System.currentTimeMillis()
var found = false
var head = initBoard
val pq: mutable.PriorityQueue[Board] = new mutable.PriorityQueue()
pq.enqueue(head)
val visited = mutable.HashSet[String]()
var explore = 0
while (pq.nonEmpty && !found) {
head = pq.dequeue()
visited.add(head.key)
if (!head.key.equals(finalBoard.key)) {
val newChildren = head.children.filter(child ⇒ !visited.contains(child.key))
visited ++= (newChildren.map(_.key))
pq.enqueue(newChildren: _*)
explore += 1
} else found = true
if (explore % 5000 == 0)
println(s"# $explore: A* ${aStar(head)} g:${head.travelled()} h:${head.heuristic()}")
}
if (found) {
println(s"Exploring $explore states, solution with length ${head.parent.length}.")
println(s"Weighted heuristic used $wHeuristic * heuristic + $wTravel * travel.")
println(initBoard.format)
println(head.parent.mkString.reverse)
}
println("Total time: " + (System.currentTimeMillis() - start) / 1000.0 + " seconds")
}
solve(startEasy, 4, 5)
solve(startHard, 1, 2 )
}
object Board {
val finalBoard = Board(Array(Array(1, 2, 3, 4), Array(5, 6, 7, 8), Array(9, 10, 11, 12), Array(13, 14, 15, 0)).flatten, 3, 3)
val startEasy = Board(Array(Array(15, 14, 1, 6), Array(9, 11, 4, 12), Array(0, 10, 7, 3), Array(13, 8, 5, 2)).flatten, 2, 0)
val startHard = Board(Array(Array(0, 12, 9, 13), Array(15, 11, 10, 14), Array(3, 7, 2, 5), Array(4, 8, 6, 1)).flatten, 0, 0)
}

175
Task/15-puzzle-solver/Wren/15-puzzle-solver.wren Normal file
View file

@ -0,0 +1,175 @@
import "/long" for ULong
var Nr = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
var Nc = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]
var n = 0
var n1 = 0
var N0 = List.filled(85, 0)
var N2 = List.filled(85, 0)
var N3 = List.filled(85, 0)
var N4 = List.filled(85, 0)
var i = 1
var g = 8
var e = 2
var l = 4
var fN // forward declaration
var xx = ULong.fromBaseString("123456789abcdef0", 16)
var fifteen = ULong.new(15)
var fY = Fn.new {
if (N2[n] == xx ) return true
if (N4[n] <= n1) return fN.call()
return false
}
var fI = Fn.new {
var g = (11 - N0[n]) * 4
var a = N2[n] & (fifteen << g)
N0[n+1] = N0[n] + 4
N2[n+1] = N2[n] - a + (a << 16)
N3[n+1] = "d"
N4[n+1] = N4[n]
var cond = Nr[(a >> g).toSmall] <= (N0[n] >> 2)
if (!cond) N4[n+1] = N4[n+1] + 1
n = n + 1
}
var fG = Fn.new {
var g = (19 - N0[n]) * 4
var a = N2[n] & (fifteen << g)
N0[n+1] = N0[n] - 4
N2[n+1] = N2[n] - a + (a >> 16)
N3[n+1] = "u"
N4[n+1] = N4[n]
var cond = Nr[(a >> g).toSmall] >= (N0[n] >> 2)
if (!cond) N4[n+1] = N4[n+1] + 1
n = n + 1
}
var fE = Fn.new {
var g = (14 - N0[n]) * 4
var a = N2[n] & (fifteen << g)
N0[n+1] = N0[n] + 1
N2[n+1] = N2[n] - a + (a << 4)
N3[n+1] = "r"
N4[n+1] = N4[n]
var cond = Nc[(a >> g).toSmall] <= N0[n] % 4
if (!cond) N4[n+1] = N4[n+1] + 1
n = n + 1
}
var fL = Fn.new {
var g = (16 - N0[n]) * 4
var a = N2[n] & (fifteen << g)
N0[n+1] = N0[n] - 1
N2[n+1] = N2[n] - a + (a >> 4)
N3[n+1] = "l"
N4[n+1] = N4[n]
var cond = Nc[(a >> g).toSmall] >= N0[n] % 4
if (!cond) N4[n+1] = N4[n+1] + 1
n = n + 1
}
var fZ = Fn.new { |w|
if (w&i > 0) {
fI.call()
if (fY.call()) return true
n = n - 1
}
if (w&g > 0) {
fG.call()
if (fY.call()) return true
n = n - 1
}
if (w&e > 0) {
fE.call()
if (fY.call()) return true
n = n - 1
}
if (w&l > 0) {
fL.call()
if (fY.call()) return true
n = n - 1
}
return false
}
fN = Fn.new {
var p0 = N0[n]
if (p0 == 0) {
var p3 = N3[n]
if (p3 == "l") return fZ.call(i)
if (p3 == "u") return fZ.call(e)
return fZ.call(i + e)
} else if (p0 == 3) {
var p3 = N3[n]
if (p3 == "r") return fZ.call(i)
if (p3 == "u") return fZ.call(l)
return fZ.call(i + l)
} else if (p0 == 1 || p0 == 2) {
var p3 = N3[n]
if (p3 == "l") return fZ.call(i + l)
if (p3 == "r") return fZ.call(i + e)
if (p3 == "u") return fZ.call(e + l)
return fZ.call(l + e + i)
} else if (p0 == 12) {
var p3 = N3[n]
if (p3 == "l") return fZ.call(g)
if (p3 == "d") return fZ.call(e)
return fZ.call(e + g)
} else if (p0 == 15) {
var p3 = N3[n]
if (p3 == "r") return fZ.call(g)
if (p3 == "d") return fZ.call(l)
return fZ.call(g + l)
} else if (p0 == 13 || p0 == 14) {
var p3 = N3[n]
if (p3 == "l") return fZ.call(g + l)
if (p3 == "r") return fZ.call(e + g)
if (p3 == "d") return fZ.call(e + l)
return fZ.call(g + e + l)
} else if (p0 == 4 || p0 == 8) {
var p3 = N3[n]
if (p3 == "l") return fZ.call(i + g)
if (p3 == "u") return fZ.call(g + e)
if (p3 == "d") return fZ.call(i + e)
return fZ.call(i + g + e)
} else if (p0 == 7 || p0 == 11) {
var p3 = N3[n]
if (p3 == "d") return fZ.call(i + l)
if (p3 == "u") return fZ.call(g + l)
if (p3 == "r") return fZ.call(i + g)
return fZ.call(i + g + l)
} else {
var p3 = N3[n]
if (p3 == "d") return fZ.call(i + e + l)
if (p3 == "l") return fZ.call(i + g + l)
if (p3 == "r") return fZ.call(i + g + e)
if (p3 == "u") return fZ.call(g + e + l)
return fZ.call(i + g + e + l)
}
}
var fifteenSolver = Fn.new { |n, g|
N0[0] = n
N2[0] = g
N4[0] = 0
}
var solve // recursive function
solve = Fn.new {
if (fN.call()) {
System.print("Solution found in %(n) moves: ")
for (g in 1..n) System.write(N3[g])
System.print()
} else {
n = 0
n1 = n1 + 1
solve.call()
}
}
fifteenSolver.call(8, ULong.fromBaseString("fe169b4c0a73d852", 16))
solve.call()