Sudoku Programmers Forum Index

 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister   ProfileProfile   Log inLog in          Games  Calendar

Log in to check your private messagesLog in to check your private messages   

fittable solver
Goto page Previous  1, 2
 
Post new topic   Reply to topic    Sudoku Programmers Forum Index -> Programming sudoku
View previous topic :: View next topic  
Author Message
soduko

Joined: 10 Oct 2005
Posts: 50
:

Items
PostPosted: Sat Jul 11, 2009 7:12 am    Post subject: Reply with quote

Here the full code of my present program.

it is not anymore the quick program i had but is much stronger.

far from optimized yet but here is it all

the placements are numbered 1-729 (see function celsymtoplace)
and the constraint (test () in the program 1-324)


i use QB45 as basic/ basis and you need to use the /ah option when starting.
probably you can get it working on other basics as well


The program uses quite a lot of memory if it doesn't run reduce the value of the constant maxfitsize.

but for the easter monster you need a size of 244.

if even setting the value to 0 doesn't work that sorry it will not run.

setting the value to 0 as a matter of fact stops the fittablesolver (solver5 and all subs starting with fit working all together.)

maybe removing many of the comments and unnescesary tests (all tests that only leads to a stop) is better.

The pit (positive implication solver- solver4) only uses the pitarray (also a rather big array) 729 by 81 so will then still work

there are lots of stops in the program but they are just a help when i am programming.


post questions if you like.

included is also a small (and inefficient) bruteforce solver (brute solver and brutesolverfit) that uses brute force.
(but again this only works if maxfitsize is big enough.)
it reuses the fittable because i did not have enough memory to let it have its own array.






[code]

DEFINT A-Z
REM $DYNAMIC

OPTION BASE 1

'SODUKO solver
' pit tables DONE solver4
' fit tables bit done solver5
' fullpittables very beginning solver6

CONST maxfitsize = 244: 'maximum size for fittable
' can be a bit bigger
'unknown what the maximal needed size is
'guess 250
'(number of candidates after hidden and naked singles are removed)
'easter monster has 240
'if it can be unlimited set it to sz6 (size ^6)
'see just before the declaration of shared arrays

'start
DECLARE SUB memprint (a$)
DECLARE SUB fillcelarrays ()
DECLARE SUB fillmainarrays ()
DECLARE SUB fillplacearrays ()
DECLARE SUB keyboard ()

DECLARE SUB main ()
DECLARE SUB clearpuzzle ()
DECLARE SUB clearsolverdata ()
DECLARE SUB statustest ()
DECLARE SUB testsolution (a$)
DECLARE SUB solverdata ()

'show
DECLARE SUB printgrid ()
DECLARE SUB locatecel (cel)
DECLARE SUB showsolution ()
DECLARE SUB showcel (cel)
DECLARE SUB showplacementsstat ()
DECLARE SUB showplaceingrid (place)

'given
DECLARE SUB addgiven (place)
DECLARE SUB removegiven (cel)
DECLARE SUB showgivens (show)
DECLARE SUB showtestresults ()
DECLARE SUB message (a$)
DECLARE SUB message2 (a$)


'solution
DECLARE SUB addtosolution (place)
DECLARE SUB addtosolutiondry (place)
DECLARE SUB addtoblocked (place)

DECLARE SUB solver ()
DECLARE SUB solver1 ()
DECLARE SUB solver2 ()
DECLARE SUB solver3 (depth)
DECLARE SUB solver4 ()
DECLARE SUB pitarraytest ()
DECLARE SUB solver5 ()
DECLARE SUB solver5fittest ()
DECLARE SUB solver5reftest ()
DECLARE SUB solver5solfittest ()
DECLARE SUB solver6 ()

DECLARE SUB brutesolver ()
DECLARE SUB brutesolverfit ()


DECLARE SUB solversall ()
DECLARE SUB solversread ()
DECLARE SUB solverstest ()

'scrapbook
DECLARE SUB clearplacelist ()
DECLARE SUB cleartestoptions ()

DECLARE SUB readsoduko (a$)
DECLARE SUB testoption2 (test, p1, p2)

'fittable sub's
'fittable start
DECLARE SUB fittoplacefill ()
DECLARE SUB fittablefill1 ()

DECLARE SUB fitnewdiscards ()
DECLARE SUB fittablefrompit ()

'placegrows
DECLARE SUB fittablefill2 ()
DECLARE SUB fitplacegrow ()
DECLARE SUB fitimpliesgrow ()
DECLARE SUB fitblockgrow ()

'testgrows
DECLARE SUB fittestgrow ()
DECLARE SUB fittestgrow1 ()
DECLARE SUB fittestgrow2 ()
DECLARE SUB fittestgrow2a ()
DECLARE SUB fittestgrow3 ()


DECLARE SUB fitmixed ()
DECLARE SUB fitmixedgrow ()
DECLARE SUB fitmixedgrow1 ()
DECLARE SUB fitmixedgrow2 ()
DECLARE SUB fitfilltestlist (test1)


'fittable end
DECLARE SUB fittabletopit ()
DECLARE SUB pittablestats ()
DECLARE SUB fittabletests ()


DECLARE FUNCTION celsymtoplace (cel, sym)
DECLARE FUNCTION rowcoltocel (row, col)
DECLARE FUNCTION opencount ()
DECLARE FUNCTION fillblocklist (p1)
DECLARE SUB testtest ()

'signature functions
DECLARE FUNCTION celsig$ (cel)
DECLARE FUNCTION placesig$ (place)
DECLARE FUNCTION testsig$ (test)
DECLARE FUNCTION symsig$ (sym)

'arrays
CONST sz = 3
CONST sz2 = sz * sz
CONST sz4 = sz2 * sz2
CONST sz44 = sz4 * 4
CONST sz6 = sz4 * sz2
CONST implies = sz6 + 10
CONST blocked = sz6 + 11

CLS
PRINT
memprint " memory before making arrays"
'main arrays


'placearrays
DIM SHARED testtoplace(sz44, sz2)
DIM SHARED placetotest(sz6, 4)
DIM SHARED placetocel(sz6)
DIM SHARED placetosym(sz6)
'celarrays
DIM SHARED celtorow(sz4)
DIM SHARED celtocol(sz4)
DIM SHARED celtobox(sz4)
DIM SHARED celtopib(sz4)

memprint " after main arrays"

'solution

DIM SHARED given(sz4)
DIM SHARED placeref(sz6)
DIM SHARED solution(sz4)
DIM SHARED sstatus
DIM SHARED givennr

'supporting arrays
DIM SHARED solverloop

DIM SHARED placelist(sz6): 'scrabbook for place
DIM SHARED testoptions(sz44) 'for solver2 and 3
DIM SHARED blocklist(sz2 * 4)
memprint " before pitarray"

'pittables
DIM SHARED pitarray(sz6, sz4)
memprint " after pitarray"

'fit tables
DIM SHARED fittable(maxfitsize, maxfitsize)
memprint " only fittable size " + STR$(maxfitsize)
DIM SHARED fitlist(maxfitsize):
DIM SHARED fittoplace(maxfitsize)
memprint " after al maxfitsize arrays"

DIM SHARED placetofit(sz6)
memprint " 1 more sz6 arrays"

DIM SHARED discardf(sz6)
DIM SHARED foundf(sz6)
memprint " 2 more sz6 arrays"

DIM SHARED testlist(sz2): 'used in testgrow
DIM SHARED testlist2(sz2): 'used in testgrow2



memprint " just before 4 more shared variables"

DIM SHARED maxfit
DIM SHARED newdiscard
DIM SHARED newimplies
DIM SHARED fitloop

memprint " after all shared arrays"
keyboard

CLS
' fills arrays
fillcelarrays
fillplacearrays

loadstart = 1
IF loadstart = 1 THEN
a$ = ""
a$ = a$ + "1.......2"
a$ = a$ + ".3.4...5."
a$ = a$ + "..6...7.."
a$ = a$ + ".5...8..."
a$ = a$ + "...36...."
a$ = a$ + "...9.1.4."
a$ = a$ + "2.....6.."
a$ = a$ + ".4...3.9."
a$ = a$ + "..7.....1"
readsoduko a$
solver
'solversread
main
STOP
END IF


top50000 = 1
IF top50000 = 1 THEN
'try solve top50000
OPEN "c:\qbasic\soduko\top50000.sdm" FOR INPUT AS #1
' OPEN "c:\qbasic\soduko\top50000.out" FOR OUTPUT AS #2
DO
j = j + 1
IF j = 1000 THEN
i = i + 1
j = 0
END IF
INPUT #1, a$

message2 "top 50000"
PRINT "top 50000"; " nr "; i; j; SPACE$(30)
readsoduko a$

solversread
showsolution
testsolution a$
message2 " "
' keyboard
message2 "top 50000"
IF sstatus = 2 THEN
STOP
ELSEIF sstatus = 1 THEN
message2 "top 50000 nr " + STR$(i) + STR$(j) + " solved"
'keyboard
ELSE
IF sstatus <> 0 THEN STOP
' PRINT #2, a$
message2 "top 50000 nr " + STR$(i) + STR$(j) + " unsolved"
keyboard
main
END IF
LOOP UNTIL EOF(1)
PRINT "end of top 50000"
keyboard
END IF

CLS
printgrid
main

END

REM $STATIC
SUB addgiven (place)

cel = placetocel(place)

'testnew place
IF placeref(place) = implies THEN
'place cannot go there
cel = placetocel(place)
IF solution(cel) = place THEN
message "symbol was allready known"
given(cel) = place
EXIT SUB
END IF
ELSEIF placeref(place) = blocked THEN
IF given(cel) > 0 THEN
sym = placetosym(place)

placeold = given(cel)
osym = placetosym(placeold)
b$ = "replace " + symsig$(osym) + " with " + symsig(sym)
removegiven cel
IF placeref(place) = blocked THEN
message "cannot " + b$
EXIT SUB
ELSE
message b$
END IF
ELSE
message "symbol cannot go there"
EXIT SUB
END IF
END IF

'add given

given(cel) = place
givennr = givennr + 1
addtosolution (place)
IF sstatus > 0 THEN EXIT SUB
showsolution
solver

END SUB

SUB addtoblocked (place)

'block place
IF place > sz6 THEN STOP
IF place < 1 THEN STOP

'test of already blocked
ref = placeref(place)

IF ref = blocked THEN EXIT SUB
IF ref = implies THEN
'problem...
STOP
END IF

placeref(place) = blocked

END SUB

SUB addtosolution (place)

addtosolutiondry (place)

'block other placements in testtoplace

FOR i = 1 TO 4
test = placetotest(place, i)
FOR j = 1 TO sz2
placebl = testtoplace(test, j)
IF placebl <> place THEN
addtoblocked (placebl)
END IF
NEXT
testoptions(test) = 1
NEXT
statustest

END SUB

SUB addtosolutiondry (place)

'place is good point
a$ = placesig$(place)

'tests
ref = placeref(place)
IF ref = implies THEN
EXIT SUB
'allready implies
showsolution
EXIT SUB
END IF
IF ref = blocked THEN
'problem
STOP
END IF

' place it in grid
showplaceingrid place
message2 "newpoint " + a$
solution(cel) = place
placeref(place) = implies

END SUB

SUB brutesolver

'kind of brute force (not to much of course)

solver4

'pittablestats


openp = opencount
message2 " "
message " number of open placements " + STR$(openp)



'count opentests
testnr = 0
FOR t1 = 1 TO sz44
IF testoptions(t1) > 2 THEN
testnr = testnr + 1
END IF
NEXT
message2 " "
message " number of open tests " + STR$(testnr)
keyboard


'DIM fullpit(openp, testnr)
'unfortunedly we are out of memory...

ftest = 1
IF openp > maxfit THEN ftest = 0
IF testnr > maxfit THEN ftest = 0

IF ftest = 1 THEN
brutesolverfit
END IF

END SUB

SUB brutesolverfit

'brutesolver (mis) using fittables
'only knowledge this far is that it fits...


DIM placetofpit(sz6)
DIM testtofpit(sz44)

DIM celsol(sz4)
DIM fullsol(maxfitsize)
DIM bsol(sz4)
DIM bsolution(2, sz4)


'fill placetofpit
fpnr = 0
eqcount = 0
FOR p1 = 1 TO sz6
p1loop = 1
IF placeref(p1) = 0 THEN
fpnr = fpnr + 1
placetofpit(p1) = fpnr
ELSE
placetofpit(p1) = blocked
END IF
NEXT p1

message " placements to concider " + STR$(fpnr)
IF fpnr > maxfitsize THEN STOP
keyboard

'fill testtofpit
testnr = 0
FOR t1 = 1 TO sz44
IF testoptions(t1) > 1 THEN
testnr = testnr + 1
testtofpit(t1) = testnr
ELSE
testtofpit(t1) = blocked
END IF
NEXT
maxtest = testnr
message "number of constraints to test " + STR$(maxtest)
IF maxtest > maxfitsize THEN STOP
keyboard

'clear pittable
FOR i = 1 TO maxfitsize
FOR j = 1 TO maxfitsize
fittable(i, j) = 0
NEXT
NEXT

'fill pittable with links
FOR p1 = 1 TO sz6
IF placeref(p1) = 0 THEN
f1 = placetofpit(p1)
addctest = 0
FOR c2 = 1 TO sz4
p2 = pitarray(p1, c2)
IF p2 > 0 THEN
addctest = addctest + 1
FOR i3 = 1 TO 4
t3 = placetotest(p2, i3)
IF testoptions(t3) = 1 THEN STOP
tf3 = testtofpit(t3)
r = fittable(f1, tf3)
IF r = 0 THEN
fittable(f1, tf3) = p2
ELSEIF r <> p2 THEN
STOP
END IF
NEXT i3
END IF
NEXT c2
IF addctest = 1 THEN
'place without implies
p1$ = placesig$(p1)
'STOP
END IF
END IF
NEXT p1


'search begins here...............................


'fill celsol with solution
FOR c1 = 1 TO sz4
celsol(c1) = solution(c1)
NEXT

bsolnr = 0
ecel = 1
minplace = 0
bsolverfound = 0

DO
IF celsol(ecel) > 0 THEN
DO
ecel = ecel + 1
IF ecel > sz4 THEN
bsolverfound = bsolverfound + 1
message " found a solution"
FOR i1 = 1 TO bsolnr
ps = bsol(i1)
bsolution(bsolverfound, i1) = ps
p$ = placesig(ps)
showplaceingrid ps
'message2 "sol part" + STR$(i2) + p$
'keyboard
NEXT
message " found a solution"
keyboard
'STOP
minplace = ps - 1
ecel = 0
EXIT DO
END IF
LOOP UNTIL celsol(ecel) = 0
END IF
minplace = minplace + 1

mcel = placetocel(minplace)
IF mcel < ecel THEN
'minplace to small goto first place that fits
minplace = celsymtoplace(ecel, 1)
mcel = ecel
END IF
minplace$ = placesig$(minplace)

IF mcel = ecel THEN
'test if minplace fits in bsol
ftest = 0
IF placeref(minplace) = 0 THEN
f1 = placetofpit(minplace)
ftest = 1
'testif place fits in fullsol
FOR i2 = 1 TO maxtest
ft1 = fittable(f1, i2)
ft2 = fullsol(i2)
IF ft1 > 0 AND ft2 > 0 THEN
IF ft1 <> ft2 THEN
ftest = 0
EXIT FOR
END IF
END IF
NEXT
IF ftest = 1 THEN
'place fits
bsolnr = bsolnr + 1
bsol(bsolnr) = minplace
'add places to celsol
addctest = 0
FOR c2 = 1 TO sz4
p2 = pitarray(minplace, c2)
IF p2 > 0 THEN
pt = celsol(c2)
IF pt > 0 AND pt <> p2 THEN STOP
celsol(c2) = p2
showplaceingrid p2
addctest = addctest + 1
END IF
NEXT
IF addctest = 0 THEN STOP
addftest = 0
f1 = placetofpit(minplace)

'add places to fullsol
FOR ft2 = 1 TO maxtest
p2 = fittable(f1, ft2)
IF p2 > 0 THEN
pt = fullsol(ft2)
IF pt > 0 AND pt <> p2 THEN STOP
fullsol(ft2) = p2
addftest = addftest + 1
END IF
NEXT
IF addftest <> addctest * 4 THEN STOP
END IF
END IF
END IF

IF mcel > ecel THEN
'no solution possible with present startingpoints

'remove last place in stplace
p1 = bsol(bsolnr)
IF p1 = 0 THEN STOP
IF placeref(p1) <> 0 THEN STOP
bsol(bsolnr) = 0
bsolnr = bsolnr - 1
IF bsolnr = 0 THEN EXIT DO
minplace = p1
ecel = placetocel(minplace)

printgrid
'clear celsol and fpitsol
FOR c1 = 1 TO sz4
p1 = solution(c1)
celsol(c1) = p1
IF p1 > 0 THEN
showplaceingrid p1
END IF
NEXT
FOR i1 = 1 TO maxtest
fullsol(i1) = 0
NEXT i1

'rebuild celsol and fpitsol
FOR i4 = 1 TO bsolnr
p4 = bsol(i4)
FOR c5 = 1 TO sz4
p5 = pitarray(p4, c5)
IF p5 > 0 THEN
pt = celsol(c5)
IF pt > 0 AND pt <> p5 THEN STOP
celsol(c5) = p5
showplaceingrid p5
END IF
NEXT
f4 = placetofpit(p4)
FOR ft5 = 1 TO maxtest
p5 = fittable(f4, ft5)
IF p5 > 0 THEN
pt = fullsol(ft5)
IF pt > 0 AND pt <> p5 THEN STOP
fullsol(ft5) = p5
END IF
NEXT
NEXT i4
END IF
LOOP UNTIL bsolverfound > 1

SELECT CASE bsolverfound
CASE 0
message "soduko has no solution"
CASE 1
message "soduko has one solution"
CASE 2
message "soduko has more than one solution"
END SELECT
keyboard

FOR i1 = 1 TO bsolverfound
message " found a solution" + STR$(i1)
FOR b2 = 1 TO sz4
ps = bsolution(i1, b2)
IF ps > 0 THEN
p$ = placesig(ps)
message2 "sol part" + STR$(b2) + p$
keyboard
END IF
NEXT
NEXT

STOP

END SUB

FUNCTION celsig$ (cel)

'signature of cel at the moment same as testsig)
row = celtorow(cel)
col = celtocol(cel)

r$ = CHR$(row + 48)
c$ = CHR$(col + 48)

sig$ = "R" + r$ + "C" + c$

celsig$ = sig$

END FUNCTION

FUNCTION celsymtoplace (cel, sym)

IF cel < 1 OR cel > sz4 THEN STOP
IF sym < 1 OR sym > sz2 THEN STOP

place = cel * sz2 + sym - sz2
IF place < 1 OR place > sz6 THEN STOP

celsymtoplace = place

END FUNCTION

SUB clearplacelist
FOR i = 1 TO sz6
placelist(i) = 0
NEXT

END SUB

SUB clearpuzzle



sstatus = 0
FOR i = 1 TO sz4
given(i) = 0
NEXT


clearsolverdata



CLS
printgrid
givennr = 0

END SUB

SUB clearsolverdata

sstatus = 0
FOR i = 1 TO sz4
solution(i) = 0
NEXT

'clear placeref
FOR i = 1 TO sz6
placeref(i) = 0
NEXT

'clear pitarray
FOR i = 1 TO sz6
FOR j = 1 TO sz4
pitarray(i, j) = 0
NEXT
NEXT

FOR i = 1 TO maxfitsize
foundf(i) = 0
discardf(i) = 0
NEXT

'fitarray doesn't need cleaning

solver: ' just to cleanup messages

END SUB

SUB cleartestoptions

FOR t = 1 TO sz44
testoptions(t) = sz2
NEXT

END SUB

FUNCTION fillblocklist (p1)

IF placeref(p1) = blocked THEN STOP

'fills blocklist
FOR i1 = 1 TO 4
t1 = placetotest(p1, i1)
FOR j2 = 1 TO sz2
p2 = testtoplace(t1, j2)
ptest = 1
IF p2 = p1 THEN ptest = 0
IF placeref(p2) = blocked THEN ptest = 0
IF ptest = 1 THEN
nr = nr + 1
blocklist(nr) = p2
END IF
NEXT
NEXT

fillblocklist = nr

END FUNCTION

SUB fillcelarrays

FOR h1 = 1 TO 3
FOR h2 = 1 TO 3
row = 3 * h1 + h2 - 3
FOR v1 = 1 TO 3
box = 3 * h1 + v1 - 3
FOR v2 = 1 TO 3
col = 3 * v1 + v2 - 3
pig = 3 * h2 + v2 - 3
cel = rowcoltocel(row, col)
celtorow(cel) = row
celtocol(cel) = col
celtobox(cel) = box
celtopib(cel) = pig
NEXT
NEXT
NEXT
NEXT

show = 0
'show = 1
IF show = 1 THEN

CLS
PRINT "cel"
PRINT SPACE$(14); "+"; STRING$(43, "-"); "+";
FOR r1 = 1 TO 3
FOR r2 = 1 TO 3
row = r1 * 3 + r2 - 3
PRINT
PRINT USING " ## έ"; row;
FOR c1 = 1 TO 3
FOR c2 = 1 TO 3
col = c1 * 3 + c2 - 3
cel = rowcoltocel(row, col)
PRINT USING " ## "; cel;
NEXT
PRINT " έ ";
NEXT
NEXT
PRINT
PRINT SPACE$(14); "+"; STRING$(43, "-"); "+";
NEXT

PRINT
keyboard


CLS
printgrid
FOR cel = 1 TO sz4
locatecel (cel)
i = celtocol(cel)
PRINT symsig$(i);
NEXT
message "col"
keyboard

CLS
printgrid
FOR cel = 1 TO sz4
locatecel (cel)
i = celtorow(cel)
PRINT symsig$(i);
NEXT
message "row"
keyboard

CLS
printgrid
FOR cel = 1 TO sz4
locatecel (cel)
i = celtobox(cel)
PRINT symsig$(i);
NEXT
message "box"
keyboard

CLS
printgrid
FOR cel = 1 TO sz4
locatecel (cel)
i = celtopib(cel)
PRINT symsig$(i);
NEXT
message "pib"
keyboard
END IF


END SUB

SUB fillplacearrays

FOR cel = 1 TO sz4
row = celtorow(cel)
col = celtocol(cel)
box = celtobox(cel)
pib = celtopib(cel)
FOR sym = 1 TO sz2
place = celsymtoplace(cel, sym)
placetocel(place) = cel
placetosym(place) = sym
test1 = 0 * sz4 + cel
test2 = 1 * sz4 + row * sz2 + sym - sz2
test3 = 2 * sz4 + col * sz2 + sym - sz2
test4 = 3 * sz4 + box * sz2 + sym - sz2

placetotest(place, 1) = test1
placetotest(place, 2) = test2
placetotest(place, 3) = test3
placetotest(place, 4) = test4
IF testtoplace(test1, sym) <> 0 THEN STOP
IF testtoplace(test2, col) <> 0 THEN STOP
IF testtoplace(test3, row) <> 0 THEN STOP
IF testtoplace(test4, pib) <> 0 THEN STOP

testtoplace(test1, sym) = place
testtoplace(test2, col) = place
testtoplace(test3, row) = place
testtoplace(test4, pib) = place
NEXT
NEXT

'show=1
IF show = 1 THEN
FOR i = 1 TO 4 * sz2
FOR j = 1 TO sz2
test = i * sz2 + j - sz2
PRINT
PRINT test; testsig$(test); " : ";
FOR i3 = 1 TO sz2
place = testtoplace(test, i3)
PRINT placesig$(place); " ";
NEXT
NEXT
PRINT
'keyboard
NEXT
END IF

'test testtoplace
FOR i1 = 1 TO sz4
FOR j = 1 TO sz2
place1 = testtoplace(i1, j)
cel = placetocel(place1)
sym = placetosym(place1)
IF cel <> i1 THEN STOP
IF sym <> j THEN STOP
NEXT
NEXT

FOR i1 = 1 TO sz2
FOR i2 = 1 TO sz2
test2 = 1 * sz4 + i1 * sz2 + i2 - sz2
IF show = 1 THEN
PRINT
PRINT test2; testsig$(test2); " : ";
END IF
FOR i3 = 1 TO sz2
place2 = testtoplace(test2, i3)
IF show = 1 THEN PRINT placesig$(place2); " ";
cel = placetocel(place2)
col = celtocol(cel)
row = celtorow(cel)
sym = placetosym(place2)
IF sym <> i2 THEN STOP
IF col <> i3 THEN STOP
IF row <> i1 THEN STOP
NEXT
test3 = test2 + sz4
IF show = 1 THEN
PRINT
PRINT test3; testsig$(test3); " : ";
END IF
FOR i3 = 1 TO sz2
place3 = testtoplace(test3, i3)
IF show = 1 THEN PRINT placesig$(place3); " ";
cel = placetocel(place3)
col = celtocol(cel)
row = celtorow(cel)
sym = placetosym(place3)
IF sym <> i2 THEN STOP
IF col <> i1 THEN STOP
IF row <> i3 THEN STOP
NEXT
test4 = test3 + sz4
IF show = 1 THEN
PRINT
PRINT test4; testsig$(test4); " : ";
END IF
FOR i3 = 1 TO sz2

place4 = testtoplace(test4, i3)
IF show = 1 THEN PRINT placesig(place4); " ";
cel = placetocel(place4)
box = celtobox(cel)
pib = celtopib(cel)
sym = placetosym(place4)
IF sym <> i2 THEN STOP
IF pib <> i3 THEN STOP
IF box <> i1 THEN STOP
NEXT
NEXT
NEXT
END SUB

SUB fitblockgrow

'BLOCK GROW f1 -> -f2 => f2 -> -f1
FOR f1 = 1 TO maxfit
IF discardf(f1) = 0 THEN
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) = blocked THEN
'f1 -> -f2
IF fittable(f2, f1) = 0 THEN
fittable(f2, f1) = blocked
ELSEIF fittable(f2, f1) = implies THEN
'f2-> f1, f1-> -f2 => -f2
discardf(f2) = 1
newdiscard = 1
END IF
END IF
NEXT f2
END IF
NEXT f1

END SUB

SUB fitfilltestlist (test1)

nropt1 = 0
FOR i2 = 1 TO sz2
p2 = testtoplace(test1, i2)
f2 = placetofit(p2)
placeblock = 0
IF placeref(p2) = implies THEN STOP
IF placeref(p2) = 0 THEN
IF f2 = blocked THEN STOP
nropt1 = nropt1 + 1
testlist(nropt1) = f2
END IF
NEXT i2
IF nropt1 <> testoptions(test1) THEN STOP





END SUB

SUB fitimpliesgrow

'fittable test
'f1 -> f2 , -f2 => -f1

DO
testdone = 1
FOR f1 = 1 TO maxfit
IF discardf(f1) = 0 THEN
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) = implies THEN
IF discardf(f2) = 1 THEN
IF foundf(f1) = 1 THEN STOP
discardf(f1) = 1
newdiscard = 1
testdone = 0
END IF
END IF
NEXT f2
END IF
NEXT
LOOP UNTIL testdone = 1


'expand implications
'p2 -> p1, p1-> +/-p3 => p2-> +/- p3

FOR f1 = 1 TO maxfit
IF discardf(f1) = 0 AND foundf(f1) = 0 THEN
FOR f2 = 1 TO maxfit
f2loop = 1
IF fittable(f2, f1) <> implies THEN f2loop = 0
IF discardf(f2) = 1 THEN f2loop = 0
IF f2 = f1 THEN f2loop = 0
IF f2loop = 1 THEN
'f2 -> f1
FOR f3 = 1 TO maxfit
test13 = fittable(f1, f3)
IF f3 = f1 THEN test13 = 0
IF f3 = f2 THEN test13 = 0
IF test13 > 0 THEN
' f1 -> +/- f3 => f2 -> +/-f3
test23 = fittable(f2, f3)
IF test23 = 0 THEN
fittable(f2, f3) = test13
newimplies = newimplies + 1
ELSE
IF test13 <> test23 THEN
'f2 -> f3, f2 -> -f3 => -f2
discardf(f2) = 1
newdiscard = 1
EXIT FOR
END IF
END IF
END IF
NEXT f3
END IF
NEXT f2
END IF
NEXT f1

END SUB

SUB fitmixedgrow

'does the more complex implications
'fitmixedgrow 1
'f7 v f8 v f9, f2 -> -f7, f2 -> -f8 => f2 -> f9
'f7 v f8 v f9, f2 -> -f7, f2 -> -f8, f2 ->-f9 => -f2

'and
'fitmixedgrow 2
'f7 v f8 v f9, f2 -> -f7, f8 -> *f5 f9 -> *f5 => f2 -> *f5
' ft1 , f2 , f5

'think this is as far as you can go with fittables

solver5reftest

IF newimplies <> 0 THEN STOP
IF fitloop <> 0 THEN STOP



DO
newloop = 0
loopcnt = loopcnt + 1
message "fitmixedgrow loop" + STR$(loopcnt)
newimplies = 0
'fittestgrow1 to update testoptions
fittestgrow1

fitmixedgrow2

IF newimplies = 1 THEN
fitloop = 1
END IF
IF newdiscard = 1 THEN
fitnewdiscards
'solver5reftest
newloop = 1
fitloop = 1
END IF
LOOP UNTIL newloop = 0


IF newdiscard = 1 THEN STOP

solver5reftest
END SUB

SUB fitmixedgrow2

'does complex testplace grow
'fitmixedgrow 1
'f7 v f8 v f9, f2 -> -f7, f2 -> -f8 => f2 -> f9
'also
'f7 v f8 v f9, f2 -> -f7, f2 -> -f8, f2 -> -f9 => -f2


'TESTGROW 2
'maybe the last option to strenghten solver 5
'f7 v f8 v f9, f2 -> -f7, f8 -> *f5 f9 -> *f5 => f2 -> *f5
' ft1 , f2 , f5
'exit out of test1 loop after one newdiscard implication
'to make it more simple for the moment

solver5reftest

testgrow = 0
FOR test1 = 1 TO sz44
'solver5reftest
topt1 = testoptions(test1)
IF topt1 > 2 THEN
fitfilltestlist (test1)

'test against placements
FOR f2 = 1 TO maxfit
f2loop = 1
IF discardf(f2) = 1 THEN f2loop = 0
IF f2loop = 1 THEN
' test if f2 is in testlist
' or implies one in test
' no test
FOR i3 = 1 TO topt1
f3 = testlist(i3)
IF f2 = f3 THEN f2loop = 0
IF fittable(f2, f3) = implies THEN f2loop = 0
IF f2loop = 0 THEN
EXIT FOR
END IF
NEXT i3
END IF

'another testif f2 is in test
IF f2loop = 1 THEN
ptest = fittoplace(f2)
FOR i3 = 1 TO 4
IF test1 = placetotest(ptest, i3) THEN
STOP
'should already be found
f2loop = 0
END IF
NEXT
END IF

IF f2loop = 1 THEN
'testloop2

'make list from testlist without options blocked by f2
f2opt = 0
FOR i3 = 1 TO topt1
f3 = testlist(i3)
IF fittable(f2, f3) = implies THEN STOP
IF f2 = f3 THEN STOP

IF fittable(f2, f3) = 0 THEN
f2opt = f2opt + 1
testlist2(f2opt) = f3
END IF
NEXT i3

IF f2opt < topt1 THEN
IF f2opt < 2 THEN
'fitmixedgrow 1
IF f2opt = 0 THEN
'f2 has no follower in test1 -> f2 is blocked
discardf(f2) = 1
newdiscard = 1
EXIT FOR
ELSEIF f2opt = 1 THEN
f9 = testlist2(1)
ftest = fittable(f2, f9)
IF ftest = 0 THEN
fittable(f2, f9) = implies
newimplies = 1
ELSEIF ftest = blocked THEN
'f2 -> f9, f2 -> -f9 => -f2
discardf(f2) = 1
newdiscard = 1
EXIT FOR
END IF
END IF
IF newimplies = 0 THEN STOP
ELSE
'fixmixedgrow 2
'for all options in testlist2
first = 1
FOR i3 = 1 TO f2opt
f7 = testlist2(i3)
IF f7 = 0 THEN STOP
IF first = 1 THEN
first = 0
FOR f5 = 1 TO maxfit
fitlist(f5) = fittable(f7, f5)
NEXT
ELSE
FOR f5 = 1 TO maxfit
IF fitlist(f5) > 0 THEN
IF fitlist(f5) <> fittable(f7, f5) THEN
fitlist(f5) = 0
END IF
END IF
NEXT
END IF
NEXT i3

'f2 implies all what remains in fitlist
FOR f5 = 1 TO maxfit
rlist = fitlist(f5)
IF rlist > 0 THEN
rtable = fittable(f2, f5)
IF rtable = 0 THEN
fittable(f2, f5) = rlist
newimplies = 1
ELSEIF rlist <> rtable THEN
discardf(f2) = 1
newdiscard = 1
END IF
END IF
NEXT f5
IF newdiscard = 1 THEN
EXIT SUB
END IF
END IF
END IF
END IF
NEXT f2
END IF
NEXT test1

END SUB

SUB fitnewdiscards

'add to solution all with foundf=1
'or are implied by then

'add to blocked all with blockf=1
'or have that potential

solver5fittest

'add new found to solution
DO
newfound = 0
FOR f1 = 1 TO maxfit
IF foundf(f1) = 1 THEN
solverloop = 1
p1 = fittoplace(f1)
IF placeref(p1) = blocked THEN STOP
IF placeref(p1) <> implies THEN
IF placeref(p1) <> 0 THEN STOP
addtosolutiondry p1
fitloop = 1
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) = implies THEN
' f1 , f1 -> f2 => f2
foundf(f2) = 1
newfound = 1
END IF
' f1 , f1 -> -f2 => -f2
' f1 , f2 -> -f1 => -f2 'not really nessecary ??
f2test = 0
IF fittable(f1, f2) = blocked THEN f2test = 1
IF fittable(f2, f1) = blocked THEN f2test = 1
IF f2test = 1 THEN
IF foundf(f2) = 1 THEN
p1 = fittoplace(f1)
p1$ = placesig$(p1)
p2 = fittoplace(f2)
p2$ = placesig$(p2)


STOP
END IF
discardf(f2) = 1
END IF
'clear fittable
fittable(f1, f2) = 0
fittable(f2, f1) = 0
NEXT
END IF
END IF
NEXT
LOOP WHILE newfound = 1

solver5solfittest

'test
FOR f1 = 1 TO maxfit
IF foundf(f1) = 1 THEN
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) <> 0 THEN STOP
IF fittable(f2, f1) <> 0 THEN STOP
NEXT
END IF
NEXT

solver5fittest

'block all discarded from solution
DO
newdiscard = 0
FOR f1 = 1 TO maxfit
IF discardf(f1) = 1 THEN
solverloop = 1
p1 = fittoplace(f1)
IF placeref(p1) = implies THEN STOP
IF placeref(p1) <> blocked THEN
IF placeref(p1) <> 0 THEN STOP
fitloop = 1
addtoblocked p1
newdiscard = 1
FOR f2 = 1 TO maxfit
IF fittable(f2, f1) = implies THEN
' - p1, p2 -> p1 => -p2
discardf(f2) = 1
newdiscard = 1
fitloop = 1
END IF
fittable(f1, f2) = 0
fittable(f2, f1) = 0
NEXT
END IF
END IF
NEXT
LOOP WHILE newdiscard = 1

'test
FOR f1 = 1 TO maxfit
IF discardf(f1) = 1 OR foundf(f1) = 1 THEN
FOR f2 = 1 TO maxfit
'fittable(f1, f2) = 0
'fittable(f2, f1) = 0
IF f1 <> f2 THEN
IF fittable(f1, f2) <> 0 THEN STOP
IF fittable(f2, f1) <> 0 THEN STOP
END IF
NEXT
END IF
NEXT
fitloop = 1

showplacementsstat

solver5reftest

END SUB

SUB fitplacegrow

'does all place only grows for fittable
'loop is on newimplies not on newblocked or newdiscards


DO
newimplies = 0
fitblockgrow
fitimpliesgrow
LOOP UNTIL newimplies = 0
fitblockgrow


END SUB

SUB fittablefill1

'fill fittable with first values
' p1 blocks all p in tests that include p1
' p1 forces p1

'clear fitttable
'only bit used? -> only till maxfit
FOR f1 = 1 TO maxfitsize
FOR f2 = 1 TO maxfitsize
fittable(f1, f2) = 0
NEXT
NEXT


FOR f1 = 1 TO maxfit
p1 = fittoplace(f1)
IF p1 = 0 THEN STOP

nrb = fillblocklist(p1)
FOR i1 = 1 TO nrb
p2 = blocklist(i1)
f2 = placetofit(p2)
ptest = 1

IF f2 = blocked THEN ptest = 0
IF ptest = 1 THEN
fittable(f1, f2) = blocked
fittable(f2, f1) = blocked
END IF
NEXT
fittable(f1, f1) = implies
NEXT

END SUB

SUB fittablefill2

' fill fittable with second values.
' all tests with 2 values
' p7 v p8, p1 -> -p7 => p1 -> p8
' p7 v p8, p1 -> -p8 => p1 -> p7
' is done at solver5loop

'solver5reftest
IF newdiscard = 1 THEN STOP


FOR test = 1 TO sz44
IF testoptions(test) = 2 THEN
'for al tests with 2 options
testoption2 test, p3, p4
IF p3 = 0 THEN STOP
IF p4 = 0 THEN STOP

f3 = placetofit(p3)
f4 = placetofit(p4)
IF f3 > maxfit THEN STOP
IF f4 > maxfit THEN STOP
IF foundf(f3) = 1 THEN STOP
IF foundf(f4) = 1 THEN STOP
IF discardf(f3) = 1 THEN STOP
IF discardf(f4) = 1 THEN STOP

FOR f1 = 1 TO maxfit
testf1 = 1
IF foundf(f1) = 1 THEN testf1 = 0
IF discardf(f1) = 1 THEN testf1 = 0
IF f1 = f3 THEN testf1 = 0
IF f1 = f4 THEN testf1 = 0
IF testf1 = 1 THEN
FOR i = 1 TO 2
IF i = 1 THEN
f7 = f3: f8 = f4
ELSEIF i = 2 THEN
f7 = f4: f8 = f3
END IF
IF fittable(f1, f7) = blocked THEN
ftest = fittable(f1, f8)
IF ftest = blocked THEN
IF foundf(f1) = 1 THEN STOP
IF discardf(f1) = 0 THEN
discardf(f1) = 1
newdiscard = 1
END IF
ELSEIF ftest = 0 THEN
fittable(f1, f8) = implies
newimplies = 1
END IF
END IF
NEXT
END IF
NEXT
END IF
NEXT

END SUB

SUB fittablefrompit

pitarraytest

'fill fittable from pitarray

FOR p1 = 1 TO sz6
IF placeref(p1) = 0 THEN
f1 = placetofit(p1)
FOR c2 = 1 TO sz4
p2 = pitarray(p1, c2)
IF p2 > 0 THEN
IF placeref(p2) = blocked THEN
STOP: 'not really possible
'p1 should be blocked as well here...
END IF
IF placeref(p2) = 0 THEN
f2 = placetofit(p2)
IF fittable(f1, f2) = blocked THEN STOP
fittable(f1, f2) = implies
END IF
END IF
NEXT
END IF
NEXT


END SUB

SUB fittabletests

'looks like there is something wrong with fittables therefore a test
solver5reftest
solver5solfittest

solverdata

FOR f1 = 1 TO maxfit
p1 = fittoplace(f1)
IF placeref(p1) = 0 THEN
FOR f2 = 1 TO maxfit
fitlist(f2) = fittable(f1, f2)
NEXT
p$ = placesig$(p1)
FOR t2 = 1 TO sz44
t$ = testsig(t2)
t2opt = testoptions(t2)
IF t2opt > 1 THEN
blockcnt = 0
impcnt = 0
cnt0 = 0
topt = 0
FOR i3 = 1 TO sz2
p3 = testtoplace(t2, i3)
IF placeref(p3) = 0 THEN
p3$ = placesig$(p3)
topt = topt + 1
f3 = placetofit(p3)
r3 = fittable(f1, f3)
SELECT CASE r3
CASE blocked: blockcnt = blockcnt + 1
CASE implies: impcnt = impcnt + 1
CASE 0: cnt0 = cnt0 + 1
CASE ELSE: STOP
END SELECT
END IF
NEXT
IF t2opt <> topt THEN STOP
IF impcnt > 1 THEN STOP
IF impcnt = 1 THEN
IF cnt0 > 0 THEN STOP
IF blockcnt <> topt - 1 THEN STOP
END IF
IF cnt0 = 1 THEN STOP
IF blockcnt > topt - 2 AND cnt0 > 0 THEN STOP
END IF
NEXT t2
END IF
NEXT f1

'test tests

'testif alloption=2 are recognised
FOR t1 = 1 TO sz44
IF testoptions(t1) = 2 THEN
testoption2 t1, p7, p8
f7 = placetofit(p7)
f8 = placetofit(p8)
FOR f2 = 1 TO maxfit
p2 = fittoplace(f2)
IF placeref(p2) = 0 THEN
r7 = fittable(f2, f8)
r8 = fittable(f2, f7)
IF r8 > 0 OR r7 > 0 THEN
IF r8 = r7 THEN STOP
IF r8 = 0 THEN STOP
IF r7 = 0 THEN STOP
END IF
END IF
NEXT
END IF
NEXT


'test implications

FOR f1 = 1 TO maxfit
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) = blocked THEN
IF fittable(f1, f2) <> blocked THEN STOP
END IF

IF fittable(f1, f2) = implies THEN
'f1 -> f2
FOR f3 = 1 TO maxfit
IF fittable(f2, f3) > 0 THEN
IF fittable(f2, f3) <> fittable(f1, f3) THEN STOP
END IF
IF fittable(f3, f2) = blocked THEN
IF fittable(f3, f1) <> blocked THEN STOP
END IF
NEXT
END IF
NEXT
NEXT


'test equivalents
eqcount = 0
show = 0
FOR f1 = 1 TO maxfit
FOR f2 = 1 TO maxfit
IF fittable(f1, f2) = implies THEN
IF fittable(f2, f1) = implies THEN
IF f2 > f1 THEN
'f1 <-> f2
IF show = 1 THEN
p1 = fittoplace(f1)
p2 = fittoplace(f2)
eqcount = eqcount + 1
eq$ = ": " + placesig$(p1) + " <-> " + placesig$(p2)
message2 "eq" + STR$(eqcount) + eq$
keyboard
END IF
FOR f3 = 1 TO maxfit
IF fittable(f1, f3) <> fittable(f2, f3) THEN STOP
IF fittable(f3, f1) <> fittable(f3, f2) THEN STOP
NEXT
END IF
END IF
END IF
NEXT
NEXT



END SUB

SUB fittabletopit

'copy pittable results to pit array

solver5reftest

linkcnt = 0
FOR f1 = 1 TO maxfit
p1 = fittoplace(f1)
IF placeref(p1) = 0 THEN
c1 = placetocel(p1)
FOR f2 = 1 TO maxfit
p2 = fittoplace(f2)
IF placeref(p2) = 0 THEN
IF fittable(f2, f1) = implies THEN
linkcnt = linkcnt + 1
'p2-> p1
pitp = pitarray(p2, c1)
IF pitp = 0 THEN
pitarray(p2, c1) = p1
ELSEIF pitp <> p1 THEN
'pittable and fittable disagree!
STOP
END IF
END IF
END IF
NEXT f2
END IF
NEXT f1

message2 "links found " + STR$(linkcnt)

END SUB

SUB fittestgrow

'all fittable routines directly from test
'works because every test needs to be satisfied (at least once)


DO
newloop = 0

'solver5reftest
fittestgrow1
' looks for tests with only one option
' also updates testoptions
' adds to solution as well
'after this all testoption(t)=1 are solved


IF newdiscard = 1 THEN
newloop = 1
END IF

IF newloop = 0 THEN
'solver5reftest
fittestgrow2
IF newdiscard = 1 THEN
newloop = 1
END IF
END IF


IF newloop = 0 THEN
'fills fittable with links from testoptions=2 tests
'also tests tests with two options that needs to be blocked ???
'solver5reftest
newimplies = 0
fittestgrow2a
IF newimplies = 1 THEN
endfitloop = 1
fitloop = 0
newloop = 1
END IF
IF newdiscard = 1 THEN
newloop = 1
END IF
END IF

'fitestgrow3 is like solver3 only on fittable
IF newloop = 0 THEN
'solver5reftest
fittestgrow3
END IF

IF newdiscard = 1 THEN
endfitloop = 1
solver5fittest
fitnewdiscards
newloop = 1
'solver5reftest
END IF
LOOP UNTIL newloop = 0

IF endfitloop = 1 THEN
fitloop = 1
END IF


END SUB

SUB fittestgrow1

' looks for tests with only one option
' adds them all to solution
' also updates testoptions

DO
'solver5reftest
test1loop = 0
FOR t1 = 1 TO sz44
op = testoptions(t1)
IF op = 0 THEN STOP
IF op > 1 THEN
blocknr = 0
oldfound = 0
foundp = 0
nropt = 0
FOR i2 = 1 TO sz2
p2 = testtoplace(t1, i2)
ref = placeref(p2)
IF ref = implies THEN
nropt = nropt + 1
foundp = p2
oldfound = oldfound + 1
ELSEIF ref = 0 THEN
nropt = nropt + 1
foundp = p2
ELSEIF ref = blocked THEN
blocknr = blocknr + 1
ELSE
STOP
END IF
NEXT
IF oldfound > 1 THEN
'two founds in one test no good
STOP
END IF

IF nropt > op THEN STOP
IF nropt + blocknr <> sz2 THEN STOP


IF nropt = 0 THEN
'no options in test remaining
'error in soduko or program (much more likely)
STOP
END IF
testoptions(t1) = nropt

IF nropt = 1 THEN
IF oldfound = 0 THEN
'new only point found
f2 = placetofit(foundp)
IF f2 = blocked THEN STOP
IF discardf(f2) = 1 THEN STOP
foundf(f2) = 1
newdiscard = 1
EXIT FOR: 'for the moment
END IF
END IF
END IF
NEXT
solver5solfittest

IF newdiscard = 1 THEN
'solver5fittest
fitnewdiscards
test1loop = 1
fitloop = 1
END IF
LOOP UNTIL test1loop = 0

'solver5reftest



END SUB

SUB fittestgrow2
'like solver2 only on fittable

'solver5reftest

'f7 v f8 , f7-> +/-f2, f8 -> +/-f2 => +/-f2


FOR test = 1 TO sz44
'solver5reftest
IF testoptions(test) = 2 THEN
IF newdiscard = 0 THEN
'solver5reftest
END IF
'for al tests with 2 options
testoption2 test, p7, p8
IF p7 = 0 THEN STOP
IF p8 = 0 THEN STOP

f7 = placetofit(p7)
f8 = placetofit(p8)

FOR f2 = 1 TO maxfit
testf2 = 1
IF foundf(f2) = 1 THEN testf2 = 0
IF discardf(f2) = 1 THEN testf2 = 0
IF f2 = f7 THEN testf2 = 0
IF f2 = f8 THEN testf2 = 0
IF testf2 = 1 THEN
rn = fittable(f7, f2)
IF rn > 0 THEN
IF rn = fittable(f8, f2) THEN
newdiscard = 1
IF rn = blocked THEN
discardf(f2) = 1
ELSEIF rn = implies THEN
foundf(f2) = 1
ELSE
STOP
END IF
END IF
END IF
END IF
NEXT f2
END IF
NEXT test


END SUB

SUB fittestgrow2a

'p7 v p8, p2-> -p7 => p2 -> p8
FOR test = 1 TO sz44
'solver5reftest
IF testoptions(test) = 2 THEN
IF newdiscard = 0 THEN
'solver5reftest
END IF
'for al tests with 2 options
testoption2 test, p3, p4
IF p3 = 0 THEN STOP
IF p4 = 0 THEN STOP

f3 = placetofit(p3)
f4 = placetofit(p4)

FOR f2 = 1 TO maxfit
testf2 = 1
IF foundf(f2) = 1 THEN testf2 = 0
IF discardf(f2) = 1 THEN testf2 = 0
IF f2 = f3 THEN testf2 = 0
IF f2 = f4 THEN testf2 = 0
IF fittable(f2, f3) = implies THEN testf2 = 0
IF fittable(f2, f4) = implies THEN testf2 = 0
IF testf2 = 1 THEN
FOR i3 = 1 TO 2
IF i3 = 1 THEN
f7 = f3: f8 = f4
ELSEIF i3 = 2 THEN
f7 = f4: f8 = f3
ELSE
STOP
END IF
r7 = fittable(f2, f7)
IF r7 = blocked THEN
r8 = fittable(f2, f8)
IF r8 = 0 THEN
fittable(f2, f8) = implies
newimplies = 1
ELSEIF r8 = blocked THEN
newdiscard = 1
discardf(f2) = 1
EXIT FOR
ELSE
STOP
END IF
END IF
NEXT i3
END IF
NEXT f2
END IF
NEXT test

