Strange, as far as I can see the zip is correct. Here's the code (rather big, you'll have to scroll a lot):
Code:
#pragma mode( separator(.,;) integer(h32) )
// Sudoku editor/solver by Lennart Börjeson 2015-01-31
//
// The solution strategies are my own and can surely be improved.
//
// The basic idea is to represent a sudoku grid by a NxN matrix, where
// a positive number is a known cell, and a negative number a bitmask
// of possible digits.
//
// E.g. a 9x9 grid is initialised with all cells set to -1022, since
// 1022 == #1111111110b, i.e. bits 1-9 set.
//
// Strategy 1, "straight elimination":
// As a cell is set to a known digit, the corresponding bit is eliminated from
// all other cells in the same row, column, and surrounding 3x3 block.
//
// When all known digits have been eliminated from their neigbouring cells,
// hopefully some cells have only one bit left, which can then be converted to
// a "known" digit, generating yet more eliminations.
//
// In this ways some trivial sudokus can be be completely solved.
//
// Strategy 2, "find singletons":
// This strategy counts the number of occurrences of each possible number
// in a row, column, or block, and look for numbers only possible in a
// single cell. E.g. if, after elimination, three cells in some
// row are left open with the possibilities [2,3], [2,3], and [3,8], then 8
// must be in the thrid cell. I call such numbers "singletons".
//
// The code iteratively searches for singletons and performs elimination until
// no more digits can be found.
//
// Strategy 3: recursive trial-and-error:
// In the finaly strategy, the code recursively selects the cell with the least
// number of possibilities and tries to set the cell to each possible digit.
// As each digit is tried, the strategy recursively calls the solver, which
// invokes elimination, finds singletons and proceeds to the next "open" cell,
// until either a conflict is found or the problem solved.
// Backtracking is done by simply returning from a recursive call, which
// throws away the local solution candidate and lets the level above proceed
// to the next possibility. Exhausting the possibilities also causes
// backtracking.
//
//
// Sudoku size. 4, 9 and 16 are possible, selected by ChooseSize below.
LOCAL siz=9;
// Forward declaration of the getUnknownsValue method, which
// returns the negative number representing a fully unknown cell.
getUnknownsValue();
// The sudoku grid.
LOCAL displayGrid=MAKEMAT(getUnknownsValue(),siz,siz);
// The undo list
LOCAL undoList = {};
// The row and column of the highlighted cell in the editor, if any. 0 == none.
LOCAL highlightR=0,highlightC=0;
// Forward declarations of solver subroutines.
Solve();
EliminateAll();
recursiveSolve();
getGroups();
getNeighbours();
groupsList();
checkAndEliminate();
// Forward declaration of display subroutines
DisplayCell();
DisplayGrid();
DisplayTime();
// Forward declaration of editor subroutines
ChooseSize();
DoClear();
DoSolve();
DoDraw();
DoHelp();
ChooseDemo();
HighlightOn();
HighlightOff();
HighlightMove();
resetFreeCells();
pushGrid();
popGrid();
DoUndo();
ShowHint();
// Utility routines
BitS();
BitCount();
Union();
// Sudoku editor/solver main entry. Only exported routine.
// Clears the screen, display the menu, then loops waiting for key or mouse
// input.
// Mouse: If in the menu, act on menu items.
// If in the sudoku, select and highlight a cell
// Keypad: If highlight is on, move the highlight.
// Key: ESC: Exit.
// digit (0-9, A-F): If digit valid for selected suduko size and highlight
// is on: Set highlighted cell to digit.
EXPORT Sudoku()
BEGIN
LOCAL digitKeys={47,42,43,44,37,38,39,32,33,34,14,15,16,17,18};
LOCAL joystick={7,8,2,12};
siz:=9;
displayGrid:=MAKEMAT(getUnknownsValue(),siz,siz);
undoList:={};
highlightR:=0;
highlightC:=0;
DoClear();
DoDraw();
WHILE 1 DO
LOCAL w=WAIT(−1),p=−1;
CASE
IF TYPE(w)≤1 THEN // Key
CASE
IF w==4 THEN // Esc
BREAK;
END;
IF w==3 THEN // Help
ShowHint();
END;
IF w==19 THEN // Del
IF highlightR AND highlightC THEN
pushGrid();
displayGrid(highlightR,highlightC):=getUnknownsValue();
displayGrid:=resetFreeCells(displayGrid);
DoDraw();
HighlightOn(highlightR,highlightC);
END;
END;
IF p:=POS(digitKeys,w) THEN // 0-9,A-F
// PRINT("Digit="+(p-1));
LOCAL digit=p-1; // 0-15
CASE
IF siz==4 THEN // Accept 1-4
IF digit<1 OR digit>siz THEN
CONTINUE;
END;
END;
IF siz==9 THEN // Accept 1-9
IF digit<1 OR digit>siz THEN
CONTINUE;
END;
END;
DEFAULT // Accept 0-15
IF digit<0 OR digit≥siz THEN
CONTINUE;
END;
END;
IF highlightR AND highlightC THEN
pushGrid();
IFERR
displayGrid:=checkAndEliminate(displayGrid,highlightR,highlightC,digit,0);
THEN
MSGBOX("Not possible!");
DoUndo();
END;
END;
END;
IF p:=POS(joystick,w) THEN
CASE
IF p==1 THEN HighlightMove(0,−1); END;
IF p==2 THEN HighlightMove(0,1); END;
IF p==3 THEN HighlightMove(−1,0); END;
IF p==4 THEN HighlightMove(1,0); END;
DEFAULT
END;
END;
DEFAULT
// Ignore other keys
END;
END;
IF TYPE(w)==6 THEN // Mouse
LOCAL ev=w(1);
IF ev==3 THEN // click
LOCAL x=B→R(w(2)),y=B→R(w(3));
//PRINT("(x,y)="+x+","+y);
IF y≥220 THEN // in menu
LOCAL m=IP(x/54);
CASE
IF m==0 THEN ChooseSize(); END;
IF m==1 THEN DoClear(); END;
IF m==2 THEN DoHelp(); END;
IF m==3 THEN
HighlightOff();
LOCAL d=ChooseDemo();
siz:=colDim(d);
displayGrid:=resetFreeCells(d);
DoDraw();
END;
IF m==4 THEN
DoUndo();
END;
IF m==5 THEN
pushGrid();
DoSolve();
END;
DEFAULT
// Ignore
END;
ELSE
// mouse, not in menu
LOCAL r=IP(y/12),c=IP(x/12);
IF 1≤r≤siz AND 1≤c≤siz THEN
// within displayGrid
HighlightOn(r,c);
ELSE
// outside displayGrid
HighlightOff();
END;
END;
END;
END;
DEFAULT
// Unknown WAIT return type
//PRINT(w);
END;
END;
END;
ShowHint()
BEGIN
IF highlightR AND highlightC THEN
MSGBOX("Possible digits are: "+STRING(BitS(displayGrid(highlightR,highlightC))));
DoDraw();
HighlightOn(highlightR,highlightC);
END;
END;
// Display help text
DoHelp()
BEGIN
// PRINT(displayGrid);
LOCAL txt={
"Size: Select grid size.",
"Clear: Clear the grid and the undo list.",
"Help: This help.",
"Demo: Select a demo problem.",
"Undo: Undo latest operation.",
"Solve: Solve the problem.",
"",
"Click in the grid to highlight a cell,",
"then enter a digit or use the pad to",
"move the highlight. Del clears a cell.",
"",
"ESC exits the program, HELP shows a hint."};
RECT();
LOCAL r=0;
FOR r FROM 1 TO SIZE(txt) DO
TEXTOUT_P(txt(r),0,r*14,2);
END;
WAIT(−1);
DoDraw();
END;
// Solve!
DoSolve()
BEGIN
HighlightOff();
displayGrid:=Solve(resetFreeCells(displayGrid));
END;
// Draw the grid and display the sudoku
DoDraw()
BEGIN
RECT();
DRAWMENU("Size","Clear","Help","Demo","Undo","Solve");
LOCAL r,c,blockSize=√siz;
LOCAL x0=9,x1=siz*12+9+blockSize+1;
LOCAL y0=x0,y1=x1;
LOCAL dy=0;
FOR r FROM 0 TO siz DO
LINE_P(x0,y0+dy,x1,y0+dy);
IF NOT (r MOD blockSize) THEN
LINE_P(x0,y0+dy+1,x1,y0+dy+1);
dy+1▶dy;
END;
dy+12▶dy;
END;
LOCAL dx=0;
FOR c FROM 0 TO siz DO
LINE_P(x0+dx,y0,x0+dx,y1);
IF NOT (c MOD blockSize) THEN
LINE_P(x0+dx+1,y0,x0+dx+1,y1);
dx+1▶dx;
END;
dx+12▶dx;
END;
DisplayGrid(displayGrid);
END;
// Turn on the highlight
HighlightOn(r,c)
BEGIN
IF highlightR AND highlightC THEN
HighlightOff();
END;
IF 1≤r≤siz AND 1≤c≤siz THEN
highlightR:=r;
highlightC:=c;
LOCAL x0=12+(highlightC-1)*12+IP((highlightC-1)/√siz)-2;
LOCAL y0=12+(highlightR-1)*12+IP((highlightR-1)/√siz)-2;
LOCAL x1=x0+12,y1=y0+12;
LINE_P(x0,y0,x1,y0,#FF0000h);
LINE_P(x1,y0,x1,y1,#FF0000h);
LINE_P(x0,y0,x0,y1,#FF0000h);
LINE_P(x0,y1,x1,y1,#FF0000h);
END;
END;
// Turn off the highlight
HighlightOff()
BEGIN
LOCAL r,c;
IF highlightR AND highlightC THEN
LOCAL x0=12+(highlightC-1)*12+IP((highlightC-1)/√siz)-2;
LOCAL y0=12+(highlightR-1)*12+IP((highlightR-1)/√siz)-2;
LOCAL x1=x0+12,y1=y0+12;
LINE_P(x0,y0,x1,y0);
LINE_P(x1,y0,x1,y1);
LINE_P(x0,y0,x0,y1);
LINE_P(x0,y1,x1,y1);
END;
highlightR:=0;
highlightC:=0;
END;
// Move the highlight
HighlightMove(dr,dc)
BEGIN
IF highlightR AND highlightC THEN
LOCAL hr=highlightR,hc=highlightC;
HighlightOn(MAX(1,MIN(hr+dr,siz)),MAX(1,MIN(hc+dc,siz)));
END;
END;
// Clear the sudoku
DoClear()
BEGIN
displayGrid:=MAKEMAT(getUnknownsValue(),siz,siz);
undoList:={};
HighlightOff();
DoDraw();
END;
// Undo latest operation
DoUndo()
BEGIN
IF popGrid() THEN
LOCAL g=displayGrid;
siz:=colDim(g);
DoDraw();
END;
END;
numOpen(g)
BEGIN
RETURN ΣLIST(EXECON("IFTE(&1<0,1,0)",g));
END;
// Let the user choose sudoku size
ChooseSize()
BEGIN
LOCAL m=0,e=0;
IF CHOOSE(m,"Choose Sudoku size:","Childuko (4×4)","Sudoku (9×9)","Hexadoku (16×16)") THEN
CASE
IF m==1 THEN e:=4; END;
IF m==2 THEN e:=9; END;
IF m==3 THEN e:=16; END;
DEFAULT
END;
END;
IF e THEN
siz:=e;
DoClear();
END;
END;
// push the display grid to the undo list
pushGrid()
BEGIN
undoList:=CONCAT(displayGrid,undoList);
END;
// pop the undo list to the display grid
// Returns: true if there was anything on the undoList
popGrid()
BEGIN
IF SIZE(undoList) THEN
LOCAL u=undoList;
LOCAL g=head(u);
displayGrid:=g;
LOCAL tl=tail(u);
undoList:=tl;
RETURN 1;
ELSE
RETURN 0;
END;
END;
// Returns the "unknowns value", i.e. the negative bitmask representing
// all possible digits.
// Note: 4x4 -> 1..4 -> -30, 9x9 -> 1..9 -> -1022, 16x16 -> -65535
getUnknownsValue()
BEGIN
LOCAL a=2^siz-1;
IF siz<16 THEN
a:=2*a;
END;
RETURN -a;
END;
// Reset unset values to correct possibilities. Needed after clearing of a know value.
resetFreeCells(grid)
BEGIN
LOCAL r,c,u=getUnknownsValue();
FOR r FROM 1 TO siz DO
FOR c FROM 1 TO siz DO
IF grid(r,c)<0 THEN
grid(r,c):=u;
END;
END;
END;
RETURN grid;
//RETURN EliminateAll(grid,0,0,0,0);
END;
// Solve the sudoku and display the total running time
Solve(grid)
BEGIN
LOCAL start=Time;
DisplayGrid(grid);
grid:=EliminateAll(grid,0,0,0,1);
grid:=recursiveSolve(grid);
DisplayGrid(grid);
LOCAL stop=Time;
LOCAL elap=stop-start;
DisplayTime(elap);
RETURN grid;
END;
// Display the entire sudoku (numbers only, grid is drawn by DoDraw()).
DisplayGrid(grid)
BEGIN
LOCAL r,c;
FOR r FROM 1 TO siz DO
FOR c FROM 1 TO siz DO
DisplayCell(r,c,grid(r,c));
END;
END;
END;
// Displays a single cell
DisplayCell(r,c,d)
BEGIN
LOCAL e=d,s;
LOCAL x=12+(c-1)*12+IP((c-1)/√siz)+1;
LOCAL y=12+(r-1)*12+IP((r-1)/√siz);
IF d<0 THEN
s:=" ";
RECT_P(x-2,y-1,x+7,y+8,#FFFFFFh,#FFFFFFh);
ELSE
IF e≤9 THEN
s:=CHAR(48+e);
ELSE
s:=CHAR(65+e-10);
END;
TEXTOUT_P(s,x,y,1,0,9,#FFFFFFh);
END;
END;
// Displays a string to the right of the sudoku
DisplayTime(t)
BEGIN
TEXTOUT_P(STRING(t),siz*12+√siz+12+2,8);
END;
// Returns a list of all set/known cells in the grid, i.e. all cells
// with positive numbers.
// Returns: {{r1,c1},{r2,c2},...}
allSet(grid)
BEGIN
LOCAL r=0,c=0,elm={};
FOR r FROM 1 TO siz DO
FOR c FROM 1 TO siz DO
IF grid(r,c)≥0 THEN
elm:=CONCAT(elm,{{r,c}});
END;
END;
END;
RETURN elm;
END;
// Set, if possible, the cell at grid(r,c) to d, and eliminates from that cell.
// Throws an error if not possible.
// If indirect is true then proceeds to indirect eliminations.
// Returns new grid
checkAndEliminate(grid,r,c,d,indirect)
BEGIN
IF grid(r,c)==d THEN
RETURN grid;
END;
IF grid(r,c)>0 THEN
1/0;
END;
IF BITAND(R→B(-grid(r,c)),BitSL(#1,d)) THEN
DisplayCell(r,c,d);
RETURN EliminateAll(grid,r,c,d,indirect);
ELSE
1/0;
END;
END;
// Returns a list of all "groups" in the grid, i.e. all rows, columns, and
// blocks, as lists of coordinates.
// Returns: {group1, group2,...}
// where a group is: {{r1,c1},{r2,c2},...}
// Note: This is constant for a sudoku of given size, and is cached.
LOCAL aSiz=0,aG={};
allGroups()
BEGIN
IF aSiz==siz AND SIZE(aG) THEN
RETURN aG;
END;
aSiz:=siz;
LOCAL lst={};
LOCAL row,col,g;
FOR row FROM 1 TO siz DO
g:={};
FOR col FROM 1 TO siz DO
g:=CONCAT(g,{{row,col}})
END;
lst:=CONCAT(lst,{g})
END;
FOR col FROM 1 TO siz DO
g:={};
FOR row FROM 1 TO siz DO
g:=CONCAT(g,{{row,col}})
END;
lst:=CONCAT(lst,{g})
END;
LOCAL bRow,bCol,blockSize=√siz;
FOR bRow FROM 1 TO blockSize DO
FOR bCol FROM 1 TO blockSize DO
g:={};
LOCAL r0=(bRow-1)*blockSize+1;
LOCAL r1=r0+blockSize-1;
LOCAL c0=(bCol-1)*blockSize+1;
LOCAL c1=c0+blockSize-1;
FOR row FROM r0 TO r1 DO
FOR col FROM c0 TO c1 DO
g:=CONCAT(g,{{row,col}})
END;
END;
lst:=CONCAT(lst,{g})
END;
END;
aG:=lst;
RETURN lst;
END;
// Returns a list of all singletons in the grid.
// Returns: {{row1,col1,digit1},{row2,col2,digit2},...}
listSingletons(grid,groups)
BEGIN
LOCAL lst={};
WHILE SIZE(groups) DO
LOCAL g:=head(groups);
groups:=tail(groups);
LOCAL s=MAKELIST({},X,1,siz+1);
WHILE SIZE(g) DO
LOCAL p=head(g);
LOCAL r=p(1),c=p(2);
g:=tail(g);
IF grid(r,c)<0 THEN
LOCAL b=BitS(grid(r,c));
WHILE SIZE(b) DO
LOCAL d=head(b);
b:=tail(b);
s(d+1):=CONCAT(s(d+1),{p});
END;
END;//IF grid(p)<0
END;
LOCAL d;
FOR d FROM 0 TO siz DO
LOCAL pl=s(d+1);
IF SIZE(pl)==1 THEN
LOCAL p=head(pl);
lst:=CONCAT(lst,{CONCAT(p,d)})
END;
END;
END;
RETURN lst;
END;
// Finds and converts singletons, with elimination. Returns new grid.
// (Not used in this version. EliminateAll now scans for singletons
// created at each elimination.)
findSingletons(grid)
BEGIN
LOCAL ogrid;
REPEAT
ogrid:=grid;
LOCAL lst=listSingletons(grid,allGroups());
WHILE SIZE(lst) DO
LOCAL p=head(lst);
lst:=tail(lst);
//PRINT("Singleton ("+p(1)+","+p(2)+"):"+p(3));
grid:=checkAndEliminate(grid,p(1),p(2),p(3),1);
END;
UNTIL grid==ogrid;
RETURN grid;
END;
// Returns the open cell with the least number of possibilities.
// Returns: A list of the cell coordinates, e.g. {{r,c},...}.
// The first cell is the cell with least possibilities, the rest are
// unordered.
// (Was originally a complete list of all open positions, sorted by number
// of possibilities, but this was unnecessary and simplified to just a single
// cell.)
openPositions(grid)
BEGIN
LOCAL r=0,c=0,p={},m=4711;
FOR r FROM 1 TO siz DO
FOR c FROM 1 TO siz DO
IF grid(r,c)<0 THEN
LOCAL b=BitCount(grid(r,c));
IF b<m THEN
m:=b;
p:=CONCAT({{r,c}},p);
ELSE
p:=CONCAT(p,{{r,c}});
END;
END;
END;
END;
RETURN p;
END;
// Recursive solver.
recursiveSolve(grid)
BEGIN
// grid:=findSingletons(grid);
LOCAL opn=openPositions(grid);
IF SIZE(opn) THEN
LOCAL o=head(opn);
LOCAL r=o(1),c=o(2);
LOCAL cnds=BitS(grid(r,c));
WHILE SIZE(cnds) DO
//PRINT("Trying ("+r+","+c+")="+STRING(cnds));
LOCAL cnd=head(cnds);
cnds:=tail(cnds);
IFERR
//PRINT("Trying ("+r+","+c+")="+cnd+", was "+grid(r,c));
LOCAL g2=checkAndEliminate(grid,r,c,cnd,1);
grid:=recursiveSolve(g2);
THEN
// Just try next candidate
DisplayGrid(grid);
//PRINT("Backtrack!");
ELSE
RETURN grid;
END;
END;
// No solution
1/0;
ELSE
//PRINT("Solution!");
END;
RETURN grid;
END;
// Eliminates possibilities from neighbouring cells.
// If r or c ==0, then eliminate starting from all known cells.
// If r and c ≠0, then set grid(r,c) to d and eliminate from that cell only.
// If indirect is true, then proceeds to indirect eliminations.
// Returns new grid.
EliminateAll(grid,r,c,d,indirect)
BEGIN
LOCAL elm={},groups={};
IF r==0 OR c==0 THEN
elm:=allSet(grid);
ELSE
elm:={{r,c}};
grid(r,c):=d;
END;
WHILE SIZE(groups) OR SIZE(elm) DO
WHILE SIZE(elm) DO
LOCAL h=head(elm);
r:=h(1);
c:=h(2);
elm:=tail(elm);
d:=grid(r,c);
groups:=Union(groups,getGroups(r,c));
// PRINT("groups="+SIZE(groups));
LOCAL m=BitSL(1,d);
LOCAL n=BITNOT(m);
LOCAL lst=getNeighbours(grid,r,c);
WHILE SIZE(lst) DO
LOCAL e=head(lst);
lst:=tail(lst);
LOCAL x=e(1),y=e(2);
LOCAL p=grid(x,y);
IF p<0 AND BITAND(−p,m) THEN
LOCAL q=−BITAND(−p,n);
IF q≠0 THEN
IF indirect AND BitCount(q)==1 THEN
LOCAL fnd=BitS(q);
DisplayCell(x,y,fnd(1));
// PRINT("Found ("+x+","+y+"):"+STRING(fnd));
grid(x,y):=fnd(1);
elm:=Union(elm,{{x,y}});
ELSE
grid(x,y):=q;
groups:=Union(groups,getGroups(x,y));
END;
END;
ELSE // p≥0
IF p==d THEN
//PRINT("Can't take "+d+" from ("+x+","+y+")");
1/0;
END;
END;
END; // WHILE lst
END; // WHILE elm
IF SIZE(groups) THEN
LOCAL lst=listSingletons(grid,groupsList(groups));
WHILE SIZE(lst) DO
LOCAL p=head(lst);
lst:=tail(lst);
LOCAL r=p(1),c=p(2),d=p(3);
//PRINT("ESingleton ("+r+","+c+"):"+d);
grid(r,c):=d;
DisplayCell(r,c,d);
elm:=Union(elm,{{r,c}});
END;
groups:={};
END;
END; // WHILE groups OR elm
RETURN grid;
END;
// Returns a list of all cells "neighbouring" the given cell
// (i.e. in the same row, column, or block)
getNeighbours(grid,r,c)
BEGIN
LOCAL lst={};
LOCAL row,col;
FOR col FROM 1 TO siz DO
IF col≠c THEN
lst:=Union(lst,{{r,col}})
END;
END;
FOR row FROM 1 TO siz DO
IF row≠r THEN
lst:=Union(lst,{{row,c}});
END;
END;
LOCAL blockSize=√siz;
LOCAL r0=r-((r-1) MOD blockSize);
LOCAL r1=r0+blockSize-1;
LOCAL c0=c-((c-1) MOD blockSize);
LOCAL c1=c0+blockSize-1;
FOR row FROM r0 TO r1 DO
FOR col FROM c0 TO c1 DO
IF r≠row AND c≠col THEN
lst:=Union(lst,{{row,col}});
END;
END;
END;
RETURN lst;
END;
// Returns a list of all the groups a cell belongs to
// (i.e. the same row, column, and block)
// Returns: {group1, group2,...}
// where a group is represented by an index:
// Rows are numbered 0..siz-1 (i.e. row 2 has index 1),
// Cols are numbered siz..2*siz-1 (i.e. col 2 has index siz+1),
// and blocks are numbered 2*siz..3*siz-1.
// This format is used to simplify the collection of groups
// in a set.
getGroups(r,c)
BEGIN
LOCAL lst={};
lst(0):=r-1;
lst(0):=siz+c-1;
LOCAL blockSize=√siz;
LOCAL r0=(r-((r-1) MOD blockSize)-1)/blockSize;
LOCAL c0=(c-((c-1) MOD blockSize)-1)/blockSize;
lst(0):=siz+siz+r0*blockSize+c0;
// PRINT("getGroups("+r+","+c+")="+STRING(lst));
RETURN lst;
END;
// Converts a list of group indices to a list of "real" groups,
// in the same format use returned by allGroups() and expected
// by listSingletons().
groupsList(g)
BEGIN
LOCAL lst={};
WHILE SIZE(g) DO
LOCAL group={};
LOCAL h:=head(g);
g:=tail(g);
LOCAL row,col,blockSize=√siz;
CASE
IF h<siz THEN
LOCAL r=h+1;
FOR col FROM 1 TO siz DO
group:=CONCAT(group,{{r,col}});
END;
lst:=CONCAT(lst,{group});
END;
IF h<2*siz THEN
LOCAL c=h-siz+1;
FOR row FROM 1 TO siz DO
group:=CONCAT(group,{{row,c}});
END;
lst:=CONCAT(lst,{group});
END;
DEFAULT
LOCAL b=h-2*siz;
LOCAL bc=b MOD blockSize;
LOCAL br=(b-bc)/blockSize;
LOCAL r0=br*blockSize+1;
LOCAL r1=r0+blockSize-1;
LOCAL c0=bc*blockSize+1;
LOCAL c1=c0+blockSize-1;
FOR row FROM r0 TO r1 DO
FOR col FROM c0 TO c1 DO
group:=CONCAT(group,{{row,col}});
END;
END;
lst:=CONCAT(lst,{group});
END;
END;
// PRINT("groupList("+g+")="+STRING(lst));
RETURN lst;
END;
// A trivial sudoku, from https://projecteuler.net/problem=96
LOCAL easy=[
[-1022,-1022,3,-1022,2,-1022,6,-1022,-1022],
[9,-1022,-1022,3,-1022,5,-1022,-1022,1],
[-1022,-1022,1,8,-1022,6,4,-1022,-1022],
[-1022,-1022,8,1,-1022,2,9,-1022,-1022],
[7,-1022,-1022,-1022,-1022,-1022,-1022,-1022,8],
[-1022,-1022,6,7,-1022,8,2,-1022,-1022],
[-1022,-1022,2,6,-1022,9,5,-1022,-1022],
[8,-1022,-1022,2,-1022,3,-1022,-1022,9],
[-1022,-1022,5,-1022,1,-1022,3,-1022,-1022]];
// A moderately hard sudoku, from https://projecteuler.net/problem=96
// (Number 6 in the problem file)
LOCAL pe06=[
[1,-1022,-1022,9,2,-1022,-1022,-1022,-1022],
[5,2,4,-1022,1,-1022,-1022,-1022,-1022],
[-1022,-1022,-1022,-1022,-1022,-1022,-1022,7,-1022],
[-1022,5,-1022,-1022,-1022,8,1,-1022,2],
[-1022,-1022,-1022,-1022,-1022,-1022,-1022,-1022,-1022],
[4,-1022,2,7,-1022,-1022,-1022,9,-1022],
[-1022,6,-1022,-1022,-1022,-1022,-1022,-1022,-1022],
[-1022,-1022,-1022,-1022,3,-1022,9,4,5],
[-1022,-1022,-1022,-1022,7,1,-1022,-1022,6]];
// A "hard", sudoku, from http://www.telegraph.co.uk/science/science-news/9359579/Worlds-hardest-sudoku-can-you-crack-it.html
LOCAL hard=[
[8,-1022,-1022,-1022,-1022,-1022,-1022,-1022,-1022],
[-1022,-1022,3,6,-1022,-1022,-1022,-1022,-1022],
[-1022,7,-1022,-1022,9,-1022,2,-1022,-1022],
[-1022,5,-1022,-1022,-1022,7,-1022,-1022,-1022],
[-1022,-1022,-1022,-1022,4,5,7,-1022,-1022],
[-1022,-1022,-1022,1,-1022,-1022,-1022,3,-1022],
[-1022,-1022,1,-1022,-1022,-1022,-1022,6,8],
[-1022,-1022,8,5,-1022,-1022,-1022,1,-1022],
[-1022,9,-1022,-1022,-1022,-1022,4,-1022,-1022]];
// A 16x16 "hexadoku"
LOCAL hexa=[
[-65535,-65535,-65535, 6,-65535,11,-65535,-65535,-65535,-65535,-65535,10,-65535,15, 1,-65535],
[-65535, 3,-65535,-65535,-65535, 1,-65535, 9,12,-65535,-65535,11,-65535,-65535,-65535,-65535],
[-65535,-65535, 2, 5, 3, 7,-65535,-65535,15,-65535,-65535, 1, 9,11,-65535,-65535],
[-65535, 4,15,-65535,-65535,-65535,12,-65535,-65535,-65535, 0,-65535,-65535,-65535,-65535, 8],
[ 8, 2,-65535,-65535,-65535,-65535,10,-65535,-65535, 5, 4,-65535,-65535,-65535,-65535,-65535],
[10,-65535,-65535,-65535, 7,-65535, 4, 0, 9,-65535, 2,-65535,-65535,-65535,-65535,-65535],
[-65535,14,-65535,-65535,-65535, 8,-65535,-65535,-65535,-65535, 3,15, 4, 5,-65535,-65535],
[ 3, 5,-65535,-65535,-65535,-65535,-65535,13,-65535, 6,-65535,-65535,-65535, 8,15,-65535],
[ 1,-65535,-65535, 9,-65535, 6,-65535,-65535,13,-65535,-65535,-65535, 2,-65535,-65535,-65535],
[-65535, 6,13,-65535,-65535, 9, 3,12,-65535,10,-65535,-65535,-65535,-65535,-65535,-65535],
[15,-65535,-65535,-65535,-65535,-65535,-65535,-65535,11,-65535, 9,-65535,-65535,-65535,-65535, 7],
[-65535, 8,-65535,-65535,-65535,-65535,-65535, 5, 6,12,-65535,-65535,-65535, 0,13,-65535],
[13,-65535,-65535,-65535,-65535, 4, 7,-65535, 2,-65535,-65535, 6,-65535,-65535,-65535,-65535],
[14, 1,-65535,-65535,-65535,-65535, 5,-65535,-65535,-65535,-65535,-65535, 7,10, 0,-65535],
[-65535,-65535, 8,-65535,-65535,14,13,-65535, 1,15,-65535, 9,-65535, 2, 4,11],
[-65535,-65535, 0,12,15,-65535,-65535,-65535, 8,-65535,-65535,-65535,14,-65535,-65535,-65535]];
// A tiny "childoku"
LOCAL tiny=[
[1,2,-30,-30],
[3,4,-30,-30],
[-30,-30,-30,-30],
[-30,-30,-30,-30]];
// Display a menu of the predefined suduko tests above.
// Returns the choosen grid, or 0 if none.
ChooseDemo()
BEGIN
LOCAL m=0,e=0;
IF CHOOSE(m,"Choose Sudoku test:","tiny (4×4)","easy (9×9)","pe06 (9×9)","hard (9×9)","hexa (16×16)") THEN
CASE
IF m==1 THEN e:=tiny; END;
IF m==2 THEN e:=easy; END;
IF m==3 THEN e:=pe06; END;
IF m==4 THEN e:=hard; END;
IF m==5 THEN e:=hexa; END;
DEFAULT
END;
END;
//PRINT("m="+m);
//PRINT(e);
RETURN e;
END;
// Returns the bits set in the absolute value of a number, as a list.
// E.g. BitS(10) == {1,3}.
// Note: 10 == 2^1 + 2^3.
BitS(x)
BEGIN
IF TYPE(x)==0 THEN
x:=R→B(ABS(x));
END;
LOCAL bits={},y=0;
WHILE x ≠ #0 DO
IF BITAND(x,#1) THEN
bits:=CONCAT(bits,y);
END;
x:=BITSR(x);
y:=y+1;
END;
RETURN bits;
END;
// Returns the number of bits in the absolute value of number.
// Algorithm from http://stackoverflow.com/questions/109023/how-to-count-the-number-of-set-bits-in-a-32-bit-integer
BitCount(x)
BEGIN
IF TYPE(x)==0 THEN
x:=R→B(ABS(x));
END;
x:=x - BITAND(BITSR(x),#55555555h);
x:=BITAND(x,#33333333h) + BITAND(BITSR(x,2),#33333333h);
x:=BITSR(BITAND(x+BITSR(x,4),#0F0F0F0Fh)*#01010101h,24);
RETURN B→R(x);
END;
// Returns the union of two lists, i.e. concatenation without duplicates.
Union(a,b)
BEGIN
RETURN CONCAT(DIFFERENCE(a,b),INTERSECT(a,b));
END;
Search
Member List
Calendar
Help
