Anonymous user
15 puzzle solver: Difference between revisions
→{{header|PowerBASIC}}
Line 6,315:
Extrapolating from 0.5s/4hrs of C++, as-is this would probably take at least 3 days to solve the extra credit...<br>
You could probably make solve() iterative rather than recursive, and then go all full-on-inline-assembly on it...
=={{header|
===Iterative Depth A*===
From https://codegolf.stackexchange.com/questions/6884/solve-the-15-puzzle-the-tile-sliding-puzzle
Line 7,906 ⟶ 7,435:
Run time in seconds: 56.601139201
</pre>
=={{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|Racket}}==
| |||