END SUB

SUB fittestgrow3

'fitestgrow3 is like solver3 only on fittable


'solver 3 is heavy testsolver

'solver5reftest
FOR opennr = 3 TO sz2
'message2 "fittestgrow1round " + STR$(opennr)
FOR test1 = 1 TO sz44
options = testoptions(test1)
IF options = opennr THEN

'dotest
first = 1
blockednr = 0
nropt = 0
FOR i2 = 1 TO sz2
p2 = testtoplace(test1, i2)
ref = placeref(p2)
IF ref = implies THEN
testoptions(test) = 1
STOP
END IF
IF ref = blocked THEN
blockednr = blockednr + 1
ELSE
f2 = placetofit(p2)
nropt = nropt + 1

IF first = 1 THEN
first = 0
FOR f3 = 1 TO maxfit
fitlist(f3) = fittable(f2, f3)
NEXT
ELSE
FOR f3 = 1 TO maxfit
IF fitlist(f3) <> 0 THEN
IF fittable(f2, f3) <> fitlist(f3) THEN
fitlist(f3) = 0
END IF
END IF
NEXT
END IF
END IF
NEXT i2

IF opennr + blockednr <> sz2 THEN STOP
IF opennr <> nropt THEN STOP

'do with points still in fitlist
FOR f3 = 1 TO maxfit
rn = fitlist(f3)
IF rn > 0 THEN
newdiscard = 1
IF rn = blocked THEN
discardf(f3) = 1
ELSEIF rn = implies THEN
foundf(f3) = 1
ELSE
STOP
END IF
END IF
NEXT f3
IF newdiscard = 1 THEN EXIT FOR
END IF
NEXT test1
IF newdiscard = 1 THEN EXIT FOR
NEXT opennr

END SUB

SUB fittoplacefill

'fill fittoplace and placetofit
fitnr = 0
FOR p = 1 TO sz6
ref = placeref(p)
IF ref = 0 THEN
fitnr = fitnr + 1
fittoplace(fitnr) = p
placetofit(p) = fitnr
IF fitnr > maxfit THEN STOP
ELSEIF ref = blocked THEN
placetofit(p) = blocked
ELSEIF ref = implies THEN
placetofit(p) = blocked
ELSE
STOP
END IF
NEXT
IF fitnr <> maxfit THEN STOP

FOR f = 1 TO maxfit
foundf(f) = 0
discardf(f) = 0
NEXT

solver5reftest
END SUB

SUB info

'testarrays

'array 1 - sz2 places in the same cel
'array 1*sz2+1 - 2*sz2 places in the same row sym
'array 2*sz2+1 - 3*sz2 places in the same col sym
'array 3*sz2+1 - 4*sz2 places in the same box sym

'not very efficient but will have to do for now.
' much better have all sorted by sym

'array 1 - ???? places wiyh sym=1 row
'array 1 - ???? places wiyh sym=1 col
'array 1 - ???? places wiyh sym=1 grid
'array 1 - ???? places wiyh sym=2
'array 1 - ???? places wiyh sym=3
' ect
'array 3*sz2+1 - 4*sz2 places in the same cel


'variables that only exsist in info

newdiscards = 5
o = 4



END SUB

SUB keyboard

INPUT a$

END SUB

SUB locatecel (cel)

col = celtocol(cel)
row = celtorow(cel)

colextra = INT((col - 1) / sz)
rowextra = INT((row - 1) / sz)
hor = 1 + row + rowextra
ver = 2 + col * 3 + colextra

LOCATE hor, ver, 1

END SUB

SUB main

cel = 41
DO
statustest
IF sstatus = 2 THEN s$ = "no solution"
IF sstatus = 1 THEN s$ = " Soduko solved "
IF sstatus = 0 THEN s$ = " "
message2 s$

showgivens showg

showcel (cel)
locatecel (cel)
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
message SPACE$(50)

b$ = LEFT$(a$, 1)
b = ASC(b$)
SELECT CASE b
CASE 0
'cursor movement
col = celtocol(cel)
row = celtorow(cel)
dir = ASC(RIGHT$(a$, 1))
SELECT CASE dir
CASE 75: col = col - 1: 'left
CASE 77: col = col + 1: 'right
CASE 72: row = row - 1: 'up
CASE 80: row = row + 1: 'down
CASE 83: removegiven (cel): 'del
CASE ELSE
message "unknown enter"
PRINT dir;
'STOP
END SELECT
IF col < 1 THEN col = 1
IF row < 1 THEN row = 1
IF col > sz2 THEN col = sz2
IF row > sz2 THEN row = sz2
cel = rowcoltocel(row, col)
locatecel cel
CASE 13
'enter pressed
STOP
CASE 48
'remove cel from givenlist
removegiven cel
solver
CASE 49 TO 59
'add given to list
sym = b - 48
place = celsymtoplace(cel, sym)
addgiven place
CASE ASC("s")
solver
CASE ASC("b")
brutesolver
CASE ASC("g")
showg = 1 - showg
CASE ASC("c")
message "clear board? y/.."
INPUT a$
message SPACE$(50)
message2 SPACE$(50)
IF a$ = "y" THEN
clearpuzzle
cel = 41
END IF
CASE ASC("x")
message "end program? y/.."
INPUT a$
message SPACE$(50)
message2 SPACE$(50)
IF a$ = "y" THEN
EXIT SUB
END IF
CASE ASC("t")
solverstest
CASE ASC("f")
solversall

CASE ELSE
message " "
LOCATE 20, 1
b$ = LEFT$(a$, 1)
c$ = RIGHT$(a$, 1)
PRINT " >"; a$; "< = "; ASC(b$), ASC(c$)
'STOP
END SELECT
LOOP




END SUB

SUB memprint (a$)

PRINT USING " \ \ "; a$;
PRINT USING "###### ####### #####"; FRE(0); FRE(-1); FRE(-2)

END SUB

SUB message (a$)
LOCATE 20, 1
PRINT SPACE$(50)

LOCATE 20, 1
PRINT a$

END SUB

SUB message2 (a$)
LOCATE 21, 1
PRINT SPACE$(50)
'PRINT SPACE$(50)

LOCATE 21, 1
PRINT a$

END SUB

FUNCTION opencount

foundnr = 0
blockednr = 0
opennr = 0
FOR i = 1 TO sz6
ref = placeref(i)
IF ref = blocked THEN
blockednr = blockednr + 1
ELSEIF ref = implies THEN
foundnr = foundnr + 1
ELSE
opennr = opennr + 1
END IF
NEXT

IF foundnr > sz4 THEN STOP

IF foundnr = sz4 THEN
IF sstatus <> 2 THEN
'soduko solved
sstatus = 1
IF opennr <> 0 THEN STOP
END IF
END IF

'test the other way around
IF opennr = 0 THEN
IF foundnr <> sz4 THEN STOP
IF foundnr = sz4 THEN
IF sstatus <> 2 THEN
'soduko solved
sstatus = 1
IF opennr <> 0 THEN STOP
END IF
END IF
END IF

opencount = opennr

END FUNCTION

SUB pitarraytest

FOR p1 = 1 TO sz6
IF placeref(p1) = implies THEN
FOR c2 = 1 TO sz4
p2 = pitarray(p1, c2)
IF p2 > 0 THEN
IF placeref(p2) <> implies THEN STOP
END IF
NEXT
END IF
NEXT

FOR p1 = 1 TO sz6
IF placeref(p1) = 0 THEN
FOR c2 = 1 TO sz4
p2 = pitarray(p1, c2)
IF p2 > 0 THEN
IF placeref(p2) = blocked THEN STOP
END IF
NEXT
END IF
NEXT

END SUB

SUB pittablestats

maxtrl = 0
linkcnt = 0

FOR p1 = 1 TO sz6
p1loop = 1
c1 = placetocel(p1)
IF placeref(p1) > sz6 THEN
p1loop = 0
ELSE
opennr = opennr + 1
END IF
IF p1loop = 1 THEN
trl = 0
FOR c2 = 1 TO sz4
p2 = pitarray(p1, c2)
IF p2 > 0 THEN
IF placeref(p2) = 0 THEN
'p1 -> p2
trl = trl + 1
linkcnt = linkcnt + 1
IF pitarray(p2, c1) = p1 THEN
eqcount = eqcount + 1
ELSEIF pitarray(p2, c1) <> 0 THEN
STOP
'major error in solver4 !!!!!!!!!!!
END IF
END IF
END IF
NEXT
IF trl > maxtrl THEN maxtrl = trl
END IF
NEXT p1

opc = opencount
IF opennr <> opc THEN STOP

message2 " "
message "number of implications (cnt all)" + STR$(linkcnt)
keyboard
message "longest tread" + STR$(maxtrl)
keyboard




'look for equalivalents p1->p2 and p2->p1

DIM placetofpit(sz6)
fpnr = 0
opennr = 0
eqcount = 0
linkcnt = 0
maxtrl = 0

FOR p1 = 1 TO sz6
p1loop = 1
IF placeref(p1) > sz6 THEN
placetofpit(p1) = blocked
p1loop = 0
ELSE
opennr = opennr + 1
END IF
IF placetofpit(p1) > 0 THEN p1loop = 0
IF p1loop = 1 THEN
c1 = placetocel(p1)
IF placetofpit(p1) <> 0 THEN STOP
fpnr = fpnr + 1
placetofpit(p1) = fpnr
FOR p2 = 1 TO sz6
p2loop = 1
c2 = placetocel(p2)
IF placeref(p2) > sz6 THEN p2loop = 0: ' not really nessesary ?
IF pitarray(p1, c2) <> p2 THEN p2loop = 0
IF p1 = p2 THEN p2loop = 0
IF p2loop = 1 THEN
trl = trl + 1
'p1 -> p2
IF pitarray(p2, c1) = p1 THEN
'p1 -> p2 , p2 ->p1 => p1 <-> p2
placetofpit(p2) = fpnr
eqcount = eqcount + 1
ELSEIF pitarray(p2, c1) <> 0 THEN
STOP
'major error in solver4 !!!!!!!!!!!
END IF
END IF
NEXT
END IF
IF trl > maxtrl THEN maxtrl = trl
NEXT p1

opc = opencount

IF opennr <> opc THEN STOP
message2 " "
message " number of treads " + STR$(fpnr)
keyboard
'message "number of implications " + STR$(linkcnt)
'keyboard

message "number of p1 <--> p2 = " + STR$(eqcount)
keyboard

'count opentests
testnr = 0
FOR t1 = 1 TO sz44
IF testoptions(t1) > 2 THEN
testnr = testnr + 1
IF testoptions(t1) > 7 THEN
s$ = testsig$(t1)
'STOP
END IF
END IF
NEXT
message2 " "
message " number of open tests " + STR$(testnr)
keyboard



END SUB

FUNCTION placesig$ (place)


SELECT CASE place
CASE 0
result$ = "--0--"
CASE blocked
result$ = "block"
CASE IS > sz6
STOP
CASE IS < 0
STOP

CASE ELSE
cel = placetocel(place)
sym = placetosym(place)
col = celtocol(cel)
row = celtorow(cel)
c$ = CHR$(col + 48)
r$ = CHR$(row + 48)
s$ = CHR$(sym + 48)
result$ = "R" + r$ + "C" + c$ + "=" + s$
END SELECT

placesig$ = result$

END FUNCTION

SUB printgrid


t1$ = " ΙΝΝΝΝΝΝΝΝΝΝΛΝΝΝΝΝΝΝΝΝΛΝΝΝΝΝΝΝΝΝ» "
r1$ = " Ί + + + Ί + + + Ί + + + Ί "
r2$ = " ΜΝΝΝΝΝΝΝΝΝΝΞΝΝΝΝΝΝΝΝΝΞΝΝΝΝΝΝΝΝΝΉ "
b1$ = " ΘΝΝΝΝΝΝΝΝΝΝΚΝΝΝΝΝΝΝΝΝΚΝΝΝΝΝΝΝΝΝΌ "

LOCATE 1, 1
PRINT t1$
PRINT r1$
PRINT r1$
PRINT r1$
PRINT r2$
PRINT r1$
PRINT r1$
PRINT r1$
PRINT r2$
PRINT r1$
PRINT r1$
PRINT r1$
PRINT b1$

END SUB

SUB readsoduko (a$)

IF LEN(a$) > sz4 THEN STOP

