Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
467
Task/15-puzzle-solver/PowerBASIC/15-puzzle-solver.basic
Normal file
467
Task/15-puzzle-solver/PowerBASIC/15-puzzle-solver.basic
Normal 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue