Sudoku editor/Solver

[lenborje]

  Sudoku_V1.2b_HP_Prime.zip (Size: 29.77 KB / Downloads: 98)
   
   
This is a Sudoku editor/solver for the HP Prime. The GUI is a bit rough, but serviceable.

I submit the code in two file variants, UTF-8 text file and binary. Thanks Thomas for helping me with the binary file. (I have a Mac and can not run the Connectivity Kit directly.)

The GUI includes:

• Selecting grid size (4x4, 9x9 or 16x16)
• Clearing the grid
• Some demo problems
• Showing trivial hints
• Solving the problem
  

Have fun!

Edit: Updated the game.

I have corrected the bug Han found, improved the layout of the board (cf. pictures) and improved speed 10%-30%.

Have fun!

Edit: Second, minor, update. zip updated per:

(02-01-2015 01:48 PM)Thomas_Sch Wrote:  Hello Lennart,

Both of your files open fine in editors like notepad++, SciTe or jedit.
In standard notepad (included in windows) the line breaks are missing.

I'll add the text-File with the windows-line-endings for you (exported from program editor out of connectivity kit).

If I re-transfer the program from Prime via connectivity kit to a folder (drag-and-drop), I will get a file with the ending .hpprgm .
These are non-text files in windows.
For comparison i add also this .hpprgm-File. If you are opening this file in an editor, you will see the difference.

If I open the files from your zip, for example with notepad++, they open as native text files, therefore they should habe the file type .txt.

Thomas

[Mic]

I get an empty program when I open it... ?

[lenborje]

(12-03-2014 07:10 PM)Mic Wrote:  I get an empty program when I open it... ?

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;

[lenborje]

I've found an error in the program where it tried to call an external routine. This has been fixed. Both the attachment in the original post and and the code in my follow-up has has been corrected.

[Gerald H]

Downloaded 2014-12-08 - programme is extremely empty.

[Han]

Very cool!

Some minor bugs and suggestions:

[Bug] Press solve. After solving, press the Help menu option, and then press a button or tap the screen for invalid input error.

[Suggestion] Perhaps the pre-filled values should be in bold. And bold the lines that separate the "blocks" of numbers to make it easier to read a block within the puzzle. Lastly (though it may slow down the solver), having the solver use a different color as it tries out various guesses would help. Even printing its intermediate guesses would help in cases where the puzzle is large. Otherwise, the user may think the program has "hung".

[lenborje]

(12-09-2014 12:55 AM)Han Wrote:  [Bug] Press solve. After solving, press the Help menu option, and then press a button or tap the screen for invalid input error.

Thank you; I'll look into that.

(12-09-2014 12:55 AM)Han Wrote:  [Suggestion] Perhaps the pre-filled values should be in bold. And bold the lines that separate the "blocks" of numbers to make it easier to read a block within the puzzle. Lastly (though it may slow down the solver), having the solver use a different color as it tries out various guesses would help. Even printing its intermediate guesses would help in cases where the puzzle is large. Otherwise, the user may think the program has "hung".

I'll see what I can do about the colours. I did think about it, but right now the algorithm makes no difference between intermediate and original values.

Regarding printing intermediate values: The program already does. Did you run the program in the emulator? I've noticed that when running the Sudoku program the emulator does not update the screen unless you constantly move the (PC) mouse over the screen.

[lenborje]

(12-08-2014 03:14 PM)Gerald H Wrote:  Downloaded 2014-12-08 - programme is extremely empty.

As far as I can determine, the zip is OK. Here's the output of unzip -l on a freshly downloaded copy:

Code:

$ unzip -l Sudoku_V1.1_HP_Prime.zip 
Archive:  Sudoku_V1.1_HP_Prime.zip
  Length      Date    Time    Name
---------  ---------- -----   ----
    44480  12-04-2014 14:12   Sudoku.hpprgm
    22314  12-04-2014 14:12   Sudoku.hpprgm_utf8
---------                     -------
    66794                     2 files

The file "Sudoku.hpprgm" is encoded in 16-bit Unicode, "Sudoku.hpprgm_utf8" in UTF-8.

If you can't use the zip, you could perhaps cut-and-paste from my recent post in this thread where I quoted the entire code?

[Han]

(12-09-2014 07:51 AM)lenborje Wrote:  I'll see what I can do about the colours. I did think about it, but right now the algorithm makes no difference between intermediate and original values.

Regarding printing intermediate values: The program already does. Did you run the program in the emulator? I've noticed that when running the Sudoku program the emulator does not update the screen unless you constantly move the (PC) mouse over the screen.

I did indeed run it on the emulator (running inside Wine, in too). I'll try again with the actual calculator.

[lenborje]

(12-09-2014 12:55 AM)Han Wrote:  [Bug] Press solve. After solving, press the Help menu option, and then press a button or tap the screen for invalid input error.

[Suggestion] Perhaps the pre-filled values should be in bold. And bold the lines that separate the "blocks" of numbers to make it easier to read a block within the puzzle. Lastly (though it may slow down the solver), having the solver use a different color as it tries out various guesses would help. Even printing its intermediate guesses would help in cases where the puzzle is large. Otherwise, the user may think the program has "hung".

I have solved the bug, and improved the layout of the board (bold lines between blocks). I've also improved speed quite significantly.

Colouring intermediate values is still not solved.

I've updated my original post on this thread with new attachments.

[Thomas_Sch]

(01-31-2015 02:26 PM)lenborje Wrote:  ...
I have solved the bug, and improved the layout of the board (bold lines between blocks). I've also improved speed quite significantly.
Colouring intermediate values is still not solved.
I've updated my original post on this thread with new attachments.

Hello lenborje,
many thanks for your program! Now i mastered to get it running on the prime.

I have two suggestions:
1. because your files are more or less pure text (and not .hprpgm), you should
name it *.txt. I've tried to send the .hpprgm via connectivity kit to the prime,
this did not work. Opening your files with notepad++, converting line endings
to windows type, and copying the code to the connectivity kit helped.
2. In line 241 there is a call to subroutine BIT(), this led to an syntax error.

Code:

    MSGBOX("Possible digits are: "+STRING(BITS(displayGrid(highlightR,highlightC))));

I changed this call to BitS(), then the syntax error is away.

Thomas

[lenborje]

(01-31-2015 04:14 PM)Thomas_Sch Wrote:  Hello lenborje,
many thanks for your program! Now i mastered to get it running on the prime.

I have two suggestions:
1. because your files are more or less pure text (and not .hprpgm), you should
name it *.txt. I've tried to send the .hpprgm via connectivity kit to the prime,
this did not work. Opening your files with notepad++, converting line endings
to windows type, and copying the code to the connectivity kit helped.

Well, I guess guess I need some help here...

I don't have windows so I can't use the connectivity kit. I have Mac and use libhpcalcs, a command-line utility. When I transfer the Sudoku program from my Prime to my Mac I get a file called "Sudoku.hpprgm", encoded in 16-bit unicode, which I believe should be native to Windows. But I should perhaps also convert it to DOS line endings?

To be able to edit the file on my Mac I first convert it to UTF-8 encoding. This file is called "Sudoku.utf8.hpprgm". I don't know if this file can be used on Windows.

Which file did you use on Windows?

(01-31-2015 04:14 PM)Thomas_Sch Wrote:  2. In line 241 there is a call to subroutine BIT(), this led to an syntax error.

Code:

    MSGBOX("Possible digits are: "+STRING(BITS(displayGrid(highlightR,highlightC))));

I changed this call to BitS(), then the syntax error is away.

Thank you for finding this bug. (I have another program on my Prime which exports a "BITS" function, essentially the same as "BitS" in the Sudoku program.)

I you could tell which of my files you used on Windows I shall update my post with correct line encoding for Windows.

[Thomas_Sch]

(02-01-2015 01:26 PM)lenborje Wrote:  

(01-31-2015 04:14 PM)Thomas_Sch Wrote:  Hello lenborje,
many thanks for your program! Now i mastered to get it running on the prime.

I have two suggestions:
1. because your files are more or less pure text (and not .hprpgm), you should
name it *.txt. I've tried to send the .hpprgm via connectivity kit to the prime,
this did not work. Opening your files with notepad++, converting line endings
to windows type, and copying the code to the connectivity kit helped.