clearpuzzle
FOR c = 1 TO LEN(a$)
b$ = MID$(a$, c, 1)
b = ASC(b$)
IF b > 48 AND b < 59 THEN
sym = b - 48
IF sym > sz2 THEN STOP
IF sym < 1 THEN STOP
place = celsymtoplace(c, sym)
given(c) = place
givennr = givennr + 1
addtosolution place
IF sstatus > 0 THEN EXIT SUB
END IF
NEXT

END SUB

SUB removegiven (cel)

'remove given from given list

place = solution(cel)
IF place = 0 THEN
message "nothing given on this place"
EXIT SUB
END IF

place = given(cel)
IF place = 0 THEN
message "not a given"
ELSE
given(cel) = 0

clearsolverdata

'add all given to solution
givennr = 0
FOR i = 1 TO sz4
place = given(i)
IF place > 0 THEN
addtosolution (place)
IF sstatus > 0 THEN EXIT SUB
givennr = givennr + 1
END IF
NEXT
END IF

END SUB

FUNCTION rowcoltocel (row, col)

cel = row * sz2 + col - sz2

IF cel < 1 THEN STOP
IF cel > sz4 THEN STOP
rowcoltocel = cel

END FUNCTION

SUB showcel (cel)

cel$ = celsig$(cel)

'mini cel overview
LOCATE 1, 40
PRINT "cel"; cel; cel$
LOCATE 2, 40
PRINT "Cel options"
FOR c1 = 1 TO 3
FOR c2 = 1 TO 3
s = c1 * 3 + c2 - 3
p = celsymtoplace(cel, s)
ref = placeref(p)
IF ref = blocked THEN
s$ = "-"
ELSE
s$ = symsig$(s)
END IF
LOCATE 2 + c1, 40 + 2 * c2
PRINT s$;
NEXT
NEXT

'giventest
LOCATE 6, 42
p = solution(cel)
IF p > 0 THEN
IF given(cel) > 0 THEN
IF given(cel) <> p THEN STOP
i$ = "Given"
ELSE
i$ = "Found"
END IF
ELSE
i$ = " "
END IF
PRINT i$;

END SUB

SUB showgivens (show)

FOR c = 1 TO sz4
locatecel (c)
p = solution(c)
pg = given(c)

IF p > 0 THEN
test = 1
IF placetocel(p) <> c THEN test = 0
IF pg > 0 AND pg <> p THEN test = 0
IF test = 0 THEN
'c$=celsig$(c)
'p2$=placesig$(p)
'p1$ = placesig$(test2(c))
STOP
END IF
sym = placetosym(p)
s$ = symsig$(sym)
IF pg > 0 AND show = 1 THEN
PRINT s$ + "*";
ELSE
PRINT s$ + " ";
END IF
ELSE
IF pg > 0 THEN STOP
PRINT "+ ";
END IF
NEXT

END SUB

SUB showplaceingrid (place)

cel = placetocel(place)
sym = placetosym(place)
locatecel (cel)
PRINT symsig$(sym)

END SUB

SUB showplacementsstat

foundnr = 0
blockednr = 0
opennr = 0
FOR i = 1 TO sz6
ref = placeref(i)
IF ref = blocked THEN
blockednr = blockednr + 1
ELSEIF ref = implies THEN
foundnr = foundnr + 1
ELSE
opennr = opennr + 1
END IF
NEXT
LOCATE 18, 1
PRINT "Placements ";
PRINT " open"; opennr; "blocked"; blockednr; "in solution"; foundnr

END SUB

SUB showsolution
'
'test solution
'if points in place ref implies are also in solution

DIM test1(sz4): 'list from placeref

teststatus = 1
FOR p = 1 TO sz6
IF placeref(p) = implies THEN
cel = placetocel(p)
IF test1(cel) > 0 THEN
STOP
END IF
test1(cel) = p
END IF
NEXT

FOR c = 1 TO sz4
p = solution(c)
IF test1(c) <> p THEN
'c$=celsig$(c)
'p2$=placesig$(p)
'p1$ = placesig$(test2(c))
STOP
END IF

locatecel (c)
IF p > 0 THEN
sym = placetosym(p)
PRINT symsig$(sym); " ";
ELSE
PRINT "+ ";
teststatus = 0
END IF
NEXT

IF teststatus = 1 AND sstatus = 0 THEN STOP

END SUB

SUB showtestresults

DIM teststest(sz2)

LOCATE 15, 1
FOR i = 1 TO 5
PRINT SPACE$(50)
NEXT

FOR t = 1 TO sz44
op = testoptions(t)
IF op = 0 THEN STOP
teststest(op) = teststest(op) + 1
NEXT

'test solution
gc = 0
fc = 0
oc = 0
FOR c = 1 TO sz4
p = solution(c)
g = given(c)
IF g > 0 THEN
gc = gc + 1
IF p <> g THEN STOP
END IF
IF p > 0 THEN
fc = fc + 1
ELSE
oc = oc + 1
END IF
NEXT

'IF fc <> foundnr THEN STOP
IF gc <> givennr THEN STOP
IF fc + oc <> sz4 THEN STOP
IF fc * 4 <> teststest(1) THEN STOP

LOCATE 15, 1
PRINT "Tests analyses"
FOR i = 1 TO sz2
PRINT USING " ### "; teststest(i);
NEXT
PRINT

PRINT "Cel analysis";
PRINT " given "; gc; "found"; fc - gc; "open"; oc

showplacementsstat

END SUB

SUB solver

'main solverloop

'only solver 1 and fitsolver at the moment

IF sstatus = 2 THEN EXIT SUB

cleartestoptions

loopnr = 0
DO
solverloop = 0
loopnr = loopnr + 1
message "solverloop" + STR$(loopnr)
'keyboard
IF loopnr MOD 100 = 0 THEN
keyboard
END IF
solver1
IF sstatus > 0 THEN
EXIT SUB
END IF

showtestresults

IF solverloop = 0 THEN
' solver2
END IF
IF sstatus <> 0 THEN EXIT SUB

IF solverloop = 0 THEN
'heavy testsolver
' solver3 (4)
END IF
IF sstatus <> 0 THEN EXIT SUB

IF solverloop = 0 THEN
'PIT solver
' solver4
END IF
IF sstatus <> 0 THEN EXIT SUB

IF solverloop = 0 THEN
'heavy testsolver
'solver3 (sz2)
END IF
IF sstatus <> 0 THEN EXIT SUB

openpl1 = opencount
IF solverloop = 0 THEN
'FIT solver
solver5
IF solverloop = 0 THEN
openpl2 = opencount
IF openpl2 < openpl1 THEN
STOP
END IF
END IF
END IF
IF sstatus <> 0 THEN EXIT SUB

LOOP UNTIL solverloop = 0


message2 SPACE$(50)

END SUB

SUB solver1

'test for only option in test
'and update testoptions

message2 "solver1"

DO
newfound = 0
FOR t = 1 TO sz44
' testsig$(t)
IF testoptions(t) = 0 THEN STOP
IF testoptions(t) > 1 THEN
posnr = 0
posp = 0
allreadyfound = 0
blockedoptions = 0
FOR i = 1 TO sz2
p = testtoplace(t, i)
ref = placeref(p)
SELECT CASE ref
CASE blocked
blockedoptions = blockedoptions + 1
CASE implies
allreadyfound = allreadyfound + 1
testoptions(t) = 1
CASE ELSE
posnr = posnr + 1
posp = p
END SELECT
NEXT
IF allreadyfound > 1 THEN
'big problem
STOP
END IF
IF allreadyfound = 1 AND posnr > 0 THEN
'something wrong
'not all imposibilities are blocked
STOP
FOR i = 1 TO sz2
p = testtoplace(t, i)
ref = placeref(p)
SELECT CASE ref
CASE blocked, implies
'do nothing
CASE ELSE
addtoblocked (p)
END SELECT
NEXT
END IF
IF allreadyfound = 0 THEN
IF posnr = 0 THEN
'no solution
sstatus = 2
EXIT SUB
END IF
IF posnr = 1 THEN
'found symbol
addtosolution (posp)
IF sstatus > 0 THEN EXIT SUB
solverloop = 1
testoptions(t) = 1
newfound = 1
ELSE
testoptions(t) = posnr
IF blockedoptions + posnr <> sz2 THEN
STOP
END IF
END IF
END IF
END IF
NEXT
LOOP UNTIL newfound = 0

statustest


END SUB





SUB solver2


'solver2
'if a test has only two options and both block the same place
'then block that place

message2 "solver2"

[/code]


Last edited by soduko on Sat Jul 11, 2009 7:17 am; edited 1 time in total
Back to top
View user's profile Send private message
soduko

Joined: 10 Oct 2005
Posts: 50
:

Items
PostPosted: Sat Jul 11, 2009 7:15 am    Post subject: Reply with quote

oops it stoped after solver 2

here from sub solver 2 onwards
Code:



SUB solver2


'solver2
'if a test has only two options and both block the same place
'then block that place

message2 "solver2"

testval = sz2 - 2
FOR test = 1 TO sz44
  IF testoptions(test) = 2 THEN
    p1 = 0
    p2 = 0
    posnr = 0
    countblocked = 0
    solvedtest = 0
    'check test
    FOR i = 1 TO sz2
      p = testtoplace(test, i)
      ref = placeref(p)
      IF ref = implies THEN
        testoptions(test) = 1
        solvedtest = solvedtest + 1
      END IF

      IF ref = blocked THEN
        countblocked = countblocked + 1
      ELSE
        posnr = posnr + 1
        IF p1 = 0 THEN
          p1 = p
        ELSEIF p2 = 0 THEN
          p2 = p
        ELSE
          'problem
          STOP
        END IF
      END IF
    NEXT
    IF solvedtest > 1 THEN
      'problem
      STOP
    END IF

    IF solvedtest = 1 THEN
      IF posnr > 0 THEN
        'problem
        STOP
      END IF
    END IF
    IF posnr = 0 THEN STOP
    IF posnr = 1 THEN
      IF posnr + countblocked <> sz2 THEN STOP
      'otherone already blocked
      addtosolution p1
      IF sstatus > 0 THEN EXIT SUB
      solverloop = 1
    END IF
    IF posnr = 2 THEN
      clearplacelist
      'mark places blocked by p1
      FOR i1 = 1 TO 4
        t1 = placetotest(p1, i1)
        FOR j1 = 1 TO sz2
          'pt1 is every place blocked by p1
          pt1 = testtoplace(t1, j1)
          ptest = 1
          ' placesig$(p2)
          IF pt1 = p1 THEN ptest = 0
          IF pt1 = p2 THEN ptest = 0
          IF placeref(pt1) = blocked THEN ptest = 0

          IF ptest = 1 THEN
            placelist(pt1) = 1
          END IF
        NEXT
      NEXT

      'compare with points blocked by p2
      FOR i2 = 1 TO 4
        t2 = placetotest(p2, i2)
        FOR j2 = 1 TO sz2
          pt2 = testtoplace(t2, j2)
          IF placelist(pt2) = 1 THEN
            'that is also blocked by p2
            'block it
            addtoblocked (pt2)
            solverloop = 1
          END IF
        NEXT
      NEXT
    END IF
  END IF
NEXT

END SUB

SUB solver3 (depth)

'test all open tests with 3 till depth options


IF depth < 3 THEN EXIT SUB
IF depth > sz2 THEN depth = sz2

DIM solver3list(sz6)

'heavy testsolver

FOR opennr = 3 TO depth
  message2 "solver3 round " + STR$(opennr)
  FOR test = 1 TO sz44
    options = testoptions(test)
    IF options = 0 THEN STOP
    IF options = opennr THEN
      't$ = testsig$(test)
      placenr = 0
      'check test
      FOR i = 1 TO sz2
        place = testtoplace(test, i)
        ref = placeref(place)
        IF ref = implies THEN
          testoptions(test) = 1
          STOP
        END IF
        IF ref = blocked THEN
          countblocked = countblocked + 1
        ELSE
          'put all blocked by p in placelist
          clearplacelist
          placenr = placenr + 1
          IF placenr > opennr THEN STOP
          'addpoints blocked by place to placelist
          FOR i11 = 1 TO 4
            t1 = placetotest(place, i11)
            FOR i12 = 1 TO sz2
              p2 = testtoplace(t1, i12)
              'p2 is every place blocked by place
              placelist(p2) = 1
            NEXT
          NEXT
          placelist(place) = 0
          IF placenr = 1 THEN
            'first option for test
            'add copy placelist to solver3list
            FOR p = 1 TO sz6
              lp = placelist(p)

              IF placeref(p) = blocked THEN lp = 0
              IF lp = 1 THEN
                lp$ = placesig$(lp)
              END IF

              solver3list(p) = lp
            NEXT
          ELSE
            'remove options in solver3 list but not in placelist
           
            FOR p = 1 TO sz6
              IF solver3list(p) = 1 THEN
                IF placelist(p) = 0 THEN
                  'remove option
                  solver3list(p) = 0
                END IF
              END IF
            NEXT
          END IF
        END IF
      NEXT
     
      'block points still in solver3list
      FOR p = 1 TO sz6
        IF solver3list(p) = 1 THEN
          addtoblocked (p)
          solverloop = 1
        END IF
      NEXT
    END IF
  NEXT
