Sudoku editor/Solver - Printable Version

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;