RosettaCodeData/Task/15-puzzle-solver/FutureBasic/15-puzzle-solver.basic

166 lines
3.1 KiB
Plaintext

// 15 Puzzle Solver
//https://rosettacode.org/wiki/15_puzzle_solver
// Requires FutureBasic 7.0.30 or later
begin globals
int Nr(15), Nc(15), n, un, N0(99), N3(99), N4(99)
UInt64 N2(99)
end globals
def fn fY as BOOL
void def fn fI
void def fn fG
void def fn fE
void def fn fL
local fn fN1 as BOOL
if ( N3(n) != _"u" && N0(n) / 4 < 3 )
fn fI
n++
if ( fn fY ) then return YES
n--
end if
if ( N3(n) != _"d" && N0(n) / 4 > 0 )
fn fG
n++
if ( fn fY ) then return YES
n--
end if
if ( N3(n) != _"l" && N0(n) % 4 < 3 )
fn fE
n++
if ( fn fY ) then return YES
n--
end if
if ( N3(n) != _"r" && N0(n) %4 > 0 )
fn fL
n++
if ( fn fY ) then return YES
n--
end if
end fn = NO
void local fn fI
int g = ( 11 - N0(n)) * 4
UInt64 a = N2(n) & ((UInt64)15 << g)
N0(n + 1) = N0(n) + 4
N2(n + 1) = N2(n) - a + (a << 16)
N3(n + 1) = _"d"
if ( Nr(a >> g) <= N0(n) / 4 )
N4(n + 1) = N4(n)
else
N4(n + 1) = N4(n) + 1
end if
end fn
void local fn fG
int g = (19 - N0(n)) * 4
UInt64 a = N2(n) & ((UInt64)15 << g)
N0(n + 1) = N0(n) - 4
N2(n + 1) = N2(n) - a + (a >> 16)
N3(n + 1) = _"u"
if ( Nr(a >> g) >= N0(n) / 4 )
N4(n + 1) = N4(n)
else
N4(n + 1) = N4(n) + 1
end if
end fn
void local fn fE
int g = (14 - N0(n)) * 4
UInt64 a = N2(n) & ((UInt64)15 << g)
N0(n + 1) = N0(n) + 1
N2(n + 1) = N2(n) - a + (a << 4)
N3(n + 1) = _"r"
if ( Nc(a >> g) <= N0(n) % 4 )
N4(n + 1) = N4(n)
else
N4(n + 1) = N4(n) + 1
end if
end fn
void local fn fL
int g = (16 - N0(n)) * 4
UInt64 a = N2(n) & ((UInt64)15 << g)
N0(n + 1) = N0(n) - 1
N2(n + 1) = N2(n) - a + (a >> 4)
N3(n + 1) = _"l"
if ( Nc(a >> g) >= N0(n) % 4 )
N4(n + 1) = N4(n)
else
N4(n + 1) = N4(n) + 1
end if
end fn
local fn fY as BOOL
if ( N4(n) < un ) then return fn fN1
if ( N2(n) == 0x123456789abcdef0 )
printf @"Solution found in %d moves:",n
for int g = 1 to n
printf @"%c\b",N3(g)
next
print
return YES
end if
if ( N4(n) == un ) then return fn fN1
end fn = NO
void local fn Solve( initN as int, initG as UInt64 )
int tempNr(15) = {3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3}
int tempNc(15) = {3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2}
fn memcpy(@Nr(0),@tempNr(0),sizeof(int)*16)
fn memcpy(@Nc(0),@tempNc(0),sizeof(int)*16)
n = 0
un = 0
N0(0) = initN
N2(0) = initG
while ( !fn fY )
un++
wend
end fn
window 1, @"15 Puzzle Solver"
windowcenter(1)
WindowSetBackgroundColor(1,fn ColorBlack)
text ,14,fn colorWhite
Print "Puzzle: "; "fe169b4c0a73d852"
text ,14,fn colorYellow
print
print @"15 14 1 6"
print @" 9 11 4 12"
print @" 0 10 7 3"
print @"13 8 5 2"
print
text ,14,fn colorWhite
CFStringRef ComputerChip = unix @"sysctl -n machdep.cpu.brand_string"
CFTimeInterval t : t = fn CACurrentMediaTime
fn Solve( 8, 0xfe169b4c0a73d852 )
CFTimeInterval CurrentTime = fn CACurrentMediaTime-t
print
text ,14,fn colorYellow
print
print @" 1 2 3 4"
print @" 5 6 7 8"
print @" 9 10 11 12"
print @"13 14 15 0"
print
text ,14,fn colorWhite
print : printf @"Compute time: %.3f seconds",(CurrentTime)
print ComputerChip
HandleEvents