NEXT
END SUB

SUB solver4


'pitsolver
'makes pittables and does something with them
'can have subsolvers

message2 "solver4 PIT solver                     "

DIM alltestlist(sz44)

'add all points to pitarray
FOR p = 1 TO sz6
  IF placeref(p) = 0 THEN
    c = placetocel(p)
    pitarray(p, c) = p
  END IF
  'blocked and found have pitarray(p,c)=0
NEXT

'find links
linksfound = 0
newdiscard = 0
FOR test = 1 TO sz44
  IF testoptions(test) = 2 THEN
    testoption2 test, p1, p2
   
    IF p1 = 0 THEN STOP
    IF p2 = 0 THEN STOP
    IF p1 = p2 THEN STOP
   
    FOR pitloop = 1 TO 2
      'a$= testsig$(test)
      'a$= placesig$(p1)
      'a$= placesig$(p2)
      'a$= placesig$(p3)
      'a$= placesig$(pt)
      'p1 -> -p2 and p2 -> -p1
      ' =>   -p1 -> p2  and -p2 -> p1
      '
      'now find p3   p3 -> -p1
      'then p3 -> p2
      c2 = placetocel(p2)
      FOR i1 = 1 TO 4
        t1 = placetotest(p1, i1)
        IF t1 <> test THEN
          FOR j1 = 1 TO sz2
            p3 = testtoplace(t1, j1)
            ptest = 1
            IF placeref(p3) = blocked THEN ptest = 0
            IF placeref(p3) = implies THEN STOP
            IF p3 = p1 THEN ptest = 0
            IF p3 = p2 THEN ptest = 0
            IF ptest = 1 THEN
              'p3 -> - p1 => p3 -> p2
              linksfound = linksfound + 1
              pt = pitarray(p3, c2)
              IF pt = 0 THEN
                pitarray(p3, c2) = p2
              ELSEIF pt <> p2 THEN
                'p3 -> p2, p3 -> pt, -(pt & p2)  => -p3
                c3 = placetocel(p3)
                pitarray(p3, c3) = blocked
              END IF
            END IF
          NEXT
        END IF
      NEXT
      SWAP p1, p2
      'now with swaped p1 and p2
    NEXT pitloop
  END IF
NEXT

IF linksfound = 0 THEN
 'just for the moment
 EXIT SUB
END IF

'expand pitarrays
' p1-> p2, p2 -> p3 => p1 -> p3
'also
' p1 -> p2, p2 -> p3, p1 -> pt, - (p3 & pt) => -p1
' p1 -> p2, p2 -> -p2 (p2 is blocked)  => -p1

pitloop = 0
DO
  pitloop = pitloop + 1
  pitgrow = 0
  FOR p1 = 1 TO sz6
    placeblock = 0
    ptest = 0
    IF placeref(p1) = 0 THEN
      ptest = 1
      c1 = placetocel(p1)
      IF pitarray(p1, c1) = blocked THEN ptest = 0
    END IF
    IF ptest = 1 THEN
      'test p1
      IF pitarray(p1, c1) <> p1 THEN STOP

      'clear alltestlist
      'every test can only be fulfilled once
      FOR i = 1 TO sz44
        alltestlist(i) = 0
      NEXT
      FOR it1 = 1 TO 4
        t1 = placetotest(p1, it1)
        alltestlist(t1) = p1
      NEXT

      FOR c2 = 1 TO sz4
        p2 = pitarray(p1, c2)
        ptest = 1
        IF p2 = 0 THEN ptest = 0
        IF p1 = p2 THEN ptest = 0
        IF ptest = 1 THEN
          ' p1-> p2

          'test if p2 is blocked
          ct = placetocel(p2)
          IF ct <> c2 THEN STOP
          IF pitarray(p2, c2) <> p2 THEN
            ' p1 -> p2,  -p2 => -p1
            IF pitarray(p2, c2) <> blocked THEN STOP
            placeblock = p1
            EXIT FOR
          END IF

          'fill alltestlist with p2
          FOR it2 = 1 TO 4
            t2 = placetotest(p2, it2)
            pt = alltestlist(t2)
            IF pt = 0 THEN
              alltestlist(t2) = p2
            ELSEIF p2 <> pt THEN
              ' p1 ->pt, p1 -> p2,  -(pt & p2)
              ' => -p1
              placeblock = p1
              EXIT FOR
            END IF
          NEXT
         
          IF placeblock > 0 THEN
            IF placeblock <> p1 THEN STOP
            EXIT FOR
          END IF
         
          FOR c3 = 1 TO sz4
            p3 = pitarray(p2, c3)
            IF p3 > 0 THEN
              'p2 -> p3 => p1 -> p3

              'test if p3 is blocked
              ct = placetocel(p3)
              IF c3 <> ct THEN STOP
              IF pitarray(p3, c3) <> p3 THEN
                ' p1 -> p3, -p3 => -p1
                IF pitarray(p3, c3) <> blocked THEN STOP
                placeblock = p1
                EXIT FOR
              END IF

              IF pitarray(p1, c3) = 0 THEN
                pitarray(p1, c3) = p3
                pitgrow = 1
               'no need to test if there is already another value
               'in pitarray that test is done in alltestlist
              END IF

              'fill and test alltestlist
              FOR it3 = 1 TO 4
                t3 = placetotest(p3, it3)
                pt = alltestlist(t3)
                IF pt = 0 THEN
                  alltestlist(t3) = p3
                ELSEIF pt <> p3 THEN
                  ' p1 ->pt, p1 -> p3, -(pt & p3)
                  ' => -p1
                  placeblock = p1
                  EXIT FOR
                END IF
              NEXT
              IF placeblock > 0 THEN
                IF placeblock <> p1 THEN STOP
                EXIT FOR
              END IF
            END IF
          NEXT c3
          IF placeblock > 0 THEN
            IF placeblock <> p1 THEN STOP
            EXIT FOR
          END IF
        END IF
      NEXT c2
    END IF
    IF placeblock > 0 THEN
      IF placeblock <> p1 THEN STOP
      pitarray(p1, c1) = blocked
    END IF
  NEXT p1
LOOP UNTIL pitgrow = 0

'if p is blocked block it...
DO
  newdiscard = 0
  FOR p1 = 1 TO sz6
    c1 = placetocel(p1)
    IF pitarray(p1, c1) = blocked THEN
      pitarray(p1, c1) = 0
      addtoblocked p1
      solverloop = 1
      ' - p1, p2 -> p1 => -p2
      FOR p2 = 1 TO sz6
        IF pitarray(p2, c1) = p1 THEN
          c2 = placetocel(p2)
          IF pitarray(p2, c2) <> 0 THEN
            pitarray(p2, c2) = blocked
            newdiscard = 1
          END IF
        END IF
      NEXT
    END IF
  NEXT
LOOP WHILE newdiscard = 1

pitarraytest

IF solverloop = 1 THEN
  EXIT SUB
END IF

'to solver6
'solver6 not any more....

DIM cellist(sz4)
FOR test = 1 TO sz44
  IF testoptions(test) > 1 THEN
    p1 = 0
    FOR i = 1 TO sz2
      p = testtoplace(test, i)
      ref = placeref(p)
      IF ref = implies THEN STOP

      IF ref = blocked THEN
        countblocked = countblocked + 1
      ELSE
        IF p1 = 0 THEN
          p1 = 1
          'first option
          FOR c = 1 TO sz4
            cellist(c) = pitarray(p, c)
          NEXT
        ELSE
          FOR c = 1 TO sz4
            pt = cellist(c)
            IF pt > 0 THEN
              IF pitarray(p, c) <> pt THEN
                cellist(c) = 0
              END IF
            END IF
          NEXT
        END IF
      END IF
    NEXT

    FOR c = 1 TO sz4
      pt = cellist(c)
      IF pt > 0 THEN
        addtosolution pt
        IF sstatus > 0 THEN EXIT SUB
      END IF
    NEXT
  END IF
NEXT

END SUB

SUB solver5

'FIT solver the ultimate....
'and this is only half of it...
'but it is a bit slow.... always the case
'and behaves erraticly... sometimes  not any more
'now even stronger testgrow2....
' bla bla soon there will be solver 6 fullpittables


' message2 "solver5 ---- FIT solver   pre start test"

' DIM fittable(sz6, sz6) problem.... to big
'  388 <=  maxsize for pittable < 389
' depends on the size of the program  (problem we do't know that size yet)
' all set at program start now
'can i also use sub's inside solver :)
'all sub's start with fit

'first do solver4
solver4

'count number of options left
fitnr = opencount
maxfit = fitnr

IF fitnr = 0 THEN STOP

IF maxfit > maxfitsize THEN
  message "fittable to big for allocated memory "
  'do solver4 instead (is allready done)
  keyboard
  EXIT SUB
END IF

' message2 "solver5 ---- FIT solver   start"

'fill fittoplace and placetofit
fittoplacefill

testgrow = 0
fitloop = 0

fittablefill1
fittablefrompit

message2 "solver5 ---- FIT solver: loop  1"
'big fit loop
fitloop = 0
testgrow = 1

DO
  'start of fit loop
  fitloopnr = fitloopnr + 1
  message2 "solver5 ---- FIT solver: loop " + STR$(fitloopnr)
 
  fitloop = 0
 
  solver5reftest
 
  fittestgrow1
  fittablefill2
  fitplacegrow
  'solver5fittest

  IF newdiscard = 1 THEN
    fitnewdiscards
  END IF
  'solver5reftest
 
  fittestgrow
  'solver5reftest

  IF fitloop = 0 THEN
    fitmixedgrow
  END IF

LOOP UNTIL fitloop = 0

solver5reftest
fittabletests

fittabletopit

statustest
IF sstatus = 0 THEN
  'pittablestats
END IF

END SUB

SUB solver5fittest

FOR f1 = 1 TO maxfit
  IF foundf(f1) = 1 THEN
    IF discardf(f1) = 1 THEN
      STOP
    END IF
  END IF
NEXT
solver5solfittest

END SUB

SUB solver5reftest
'test if all discarded are blocked and
'all found are in solution

FOR f1 = 1 TO maxfit

  IF discardf(f1) = 1 THEN
    IF foundf(f1) = 1 THEN
      STOP
    END IF
  END IF

  p1 = fittoplace(f1)
  IF newdiscard = 0 THEN
    IF discardf(f1) = 1 THEN
      IF placeref(p1) <> blocked THEN STOP
    END IF
    IF foundf(f1) = 1 THEN
      IF placeref(p1) <> implies THEN STOP
    END IF
  END IF
  IF placeref(p1) = blocked THEN
    IF discardf(f1) <> 1 THEN STOP
  END IF
  IF placeref(p1) = implies THEN
    IF foundf(f1) <> 1 THEN STOP
  END IF

  IF newdiscard = 0 THEN
    'big fittabletest
    IF discardf(f1) = 1 OR foundf(f1) = 1 THEN
      FOR f2 = 1 TO maxfit
        IF f1 <> f2 THEN
          IF fittable(f1, f2) <> 0 THEN STOP
          IF fittable(f2, f1) <> 0 THEN STOP
        END IF
      NEXT
    END IF
  END IF
NEXT

'test all places

FOR p1 = 1 TO sz6
  ref = placeref(p1)
  f1 = placetofit(p1)
  IF ref = 0 THEN
    IF f1 > sz6 THEN STOP
  ELSE
    IF placetofit(p1) < sz6 THEN
      ptest = 0
      IF ref = implies AND foundf(f1) = 1 THEN ptest = 1
      IF ref = blocked AND discardf(f1) = 1 THEN ptest = 1
      IF ptest = 0 THEN
        STOP
      END IF
    END IF
  END IF
NEXT

solver5solfittest

END SUB

SUB solver5solfittest