Well, I guess guess I need some help here...

I don't have windows so I can't use the connectivity kit. I have Mac and use libhpcalcs, a command-line utility. When I transfer the Sudoku program from my Prime to my Mac I get a file called "Sudoku.hpprgm", encoded in 16-bit unicode, which I believe should be native to Windows. But I should perhaps also convert it to DOS line endings?

To be able to edit the file on my Mac I first convert it to UTF-8 encoding. This file is called "Sudoku.utf8.hpprgm". I don't know if this file can be used on Windows.

Which file did you use on Windows?

(01-31-2015 04:14 PM)Thomas_Sch Wrote:  2. In line 241 there is a call to subroutine BIT(), this led to an syntax error.

Code:

    MSGBOX("Possible digits are: "+STRING(BITS(displayGrid(highlightR,highlightC))));

I changed this call to BitS(), then the syntax error is away.

Thank you for finding this bug. (I have another program on my Prime which exports a "BITS" function, essentially the same as "BitS" in the Sudoku program.)
I you could tell which of my files you used on Windows I shall update my post with correct line encoding for Windows.

Hello Lennart,

Both of your files open fine in editors like notepad++, SciTe or jedit.
In standard notepad (included in windows) the line breaks are missing.

I'll add the text-File with the windows-line-endings for you (exported from program editor out of connectivity kit).

If I re-transfer the program from Prime via connectivity kit to a folder (drag-and-drop), I will get a file with the ending .hpprgm .
These are non-text files in windows.
For comparison i add also this .hpprgm-File. If you are opening this file in an editor, you will see the difference.

If I open the files from your zip, for example with notepad++, they open as native text files, therefore they should habe the file type .txt.

Thomas

[lenborje]

(02-01-2015 01:48 PM)Thomas_Sch Wrote:  I'll add the text-File with the windows-line-endings for you (exported from program editor out of connectivity kit).

If I re-transfer the program from Prime via connectivity kit to a folder (drag-and-drop), I will get a file with the ending .hpprgm .
These are non-text files in windows.
For comparison i add also this .hpprgm-File. If you are opening this file in an editor, you will see the difference.
Thomas

Thank you, that was really helpful. I've been completely fooled by the libhpcalcs utility also giving the plain text-files the suffix ".hpprgm".

I've now updated the attachments in the first post of this thread.

[Thomas_Sch]

Many thanks for your great program!

Besides solving sudoku it will solve also many questions about programming the prime with PPL.

Thomas

[debrouxl]

There are two kinds of .hpprgm files: those with binary header before the UTF-16LE text, and those without

[Guenter Schink]

Hi Lennart

thanks for the nice app. I recently stumbled across this app, as I needed a Sudoku solver.

However this program errors out with the current firmware (10637) because UNION and DoSolve are now built in functions. UNION does what your sub-routine does, but DoSolve now is related to the Triangle Solver App.

Solution: delete the declarations for Union or comment them out, Rename DoSolve to i.e DoSolveS.

I could have posted the changed source myself, but I think it's better to leave it in your hands.

Günter

[lenborje]

Thank you for the heads-up. Unfortunately, I've been unable to upgrade my Prime since I moved to Mac on my desktop...

I'll see if I can borrow some time on a PC and upgrade, and then I'll update the Sudoku solver.

[Guenter Schink]

(12-20-2016 03:40 PM)lenborje Wrote:  Thank you for the heads-up. Unfortunately, I've been unable to upgrade my Prime since I moved to Mac on my desktop...

I'll see if I can borrow some time on a PC and upgrade, and then I'll update the Sudoku solver.

I see. The Sudoku_temp.txt is a version that has the proposed changes. I'll delete the file once you were able to do the corrections yourself. Not necessary to have various versions floating around.

Originally I got your program from hpcalc.org which is an older version. Did you commit your latest version already to Eric?

Regards, Günter

Edit Replaced .txt by .zip

[debrouxl]

Quote:I've been unable to upgrade my Prime since I moved to Mac on my desktop

Wouldn't the brand-new CK for MacOS X (current version: http://www.hpmuseum.org/forum/thread-7420.html ) be an option for you ?