15 puzzle solver: Difference between revisions
Content added Content deleted
Line 6,316: | Line 6,316: | ||
You could probably make solve() iterative rather than recursive, and then go all full-on-inline-assembly on it... |
You could probably make solve() iterative rather than recursive, and then go all full-on-inline-assembly on it... |
||
=={{header|PowerBASIC}}== |
|||
Works with PowerBASIC 6 Console Compiler |
|||
{{trans|Go}} |
|||
<lang PowerBASIC> |
|||
' 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 treats only signed 64 bit integers (quad); |
|||
' 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 |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Iterative Depth A*=== |
===Iterative Depth A*=== |