'idea is to test places already processed by fitnewdiscards

FOR f1 = 1 TO maxfit
  p1 = fittoplace(f1)
  IF placeref(p1) <> 0 THEN
    FOR f2 = 1 TO maxfit
      IF fittable(f1, f2) <> 0 THEN STOP
      IF fittable(f2, f1) <> 0 THEN STOP
    NEXT
  END IF
NEXT




END SUB

SUB solver6

' fullpittable solver new idea

'problem with fittable is thatit id difficult to add find a possible solution
'from fittable (even if there is more than one)
' the full fittable is to overcome that problem.
' all ffittable(place,test) need a placement value
'and you can just try to fill it one after another....


'starts with solver4
'solver4

'at the moment as addon to solver4

'look for equalivalents  p1->p2 and p2 -> p1
DIM placetofpit(sz6)
fpnr = 0
eqcount = 0
FOR p1 = 1 TO sz6
  p1loop = 1
  IF placeref(p1) > sz6 THEN placetofpit(p1) = blocked
  IF placetofpit(p1) > 1 THEN p1loop = 0

  IF p1loop = 1 THEN
    c1 = placetocel(p1)
    fpnr = fpnr + 1
    placetofpit(p1) = fpnr
    FOR p2 = 1 TO sz6
      p2loop = 1
      c2 = placetocel(p2)
      IF placeref(p2) > sz6 THEN p2loop = 0: ' not really nessesary ?
      IF pitarray(p1, c2) <> p2 THEN p2loop = 0
      IF p1 = p2 THEN p2loop = 0
      IF p2loop = 1 THEN
        'p1 -> p2
        IF pitarray(p2, c1) = p1 THEN
          'p2 ->p1    => p1 <-> p2
          placetofpit(p2) = fpnr
          eqcount = eqcount + 1
        ELSEIF pitarray(p2, c1) <> 0 THEN
          STOP
          'major error in solver4 !!!!!!!!!!!
        END IF
      END IF
    NEXT
  END IF
NEXT
message2 "number of p1 <--> p2 = " + STR$(eqcount)

   
END SUB

SUB solverdata

'updates solverscreen with actual values
'doesn't do any solving (not even hidden and naked singles.


cleartestoptions

'full test
FOR t = 1 TO sz44
  ' testsig$(t)
  IF testoptions(t) <> sz2 THEN STOP
  posnr = 0
  allreadyfound = 0
  blockedoptions = 0
  FOR i = 1 TO sz2
    p = testtoplace(t, i)
    ref = placeref(p)
    SELECT CASE ref
      CASE blocked
        blockedoptions = blockedoptions + 1
      CASE implies
        allreadyfound = allreadyfound + 1
        posnr = posnr + 1
      CASE ELSE
        posnr = posnr + 1
    END SELECT
  NEXT
  IF allreadyfound > 1 THEN
    'big problem
    STOP
  END IF
     
  IF blockedoptions + posnr <> sz2 THEN
    STOP
  END IF

  IF allreadyfound = 1 AND posnr > 1 THEN
    'something wrong
    'not all imposibilities are blocked
    STOP
  END IF
  IF allreadyfound = 0 THEN
    IF posnr = 0 THEN
      'no solution
      sstatus = 2
      STOP
    END IF
  END IF
  testoptions(t) = posnr
NEXT
showtestresults
statustest
SELECT CASE sstatus
  CASE 0: message2 "soduko unsolved  "
  CASE 1: message2 "soduko solved    "
  CASE 2: message2 "soduku has no solution"
  CASE ELSE: STOP
END SELECT


END SUB

SUB solversall

'main solverloop
'does use all solvers

IF sstatus = 2 THEN EXIT SUB

cleartestoptions

loopnr = 0
DO
  solverloop = 0
  loopnr = loopnr + 1
  message "all solvers loop" + STR$(loopnr)
  'keyboard
  IF loopnr MOD 100 = 0 THEN
    keyboard
  END IF
  solver1
  IF sstatus = 2 THEN
    EXIT SUB
  END IF

  showtestresults

  IF solverloop = 0 THEN
    solver2
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'heavy testsolver
    solver3 (4)
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'PIT solver
    solver4
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'heavy testsolver
    solver3 (sz2)
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'FIT solver
    solver5
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

LOOP UNTIL solverloop = 0
message2 SPACE$(50)



END SUB

SUB solversread

'solverloop for read soduko

IF sstatus = 2 THEN EXIT SUB

cleartestoptions

loopnr = 0
DO
  solverloop = 0
  loopnr = loopnr + 1
  message "read solvers loop" + STR$(loopnr)
  'keyboard
  IF loopnr MOD 100 = 0 THEN
    keyboard
  END IF
  solver1
  IF sstatus > 0 THEN
    EXIT SUB
  END IF
 
  'show = 1
  IF show = 1 THEN
    showtestresults
  END IF

  IF solverloop = 0 THEN
    solver2
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'heavy testsolver
    ' solver3 (sz2)
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'PIT solver
    ' solver4
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

  IF solverloop = 0 THEN
    'FIT solver
    solver5
    IF sstatus = 2 THEN STOP
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

LOOP UNTIL solverloop = 0
message2 SPACE$(50)



END SUB

SUB solverstest

'main solverloop TESTSOLVERSONLY

IF sstatus = 2 THEN EXIT SUB

cleartestoptions

loopnr = 0
DO
  solverloop = 0
  loopnr = loopnr + 1
  message "testsolverloop" + STR$(loopnr)
  'keyboard
  IF loopnr MOD 100 = 0 THEN
    keyboard
  END IF
  solver1
  IF sstatus = 1 THEN
    EXIT SUB
  END IF

  showtestresults

  IF solverloop = 0 THEN
    solver2
    IF sstatus > 0 THEN
      EXIT SUB
    END IF

  END IF

  IF solverloop = 0 THEN
    'heavy testsolver
    solver3 (sz2)
    IF sstatus > 0 THEN
      EXIT SUB
    END IF
  END IF

LOOP UNTIL solverloop = 0
message2 SPACE$(50)



END SUB

SUB statustest

'test if all points are found
IF sstatus = 0 THEN
  stest = 1
  FOR cel = 1 TO sz4
    IF solution(cel) = 0 THEN
      stest = 0
      EXIT FOR
    END IF
  NEXT
  IF stest = 1 THEN
    sstatus = 1
  END IF
END IF

END SUB

FUNCTION symsig$ (sym)

sig$ = CHR$(sym + 48)

IF sym = 0 THEN
  sig$ = "+"
ELSEIF sym <= sz2 THEN
  sig$ = CHR$(sym + 48)
ELSE
  STOP
END IF

symsig$ = sig$

END FUNCTION

SUB testoption2 (test, p1, p2)

'fills p1 and p2 with open options in test
 
IF testoptions(test) <> 2 THEN STOP

p1 = 0
p2 = 0
posnr = 0
countblocked = 0
'check test
FOR i = 1 TO sz2
  p = testtoplace(test, i)
  ref = placeref(p)
  IF ref = implies THEN STOP

  IF ref = blocked THEN
    countblocked = countblocked + 1
  ELSE
    posnr = posnr + 1
   IF posnr > 2 THEN
     'problem
     STOP
   END IF
   p2 = p1
   p1 = p
  END IF
NEXT
 
IF posnr <> 2 THEN STOP
IF posnr + countblocked <> sz2 THEN STOP
IF p1 = 0 THEN STOP
IF p2 = 0 THEN STOP
IF p1 = p2 THEN STOP

END SUB

FUNCTION testsig$ (test)

'signature for test


gr = INT((test - 1) / sz4) + 1

t = test + sz4 - gr * sz4
IF t < 1 OR t > sz4 THEN STOP

t1 = INT((t - 1) / sz2) + 1
IF t1 < 1 OR t1 > sz2 THEN STOP

t2 = t + sz2 - t1 * sz2
IF t2 < 1 OR t2 > sz2 THEN STOP

t1$ = CHR$(t1 + 48)
t2$ = CHR$(t2 + 48)

SELECT CASE gr
  CASE 0
    'test=0
    sig$ = "????"
    message "testsigerror"
    keyboard
    STOP
  CASE 1
    'cel test
    sig$ = "R" + t1$ + "C" + t2$
  CASE 2
    'row sym test
    sig$ = "R" + t1$ + "=" + t2$
  CASE 3
    'col sym test
    sig$ = "C" + t1$ + "=" + t2$
  CASE 4
    'box sym test
    sig$ = "B" + t1$ + "=" + t2$
  CASE ELSE
    STOP
END SELECT



testsig$ = sig$

END FUNCTION

SUB testsolution (a$)

'test if solution is correct

DIM symlist(sz2)

IF LEN(a$) > sz4 THEN STOP

FOR c = 1 TO LEN(a$)
  b$ = MID$(a$, c, 1)
  b = ASC(b$)
  IF b > 48 AND b < 59 THEN
    sym = b - 48
    IF sym > sz2 THEN STOP
    IF sym < 1 THEN STOP
    place = celsymtoplace(c, sym)

    IF solution(c) <> place THEN STOP
  END IF
NEXT

FOR test = 1 TO sz44
  cnt = 0
  FOR i = 1 TO sz2
    p = testtoplace(test, i)
    c = placetocel(p)
    IF solution(c) = p THEN
      cnt = cnt + 1
    END IF
  NEXT
  IF cnt <> 1 THEN STOP
NEXT




END SUB

SUB testtest

'test for inconsistensies in test


FOR t = 1 TO sz44
  posnr = 0
  FOR i = 1 TO sz2
    p = testtoplace(t, i)
    ref = placeref(p)
    IF ref <> blocked THEN
      posnr = 1
      EXIT FOR
    END IF
  NEXT
  IF posnr = 0 THEN
    'no solution
    t$ = testsig(t)
    STOP
    EXIT SUB
  END IF
NEXT

END SUB


[/code]
Back to top
View user's profile Send private message
PIsaacson

Joined: 17 Jan 2006
Posts: 47
:
Location: Campbell, CA

Items
PostPosted: Mon Jul 13, 2009 12:22 pm    Post subject: Reply with quote

Suduko,

I compiled your code using qb64, but it required changing all the STOP statements to END and commenting out the FRE memory usage displays. Apparently, qb64 is "work in progress", but it translates the QBasic code to C++ which it then compiles using g++, so it requires cygwin or Mingw.

So, my problem is that a blind port probably isn't the best way to discover what's going on, but after compiling and attempting to execute, I keep getting an error in line 383 in the subroutine addtosolutiondry on the line:
Code:
solution(cel) = place

cel isn't passed as a parameter, so either it's a shared variable set elsewhere or I'm missing something line "cel = placetocel (place)".

The other possibility is that qb64 is missing something, so I thought I should ask the author directly.

Also, if I change the path for the top50000 and change loadstart = 0, it looks like it should attempt to solve whatever collection I point to?

Cheers,
Paul
Back to top
View user's profile Send private message
soduko

Joined: 10 Oct 2005
Posts: 50
:

Items
PostPosted: Wed Jul 15, 2009 4:57 pm    Post subject: Reply with quote

the first problem

yes a line cel= placetocel(place) is missing.

at the moment i am on holyday so cannot check my program.


(it should give an error and it did not )

funny that the program still worked. (there is a lot of double work in the program, one of the reasons it is that slow)

the routine for doing the top 50000 is in the main routine.

( just look at it and remove all that is unnessesary.)

the program is very slow at the moment, next version will be much quicker.

but realy quick will take longer.

how did you guess the missing line?
Back to top
View user's profile Send private message
PIsaacson

Joined: 17 Jan 2006
Posts: 47
:
Location: Campbell, CA

Items
PostPosted: Thu Jul 16, 2009 5:28 pm    Post subject: Reply with quote

soduko wrote:
how did you guess the missing line?

Decades of using Xemacs as my editor of choice helped. I examined all the lines containing the words 'cel' and 'place', and the placetocel subroutine looked promising.

Cheers,
Paul
Back to top
View user's profile Send private message
energztm

Joined: 21 Jul 2009
Posts: 6
:

Items
PostPosted: Tue Jul 21, 2009 2:55 pm    Post subject: Reply with quote

I think posting it here is a great idea.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Sudoku Programmers Forum Index -> Programming sudoku All times are GMT
Goto page Previous  1, 2
Page 2 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
Sudoku Programmers topic RSS feed 


Powered by phpBB © 2001, 2005 phpBB Group

Igloo Theme Version 1.0 :: Created By: Andrew Charron