468 lines
11 KiB
Plaintext
468 lines
11 KiB
Plaintext
' 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
|