Sudoku: Difference between revisions

Content added Content deleted
m (→‎{{header|FutureBasic}}: Remove unsupported 'ConsoleWindow)
m (→‎{{header|FutureBasic}}: remove 'dim as' and update millisecond timer)
Line 5,297: Line 5,297:
More code in this one, but faster execution:
More code in this one, but faster execution:
<pre>
<pre>
include "ConsoleWindow"
include "Tlbx Timer.incl"

begin globals
begin globals
_digits = 9
_digits = 9
Line 5,308: Line 5,305:


begin record Board
begin record Board
dim as boolean f(_digits,_digits,_digits)
Boolean f(_digits,_digits,_digits)
dim as char match(_digits,_digits)
char match(_digits,_digits)
dim as pointer previousBoard // singly-linked list used to discover repetitions
pointer previousBoard // singly-linked list used to discover repetitions
dim &&
dim &&
end record
end record


dim quiz as board
Board quiz
CFTimeInterval t
dim as long t
dim as double sProgStartTime

end globals
end globals


// 'ordinary' timer used for playing
local fn Milliseconds as long // time in ms since prog start
'~'1
dim as UnsignedWide us

long if ( sProgStartTime == 0.0 )
Microseconds( @us )
sProgStartTime = 4294967296.0*us.hi + us.lo
end if
Microseconds( @us )
end fn = (4294967296.0*us.hi + us.lo - sProgStartTime)'*1e-3

local fn InitMilliseconds
'~'1
sProgStartTime = 0.0
fn Milliseconds
end fn


local mode
local mode
local fn CopyBoard( source as ^Board, dest as ^Board )
local fn CopyBoard( source as ^Board, dest as ^Board )
BlockMoveData( source, dest, sizeof( Board ) )
'~'1
dest.previousBoard = source // linked list
BlockMoveData( source, dest, sizeof( Board ) )
dest.previousBoard = source // linked list
end fn
end fn


local fn prepare( b as ^Board )
local fn prepare( b as ^Board )
short i, j, n
'~'1
dim as short i, j, n
for i = 1 to _digits

for i = 1 to _digits
for j = 1 to _digits
for j = 1 to _digits
for n = 1 to _digits
b.match[i, j] = 0
for n = 1 to _digits
b.match[i, j] = 0
b.f[i, j, n] = _true
next n
b.f[i, j, n] = _true
next n
next j
next j
next i
next i
end fn
end fn


local fn printBoard( b as ^Board )
local fn printBoard( b as ^Board )
short i, j
'~'1
dim as short i, j
for i = 1 to _digits

for i = 1 to _digits
for j = 1 to _digits
Print b.match[i, j];
for j = 1 to _digits
next j
Print b.match[i, j];
print
next j
next i
print
next i
end fn
end fn


local fn verifica( b as ^Board )
local fn verifica( b as ^Board )
short i, j, n, first, x, y, ii
'~'1
Boolean check
dim as short i, j, n, first, x, y, ii
dim as boolean check
check = _true

check = _true
for i = 1 to _digits

for i = 1 to _digits
for j = 1 to _digits
if ( b.match[i, j] == 0 )
for j = 1 to _digits
check = _false
long if ( b.match[i, j] == 0 )
for n = 1 to _digits
check = _false
if ( b.f[i, j, n] != _false )
for n = 1 to _digits
check = _true
long if ( b.f[i, j, n] != _false )
end if
check = _true
next n
end if
if ( check == _false ) then exit fn
next n
end if
if ( check == _false ) then exit fn
next j
end if
next j
next i
next i
check = _true

for j = 1 to _digits
check = _true
for j = 1 to _digits
for n = 1 to _digits
for n = 1 to _digits
first = 0
for i = 1 to _digits
first = 0
if ( b.match[i, j] == n )
for i = 1 to _digits
long if ( b.match[i, j] == n )
if ( first == 0 )
long if ( first == 0 )
first = i
else
first = i
check = _false
xelse
exit fn
check = _false
end if
exit fn
end if
end if
next i
end if
next i
next n
next n
next j
next j
for i = 1 to _digits

for i = 1 to _digits
for n = 1 to _digits
for n = 1 to _digits
first = 0
for j = 1 to _digits
first = 0
if ( b.match[i, j] == n )
for j = 1 to _digits
long if ( b.match[i, j] == n )
if ( first == 0 )
long if ( first == 0 )
first = j
else
first = j
check = _false
xelse
exit fn
check = _false
end if
exit fn
end if
end if
next j
end if
next j
next n
next n
next i
next i
for x = 0 to ( _nSetH - 1 )

for x = 0 to ( _nSetH - 1 )
for y = 0 to ( _nSetV - 1 )
for y = 0 to ( _nSetV - 1 )
first = 0
for ii = 0 to ( _digits - 1 )
first = 0
i = x * _setH + ii mod _setH + 1
for ii = 0 to ( _digits - 1 )
i = x * _setH + ii mod _setH + 1
j = y * _setV + ii / _setH + 1
j = y * _setV + ii / _setH + 1
if ( b.match[i, j] == n )
long if ( b.match[i, j] == n )
if ( first == 0 )
long if ( first == 0 )
first = j
else
first = j
check = _false
xelse
exit fn
check = _false
end if
exit fn
end if
end if
next ii
end if
next ii
next y
next y
next x
next x

end fn = check
end fn = check




local fn setCell( b as ^Board, x as short, y as short, n as short) as boolean
local fn setCell( b as ^Board, x as short, y as short, n as short) as boolean
dim as short i, j, rx, ry
short i, j, rx, ry
dim as boolean check
Boolean check

b.match[x, y] = n
b.match[x, y] = n
for i = 1 to _digits
for i = 1 to _digits
b.f[x, i, n] = _false
b.f[x, i, n] = _false
b.f[i, y, n] = _false
b.f[i, y, n] = _false
next i
next i

rx = (x - 1) / _setH
rx = (x - 1) / _setH
ry = (y - 1) / _setV
ry = (y - 1) / _setV

for i = 1 to _setH
for i = 1 to _setH
for j = 1 to _setV
for j = 1 to _setV
b.f[ rx * _setH + i, ry * _setV + j, n ] = _false
b.f[ rx * _setH + i, ry * _setV + j, n ] = _false
next j
next j
next i
next i

check = fn verifica( #b )
check = fn verifica( #b )
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn

end fn = check
end fn = check




local fn solve( b as ^Board )
local fn solve( b as ^Board )
dim as short i, j, n, first, x, y, ii, ppi, ppj
short i, j, n, first, x, y, ii, ppi, ppj
dim as boolean check
Boolean check

check = _true
check = _true

for i = 1 to _digits
for i = 1 to _digits
for j = 1 to _digits
for j = 1 to _digits
long if ( b.match[i, j] == 0 )
if ( b.match[i, j] == 0 )
first = 0
first = 0
for n = 1 to _digits
for n = 1 to _digits
long if ( b.f[i, j, n] != _false )
if ( b.f[i, j, n] != _false )
long if ( first == 0 )
if ( first == 0 )
first = n
first = n
else
xelse
first = -1
first = -1
exit for
exit for
end if
end if
end if
end if
next n
next n

long if ( first > 0 )
if ( first > 0 )
check = fn setCell( #b, i, j, first )
check = fn setCell( #b, i, j, first )
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
check = fn solve(#b)
check = fn solve(#b)
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
end if
end if

end if
end if
next j
next j
next i
next i

for i = 1 to _digits
for i = 1 to _digits
for n = 1 to _digits
for n = 1 to _digits
first = 0
first = 0

for j = 1 to _digits
for j = 1 to _digits
if ( b.match[i, j] == n ) then exit for
if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
if ( first == 0 )
first = j
first = j
else
xelse
first = -1
first = -1
exit for
exit for
end if
end if

end if
end if

next j
next j

long if ( first > 0 )
if ( first > 0 )
check = fn setCell( #b, i, first, n )
check = fn setCell( #b, i, first, n )
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
check = fn solve(#b)
check = fn solve(#b)
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
end if
end if

next n
next n
next i
next i


for j = 1 to _digits
for j = 1 to _digits
for n = 1 to _digits
for n = 1 to _digits
first = 0
first = 0

for i = 1 to _digits
for i = 1 to _digits
if ( b.match[i, j] == n ) then exit for
if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
if ( first == 0 )
first = i
first = i
else
xelse
first = -1
first = -1
exit for
exit for
end if
end if

end if
end if

next i
next i

long if ( first > 0 )
if ( first > 0 )
check = fn setCell( #b, first, j, n )
check = fn setCell( #b, first, j, n )
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
check = fn solve(#b)
check = fn solve(#b)
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
end if
end if

next n
next n
next j
next j


for x = 0 to ( _nSetH - 1 )
for x = 0 to ( _nSetH - 1 )
for y = 0 to ( _nSetV - 1 )
for y = 0 to ( _nSetV - 1 )

for n = 1 to _digits
for n = 1 to _digits
first = 0
first = 0

for ii = 0 to ( _digits - 1 )
for ii = 0 to ( _digits - 1 )

i = x * _setH + ii mod _setH + 1
i = x * _setH + ii mod _setH + 1
j = y * _setV + ii / _setH + 1
j = y * _setV + ii / _setH + 1

if ( b.match[i, j] == n ) then exit for
if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
if ( first == 0 )
first = n
first = n
ppi = i
ppi = i
ppj = j
ppj = j
else
xelse
first = -1
first = -1
exit for
exit for
end if
end if
end if
end if


next ii
next ii

long if ( first > 0 )
if ( first > 0 )
check = fn setCell( #b, ppi, ppj, n )
check = fn setCell( #b, ppi, ppj, n )
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
check = fn solve(#b)
check = fn solve(#b)
if ( check == _false ) then exit fn
if ( check == _false ) then exit fn
end if
end if

next n
next n

next y
next y
next x
next x

end fn = check
end fn = check




local fn resolve( b as ^Board )
local fn resolve( b as ^Board )
dim as boolean check, daFinire
Boolean check, daFinire
dim as long i, j, n
long i, j, n
dim as board localBoard
Board localBoard

check = fn solve(b)
check = fn solve(b)

long if ( check == _false )
if ( check == _false )
exit fn
exit fn
end if
end if

daFinire = _false
daFinire = _false

for i = 1 to _digits
for i = 1 to _digits
for j = 1 to _digits
for j = 1 to _digits
long if ( b.match[i, j] == 0 )
if ( b.match[i, j] == 0 )

daFinire = _true
daFinire = _true

for n = 1 to _digits
for n = 1 to _digits
long if ( b.f[i, j, n] != _false )
if ( b.f[i, j, n] != _false )

fn CopyBoard( b, @localBoard )
fn CopyBoard( b, @localBoard )

check = fn setCell(@localBoard, i, j, n)
check = fn setCell(@localBoard, i, j, n)

long if ( check != _false )
if ( check != _false )
check = fn resolve( @localBoard )
check = fn resolve( @localBoard )
long if ( check == -1 )
if ( check == -1 )
fn CopyBoard( @localBoard, b )
fn CopyBoard( @localBoard, b )

exit fn
exit fn
end if
end if
end if
end if

end if
end if

next n
next n

end if
end if
next j
next j
next i
next i

long if daFinire
if daFinire
else
xelse
check = -1
check = -1
end if
end if

end fn = check
end fn = check



fn InitMilliseconds


fn prepare( @quiz )
fn prepare( @quiz )
Line 5,670: Line 5,642:
DATA 2,8,0,1,3,0,0,0,0
DATA 2,8,0,1,3,0,0,0,0


dim as short i, j, d
short i, j, d
for i = 1 to _digits
for i = 1 to _digits
for j = 1 to _digits
for j = 1 to _digits
read d
read d
fn setCell(@quiz, j, i, d)
fn setCell(@quiz, j, i, d)
next j
next j
next i
next i


Line 5,681: Line 5,653:
fn printBoard( @quiz )
fn printBoard( @quiz )
print : print "-------------------" : print
print : print "-------------------" : print
dim as boolean check
Boolean check


t = fn Milliseconds
t = fn CACurrentMediaTime
check = fn resolve(@quiz)
check = fn resolve(@quiz)
t = fn Milliseconds - t
t = (fn CACurrentMediaTime - t) * 1000


if ( check )
if ( check )
print "solution:"; str$( t/1000.0 ) + " ms"
print "solution:"; str$( t ) + " ms"
else
else
print "No solution found"
print "No solution found"
end if
end if
fn printBoard( @quiz )
fn printBoard( @quiz )

HandleEvents
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Sudoku"