The New Sudoku Players' Forum

[StrmCkr]

at the end of the day you should be able to find more advanced stuff like this

Code: Select all

+----------------+-------------+----------------+
| .    -1    .   | .   -1   .  | .    -1    .   |
| .    (1)   .   | .   (1)  .  | .    .     .   |
| .    -1    .   | .   -1   .  | .    -1    .   |
+----------------+-------------+----------------+
| .    -1    .   | .   -1   .  | .    -1    .   |
| .    .     .   | .   (1)  .  | .    (1)   .   |
| .    -1    .   | .   -1   .  | .    -1    .   |
+----------------+-------------+----------------+
| .    (1)   .   | .   -1   .  | .    (1)   .   |
| (1)  (-1)  (1) | -1  -1   -1 | (1)  (-1)  (1) |
| .    (1)   .   | .   -1   .  | .    (1)   .   |
+----------------+-------------+----------------+

example codes from my solver on how i accomplish this:
{note i just wrote this code today and am still testing it out so far so good not bad for <2 hours writing. mind you 8 years of failed very slow attempts lol }

first i studied the list of strong links
then i figured out the best way for me to build a table of those type of classed links { data storage code below very well tested}

originally i had a 2ndary table of weak-links which i realized is wasted space
since a weak link only occurs on a shared sector that sees all the digits my strong link setup already included that information!

all you have to do is reference the start and end cells of the inital link
saved sectors all those cells are found in for start/end
then run your program to line up the end cells sector to the next starting sector and off to the races we go.

my solver is in free pascal using setwise mathematical functions.

data type: Show

Code: Select all

{link type data base}
Linkset : stronglk; // array [ 0..9][0..5][0..9] of numberset[0..80]//setwise
{digit selected[1..9]}
{0: bivavel,
1:  2 cells in a sector
2: cell in sector , grouped link to another = all digits in that sector
3: cells in sector, as a grouped link to a single cell = all digits in that sector
4: cells in sector, as a grouped link to a grouped node = all digits in that sector
5: ERI}
{ internal data as:
 0 starting digit,
 1 active cell,
 2  linked cells,
 3 next link digit,
 4  sector its in,
 5 peers sector the link cells are is in.
 6  previous - digit swap is applicable 0 = off
 7 digit swap is applicable 0 = off
 8 potential elimination cells for basic ...end cell
 9 potential elimination for ring codes  ...start cell
 }

strong link builder: Show

Code: Select all

Procedure links;{rebuild}
var
N,xn,q,j,a,b,c,d,e,m,n2:integer;
 output: text;
 used:numberset;
begin
setlength(Linkset,10,6,0);

for n:= 1 to 9 do
begin
q:=-1;
A:=-1;
b:=-1;
c:=-1;
D:=-1;
e:=-1;
used:=[];
 for xn:= 0 to 26 do
   begin

    {bivavle cell}
    if DigitRCB[xn,n] <> []
     then
      begin
             for J in (DigitRCB[xn,n]-used) do
        if nm[j] = 2
          then
              begin
              include(used,j);
           inc(q);         
           setlength(linkset[n][0],q+1);
         
           include(linkset[n][0][q,0],n);
           include(linkset[n][0][q,1],j);

              linkset[n][0][q,2]:=[j];
             
           for m in (pm[j]-[n]) do
            begin
              include(linkset[n][0][q,3],m);          
            linkset[n][0][q,9]:= peer[j] * digitcell[m];
            end;             

              linkset[n][0][q,4]:=cellsec[j];
              linkset[n][0][q,5]:=CellSec[j];          
          
              linkset[n][0][q,6]:=[n];
           linkset[n][0][q,7]:=[m];
              linkset[n][0][q,8]:= peer[j] * digitcell[n] ;    
                
           end;
        end;{bivavle}
      
      {bi local}       
      if (sec[xn,n] = 2 )
          then          
          for J in DigitRCB[xn,n] do
            begin
            
            inc(a);
            
             setlength(linkset[n][1],a+1);
            include(linkset[n][1][a,0],n);
             include(linkset[n][1][a,1],j);
            linkset[n][1][a,2]:= Digitrcb[xn,n] - [j];
            include(linkset[n][1][a,3],n);
            //include(linkset[n,1,a,4],xn);
             linkset[n][1][a,4]:=cellsec[j] - [xn];
            
            for m in digitRCB[xn,n] -[j] do
             linkset[n][1][a,5]:=cellsec[m]-[xn];            
                  
              linkset[n][1][a,6]:=pm[j]-[n];
             linkset[n][1][a,7]:=pm[m]-[n];
             linkset[n][1][a,8]:=peer[j]*digitcell[n] -[m];                 
             linkset[n][1][a,9]:=peer[m]*digitcell[n] -[j];
            
                end; {bilocal}
            
      { single + grouped & Grouped + single}       
      if (sec[xn,n] <5) and (Sec[xn,n] >2)
          then
            for J in DigitRCB[xn,n] do
              for m in peerRCB[xn] do
                 if  ((DigitRCB[m,n] * DigitRCB[xn,n])  + [j] = DigitRCB[xn,n] )
                     and not ( J in DigitRCB[m,n])   
                      then                
                   begin
            { single + grouped}       
                  inc(b);
            setlength(linkset[n][2],b+1);
            include(linkset[n][2,b,0],n);
             include(linkset[n][2,b,1],j);
            linkset[n][2,b,2]:= Digitrcb[xn,n] - [j];
            include(linkset[n][2,b,3],n);
            linkset[n][2,b,4]:=cellsec[j] - [xn];
            include(linkset[n][2,b,5],m);            
             linkset[n][2,b,6]:=pm[j]-[n];
             linkset[n][2,b,7]:=[0];
             linkset[n][2,b,9]:= Digitrcb[m,n]- (DigitRCB[m,n] * DigitRCB[xn,n]) ;
             linkset[n][2,b,8]:= peer[j]* digitcell[n]-(DigitRCB[m,n] * DigitRCB[xn,n]);
            
                 { grouped + single}
                  inc(c);
            setlength(linkset[n][3],c+1);
            include(linkset[n][3,c,0],n);
            linkset[n][3,c,1]:= Digitrcb[xn,n] - [j];
             include(linkset[n][3,c,2],j);            
            include(linkset[n][3,c,3],n);
            include(linkset[n][3,c,4],m);
            linkset[n][3,c,5]:= cellsec[j] - [xn] ;             
            linkset[n][3,c,6]:=[0];
            linkset[n][3,c,7]:=pm[j]-[n];
            linkset[n][3,c,9]:= peer[j] * digitcell[n]-(DigitRCB[m,n] * DigitRCB[xn,n]);
            linkset[n][3,c,8]:= DigitRCB[m,n]  -(DigitRCB[m,n] * DigitRCB[xn,n]) ;
                  end;
                  
   {Grouped + grouped}       
if (sec[xn,n] <7) and (Sec[xn,n] >4)
    then
       for J in peerrcb[xn] do
        for m in (peerrcb[xn]-[0..j]) do
        if ((DigitRCB[j,n] * DigitRCB[xn,n]) + (DigitRCB[m,n] * DigitRCB[xn,n]) = (DigitRCB[xn,n]))
           and (DigitRCB[j,n] * DigitRCB[m,n] = [] )
            then
              begin
          
               inc(d);
            setlength(linkset[n][4],d+1);
            include(linkset[n][4,d,0],n);
            linkset[n][4,d,1]:=(DigitRCB[xn,n] * Digitrcb[j,n]);
            linkset[n][4,d,2]:=(DigitRCB[xn,n] * DigitRCB[m,n]);
            include(linkset[n][4,d,3],n);
            include(linkset[n][4,d,4],J);
            include(linkset[n][4,d,5],m);            
               linkset[n][4,d,6]:=[0];   
            linkset[n][4,d,7]:=[0];
            linkset[n][4,d,9]:= DigitRCB[m,n] - (DigitRCB[xn,n] * DigitRCB[m,n]);
            linkset[n][4,d,8]:= DigitRCB[j,n] - (DigitRCB[xn,n] * DigitRCB[j,n]);
            
            inc(d);
            setlength(linkset[n][4],d+1);
            include(linkset[n][4,d,0],n);
            linkset[n][4,d,2]:=(DigitRCB[xn,n] * Digitrcb[j,n]);
            linkset[n][4,d,1]:=(DigitRCB[xn,n] * DigitRCB[m,n]);
            include(linkset[n][4,d,3],n);
            include(linkset[n][4,d,4],m);
            include(linkset[n][4,d,5],j);            
            linkset[n][4,d,6]:=[0];
            linkset[n][4,d,7]:=[0];   
               linkset[n][4,d,9]:= DigitRCB[j,n] - (DigitRCB[xn,n] * DigitRCB[j,n]);   
               linkset[n][4,d,8]:= DigitRCB[m,n] - (DigitRCB[xn,n] * DigitRCB[m,n]);         

              end;
          
if (sec[xn,n] <6) and (Sec[xn,n] >1) and (xn in [18..26])
   then
     for J in eri[xn-18,n] do
      begin
      
      inc(e);
      setlength(linkset[n][5],e+1);
      include(linkset[n][5,e,0],n);
      linkset[n][5,e,1]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]);
      linkset[n][5,e,2]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]);
      include(linkset[n][5,e,3],n);
      include(linkset[n][5,e,4], rx[secset[xn,j]]);
      include(linkset[n][5,e,5],  Cy[secset[xn,j]]+9);
       linkset[n][5,e,6]:=[0];
      linkset[n][5,e,7]:=[0];
      linkset[n][5,e,8]:= DigitRCB[Rx[secset[xn,j]],n]  - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]);
      linkset[n][5,e,9]:= DigitRCB[Cy[secset[xn,j]]+9,n]  - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]);
      
      inc(e);
      setlength(linkset[n][5],e+1);
      include(linkset[n][5,e,0],n);
      linkset[n][5,e,2]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]);
      linkset[n][5,e,1]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]);
      include(linkset[n][5,e,3],n);
      include(linkset[n][5,e,5], rx[secset[xn,j]]);
      include(linkset[n][5,e,4],  Cy[secset[xn,j]]+9);       
       linkset[n][5,e,6]:=[0];
      linkset[n][5,e,7]:=[0];
      linkset[n][5,e,9]:= DigitRCB[Rx[secset[xn,j]],n]  - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]);
      linkset[n][5,e,8]:= DigitRCB[Cy[secset[xn,j]]+9,n]  - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]);
      
      
      end;

end;
end;
{
assign(output,'C:\sudoku\combotest.txt');
erase(output);
rewrite(output);
close(output);

for n2 in [1..9] do
for xn in [0..5] do
 for J:= low(linkset[n2][xn]) to high(linkset[n2][xn]) do
 begin
   append(output);
      writeln(output);   
         write(output,'#',n2,' | ');
          write(output,'type:',xn,' | ');      
      for n:= low(linkset[n2][xn,j]) to high(linkset[n2][xn,j]) do
       begin
          for M in linkset[n2][xn,j,n] do
        write(output,m,',');
        write(output,' | ');
      end; 
      close(output);      
 end}

end;{strong link builder}

x-chain {depth first}: Show

Code: Select all

{x-chain }
procedure xchain(K:integer);
type
xsets = array of array of array of numberset;
steps = array of array of numberset;
used = array of numberset;
hold = array of integer;
var
h:hold;
xset: xsets;
step:steps;
use: used;
n,a,b,c,d,e,max:integer;

begin

setlength(xset,10,0,0);

for n in[1..9] do
begin
 b:=-1;
 for a in [1..5] do
    for c:=  low(linkset[n][a]) to high(linkset[n][a]) do
        begin
      b:=b+1;
      setlength(xset[n],b+1,10);
{ note the next section & similar subsections  can be compressed into xset[n][b]:=linkset[n,a,c]  instead of the 10 parts they are listed to show what im coping for this example}
      xset[n][b,0]:=linkset[n,a,c,0];
      xset[n][b,1]:=linkset[n,a,c,1];
      xset[n][b,2]:=linkset[n,a,c,2];
      xset[n][b,3]:=linkset[n,a,c,3];
      xset[n][b,4]:=linkset[n,a,c,4];
      xset[n][b,5]:=linkset[n,a,c,5];
      xset[n][b,6]:=linkset[n,a,c,6];
      xset[n][b,7]:=linkset[n,a,c,7];
      xset[n][b,8]:=linkset[n,a,c,8];
      xset[n][b,9]:=linkset[n,a,c,9];      
      end;
end;

for n in[1..9] do
 for a:= high(xset[n]) downto 0 do
   begin
 
   b:=0; 
   max:= high(xset[n]);   
   setlength(use,b+1);   
   use[b]:= xset[n][a][1] + xset[n][a][2] ;   
   setlength(h,b+1);
   h[b]:=max;
   
   setlength(step,b+1,10);
         step[b,0]:=xset[n,a,0];
      step[b,1]:=xset[n,a,1];
      step[b,2]:=xset[n,a,2];
      step[b,3]:=xset[n,a,3];
      step[b,4]:=xset[n,a,4];
      step[b,5]:=xset[n,a,5];
      step[b,6]:=xset[n,a,6];
      step[b,7]:=xset[n,a,7];
      step[b,8]:=xset[n,a,8];
      step[b,9]:=xset[n,a,9];   

repeat
   for c:= h[b] downto 0 do
     if (xset[n][C][1] * use[b] = [])
    and (xset[n][C][2] * use[b] = [])
    and (step[b][5]  * xset[n][c][4] <> [])
      then
     begin
     h[b]:=h[b] - 1;
      b:=b+1;     
      setlength(use,b+1);   
       use[b]:=use[b-1]+ xset[n][c][1] +xset[n][c][2] ;   
      setlength(h,b+1);
      h[b]:=max;
         setlength(step,b+1,10);
         step[b,0]:=xset[n,c,0];
      step[b,1]:=xset[n,c,1];
      step[b,2]:=xset[n,c,2];
      step[b,3]:=xset[n,c,3];
      step[b,4]:=xset[n,c,4];
      step[b,5]:=xset[n,c,5];
      step[b,6]:=xset[n,c,6];
      step[b,7]:=xset[n,c,7];
      step[b,8]:=xset[n,c,8];
      step[b,9]:=xset[n,c,9];
      
if (b > 0) and (xset[n][c][5] * xset[n][a][4] <> []) {ring}
  then
    begin
    active:=true;
 {start and finsih peers are eliminated for each set in the chain}
    
       for e:= 0 to (b-1) do
       for d:= e+1 to (b) do
        begin
        active:=true;
           covered2[n]:=covered2[n] + ((step[d][8]*step[e][8]) -use[b]); { start a to start b peers}
            covered2[n]:=covered2[n] + ((step[d][9]*step[e][9]) -use[b]);   {end a to end b peers}
          covered2[n]:=covered2[n] + ((step[d][8]*step[e][9]) -use[b]); {end a to start b}
            covered2[n]:=covered2[n] + ((step[d][9]*step[e][8]) -use[b]); {start  a to end b}
       end;
       
    end;
   
if (b > 0) and (xset[n][c][5] * xset[n][a][4] = []) and (((xset[n][a][8]*xset[n][c][9]) -use[b]) <> []){normal}
  then
    begin
    active:=true;
    covered2[n]:=covered2[n] + ((xset[n][a][8]*xset[n][c][9]) -use[b]);   
   
    end;    

   
       break;       
     end
     else
      h[b]:= h[b] - 1;
      
   
   
if (h[b] < 0) and (b > 0) or (b >= max)
 then
  begin
  b:=b-1;
        setlength(use,b+1);    
       setlength(h,b+1);
      setlength(step,b+1,10);
      h[b]:=h[b]-1;
  end; 

until (h[b] = -1) or (b = 0)    
         
   end;
   
end; {x-chain}


to help that data looks like this for me for the above pattern

double bridged er: Show

Code: Select all

#1 | type:1 | 1, | 10, | 13, | 1, | 10,18, | 13,19, | 2,3,4,5,6,7,8,9, | 2,3,4,5,6,7,8,9, | 0,1,2,18,19,20,28,46,55,64,73, | 3,4,5,21,22,23,31,40,49,58,67,76, |
#1 | type:1 | 1, | 13, | 10, | 1, | 13,19, | 10,18, | 2,3,4,5,6,7,8,9, | 2,3,4,5,6,7,8,9, | 3,4,5,21,22,23,31,40,49,58,67,76, | 0,1,2,18,19,20,28,46,55,64,73, |
#1 | type:1 | 1, | 40, | 43, | 1, | 13,22, | 16,23, | 2,3,4,5,6,7,8,9, | 2,3,4,5,6,7,8,9, | 4,13,22,30,31,32,48,49,50,58,67,76, | 7,25,33,34,35,51,52,53,61,70,79, |
#1 | type:1 | 1, | 43, | 40, | 1, | 16,23, | 13,22, | 2,3,4,5,6,7,8,9, | 2,3,4,5,6,7,8,9, | 7,25,33,34,35,51,52,53,61,70,79, | 4,13,22,30,31,32,48,49,50,58,67,76, |
#1 | type:4 | 1, | 6,7,8, | 24,25,26, | 1, | 0, | 2, | 0, | 0, | 0,1,2,3,4,5, | 18,19,20,21,22,23, |
#1 | type:4 | 1, | 24,25,26, | 6,7,8, | 1, | 2, | 0, | 0, | 0, | 18,19,20,21,22,23, | 0,1,2,3,4,5, |
#1 | type:4 | 1, | 27,28,29, | 45,46,47, | 1, | 3, | 5, | 0, | 0, | 30,31,32,33,34,35, | 48,49,50,51,52,53, |
#1 | type:4 | 1, | 45,46,47, | 27,28,29, | 1, | 5, | 3, | 0, | 0, | 48,49,50,51,52,53, | 30,31,32,33,34,35, |
#1 | type:5 | 1, | 63,64,65, | 55,64,73, | 1, | 7, | 10, | 0, | 0, | 66,67,68,69,70,71, | 1,10,19,28,46, |
#1 | type:5 | 1, | 55,64,73, | 63,64,65, | 1, | 10, | 7, | 0, | 0, | 1,10,19,28,46, | 66,67,68,69,70,71, |
#1 | type:5 | 1, | 69,70,71, | 61,70,79, | 1, | 7, | 16, | 0, | 0, | 63,64,65,66,67,68, | 7,25,34,43,52, |
#1 | type:5 | 1, | 61,70,79, | 69,70,71, | 1, | 16, | 7, | 0, | 0, | 7,25,34,43,52, | 63,64,65,66,67,68, |

pss you could build the tables to be a parent/child list and walk the links as well as some people perfer but its a breadth first approach.
{i still dont know how to do that as im self taught}

[creint]

Not very readable code: "self taught". Knowing how better code looks like could help.
Looks hardcoded to only support vanilla sudoku.
Not usable for my solver, could implement it in my solver. Code could run a bit slower, what timings would you want?

[StrmCkr]

Looks hard coded to only support vanilla sudoku.

pretty much, but my solver is set for vanilla Sudoku with no variations ATM.

Not very readable code: "self taught". Knowing how better code looks like could help.

as i mentioned wrote it yesterday finally clicked in how to do it, my strong link data base defiantly helped as it reduced almost all of other functions line count by 85%. usually i have notes on it to follow what its doing ill add them in if it helps.

having access to code for free pascal would help not many program in it these days... that and most codes Ive found arent legible either if i mange to make hide nor hair of them its by completely dissecting the whole program to figure out exactly what the short hand code is doing then cant convert it to free pascal as some of the functions arent in pascal directly.

like this one provided to me years ago by PIsaacson a retired programmer works pretty well but i had to digest 17 different pages of code to even get a vague understanding of how the data works together.

colouring: Show

Code: Select all

 function grid_t.coloring_init () : integer;

var
  cx, d, s, rcbn, rcbt, index, nx1, nx2 : integer;

begin
  cx := 0;

  for d := 0 to 8 do
    begin
      for s := 0 to 26 do
        begin
          rcbt := s div 9;
          rcbn := s mod 9;

          case rcbt of
            type_row: index := rn_cands[rcbn, d];
            type_col: index := cn_cands[rcbn, d];
            type_box: index := bn_cands[rcbn, d];
          end;

          if (cands2n[index] <> 2) then
            continue;

          nx1 := next_bit (index);
          index := index xor (1 shl nx1);
          nx2 := next_bit (index);

          c_list[cx].digit := d;

          case rcbt of
            type_row:
              begin
                c_list[cx].lh_index := rcbn * 9 + nx1;
                c_list[cx].rh_index := rcbn * 9 + nx2;
              end;
            type_col:
              begin
                c_list[cx].lh_index := nx1 * 9 + rcbn;
                c_list[cx].rh_index := nx2 * 9 + rcbn;
              end;
            type_box:
              begin
                c_list[cx].lh_index := rc2b[rcbn, nx1] * 9 + rc2x[rcbn, nx1];
                c_list[cx].rh_index := rc2b[rcbn, nx2] * 9 + rc2x[rcbn, nx2];
              end;
          end;

          cx += 1;

          if (cx >= high (c_list)) then
            begin
              setlength (c_list, high (c_list) + 129);
            end;
        end;
    end;

  exit (cx-1);
end;

function color_mbits (mask, r, c : integer) : integer;

var
  b, bx : integer;

begin
  b := rc2b[r, c];
  bx := rc2x[r, c];

  if ((cg.c_board[r, c] and cell_candidate) <> 0) and ((cg.c_board[r, c] and mask) = 0) then
    begin
      cg.c_board[r, c] := cg.c_board[r, c] or mask;
      cg.r_index[r] := cg.r_index[r] and (not (1 shl c));
      cg.c_index[c] := cg.c_index[c] and (not (1 shl r));
      cg.b_index[b] := cg.b_index[b] and (not (1 shl bx));
      exit (1);
    end;
  exit (0);
end;

function color_cell (mask, r, c : integer) : integer;

var
  b ,n : integer;

begin
  b := rc2b[r, c];

  cg.c_board[r, c] := cg.c_board[r, c] or mask;

  cg.r_index[r] := 0;
  cg.c_index[c] := 0;
  cg.b_index[b] := 0;

  mask := mask shl 1;

  for n := 0 to 8 do
    begin
      if (n <> c) then color_mbits (mask, r, n);
      if (n <> r) then color_mbits (mask, n, c);
      if (n <> rc2x[r, c]) then color_mbits (mask, rc2b[b, n], rc2x[b, n]);
    end;

  exit (1);
end;

function color_singles (mask : integer) : integer;

var
  update, n, bx : integer;

begin
  update := 0;

  for n := 0 to 8 do
    begin
      if (cands2n[cg.r_index[n]] = 1) then
        begin
          update += color_cell (mask, n, next_bit (cg.r_index[n]));
        end;
      if (cands2n[cg.c_index[n]] = 1) then
        begin
          update += color_cell (mask, next_bit (cg.c_index[n]), n);
        end;
      if (cands2n[cg.b_index[n]] = 1) then
        begin
          bx := next_bit (cg.b_index[n]);
          update += color_cell (mask, rc2b[n, bx], rc2x[n, bx]);
        end;
    end;

  exit (update);
end;

function color_boxline (mask : integer) : integer;

var
  r, c, b, bx, n, index, update : integer;

begin
  update := 0;

  for r := 0 to 8 do
    begin
      index := cg.r_index[r];
      n := cands2n[index];

      if (n < 2) or (n > 3) then
        continue;

      bx := 0;

      for c := 0 to 8 do
        begin
          if ((index and (1 shl c)) <> 0) then
            bx := bx or (1 shl rc2b[r, c]);
        end;

      if (cands2n[bx] <> 1) then
        continue;

      b := next_bit (bx);

      for bx := 0 to 8 do
        begin
          if ((bx div 3) = (r mod 3)) then
            continue;

          update += color_mbits (mask, rc2b[b, bx], rc2x[b, bx]);
        end;
    end;

  for c := 0 to 8 do
    begin
      index := cg.c_index[c];
      n := cands2n[index];

      if (n < 2) or (n > 3) then
        continue;

      bx := 0;

      for r := 0 to 8 do
        begin
          if ((index and (1 shl r)) <> 0) then
            bx := bx or (1 shl rc2b[r, c]);
        end;

      if (cands2n[bx] <> 1) then
        continue;

      b := next_bit (bx);

      for bx := 0 to 8 do
        begin
          if ((bx mod 3) = (c mod 3)) then
            continue;

          update += color_mbits (mask, rc2b[b, bx], rc2x[b, bx]);
        end;
    end;

  for b := 0 to 8 do
    begin
      index := cg.b_index[b];
      bx := cands2n[index];

      if (bx < 2) or (bx > 3) then
        continue;

      r := 0;
      c := 0;

      for bx := 0 to 8 do
        begin
          if ((index and (1 shl bx)) <> 0) then
            begin
              r := r or (1 shl rc2b[b, bx]);
              c := c or (1 shl rc2x[b, bx]);
            end;
        end;

      if (cands2n[r] = 1) then
        begin
          r := next_bit (r);

          for c := 0 to 8 do
            begin
              if (b = rc2b[r, c]) then
                continue;

              update += color_mbits (mask, r, c);
            end;
        end
      else
        if (cands2n[c] = 1) then
          begin
            c := next_bit (c);

            for r := 0 to 8 do
              begin
                if (b = rc2b[r, c]) then
                  continue;

                update += color_mbits (mask, r, c);
              end;
          end;
    end;

  exit (update);
end;

function grid_t.coloring () : integer;

var
  r, c, d, cx, cx_top, r1, c1, r2, c2, s, n, index, cell, change, update, exiting, pos_cnt, neg_cnt, cand_cnt : integer;

  label exclude_r1c1;
  label exclude_r2c2;

begin
  update := 0;
  exiting := 0;

  cx_top := coloring_init ();

  for cx := 0 to cx_top do
    begin
      d := c_list[cx].digit;

      r1 := c_list[cx].lh_index div 9;
      c1 := c_list[cx].lh_index mod 9;
      r2 := c_list[cx].rh_index div 9;
      c2 := c_list[cx].rh_index mod 9;

      if (given[r1, c1] <> 0) or ((rc_cands[r1, c1] and (1 shl d)) = 0) then
        continue;

      if (given[r2, c2] <> 0) or ((rc_cands[r2, c2] and (1 shl d)) = 0) then
        continue;

      fillbyte (cg, sizeof (cg), 0);

      for r := 0 to 8 do
        begin
          cg.r_index[r] := rn_cands[r, d];
          cg.c_index[r] := cn_cands[r, d];
          cg.b_index[r] := bn_cands[r, d];

          for c := 0 to 8 do
            begin
              if (given[r, c] <> 0) then
                begin
                  if (given[r, c] = d+1) then
                    cg.c_board[r, c] := cell_given;
                  continue;
                end;

              if ((rc_cands[r, c] and (1 shl d)) <> 0) then
                cg.c_board[r, c] := cell_candidate;
            end;
        end;

      color_cell (cell_pos_pass1, r1, c1);

      repeat
        change := color_singles (cell_pos_pass1);
        if (change = 0) then
          change := color_boxline (cell_neg_pass1);
      until (change = 0);

      for s := 0 to 26 do
        begin
          pos_cnt := 0;
          neg_cnt := 0;
          cand_cnt := 0;

          for n := 0 to 8 do
            begin
              index := sectors[s, n];
              r := index div 9;
              c := index mod 9;

              cell := cg.c_board[r, c];

              if (cell and cell_candidate) <> 0 then inc (cand_cnt);
              if (cell and cell_pos_pass1) <> 0 then inc (pos_cnt);
              if (cell and cell_neg_pass1) <> 0 then inc (neg_cnt);
            end;

          if (pos_cnt > 1) or ((neg_cnt > 1) and (neg_cnt = cand_cnt)) then
            goto exclude_r1c1;
        end;

      for n := 0 to 8 do
        begin
          cg.r_index[n] := rn_cands[n, d];
          cg.c_index[n] := cn_cands[n, d];
          cg.b_index[n] := bn_cands[n, d];
        end;

      color_cell (cell_pos_pass2, r2, c2);

      repeat
        change := color_singles (cell_pos_pass2);
        if (change = 0) then
          change := color_boxline (cell_neg_pass2);
      until (change = 0);

      for s := 0 to 26 do
        begin
          pos_cnt := 0;
          neg_cnt := 0;
          cand_cnt := 0;

          for n := 0 to 8 do
            begin
              index := sectors[s, n];
              r := index div 9;
              c := index mod 9;

              cell := cg.c_board[r, c];

              if (cell and cell_candidate) <> 0 then inc (cand_cnt);
              if (cell and cell_pos_pass2) <> 0 then inc (pos_cnt);
              if (cell and cell_neg_pass2) <> 0 then inc (neg_cnt);
            end;

          if (pos_cnt > 1) or ((neg_cnt > 1) and (neg_cnt = cand_cnt)) then
            goto exclude_r2c2;
        end;

      for r := 0 to 8 do
        begin
          for c := 0 to 8 do
            begin
              cell := cg.c_board[r, c];

              if ((cell and cell_pos_pass1) <> 0) and ((cell and cell_pos_pass2) <> 0) then
                begin
                  change := update_cell (d, r, c);
                  update += change;

                  if (sw_verbose <> 0) and (change <> 0) then
                    writeln (inc_stepno (): 3, ') r', r+1, 'c', c+1, ' <= ', d+1, ' coloring parity both pos');
 
                  if (change <> 0) and (exit_check (d, r, c, exiting) = true) then
                    exit (update);
                end
              else if ((cell and cell_neg_pass1) <> 0) and ((cell and cell_neg_pass2) <> 0) then
                begin
                  change := update_mbit (d, r, c);
                  update += change;

                  if (sw_verbose <> 0) and (change <> 0) then
                    writeln (inc_stepno (): 3, ') r', r+1, 'c', c+1, ' <> ', d+1, ' coloring parity both neg');

                  if (change <> 0) and (exit_check (d, r, c, exiting) = true) then
                    exit (update);
                end;
            end;
        end;

      continue;

    exclude_r1c1:

      change := update_mbit (d, r1, c1);
      update += change;

      if (sw_verbose <> 0) and (change <> 0) then
        writeln (inc_stepno (): 3, ') r', r1+1, 'c', c1+1, ' <> ', d+1, ' coloring conflict pass 1');

      if (change <> 0) and (exit_check (d, r1, c1, exiting) = true) then
        exit (update);

      continue;

    exclude_r2c2:

      change := update_mbit (d, r2, c2);
      update += change;

      if (sw_verbose <> 0) and (change <> 0) then
        writeln (inc_stepno (): 3, ') r', r2+1, 'c', c2+1, ' <> ', d+1, ' coloring conflict pass 2');

      if (change <> 0) and (exit_check (d, r2, c2, exiting) = true) then
        exit (update);
    end;

  exit (update);
end;

to summarize my code.

grab a strong link from the array
A = B

cycle the array for the next
A = B

check the sector of
B from the previous array to the A sector on the current cycle if they are equal add it to the list {weak link}

if applicable { end point eliminations}
perform eliminations of peers of B cells of 2nd set and A cells of initial array but only when they share peer cells

{loop/ring}
perform eliminations: if b cells in current A cells of the initial array share a sector
of peers of A&A, B&B and A&B{start 1 end 2} B&A {end1 start2}

then
advance the cycle by 1, searching for the next a = b
else
advance the cycle by 1

end that tree and back track by 1 step when no more links are found
repeat until there is no more branches to search for that tree

cycle the initial array by 1.
repeat until the initial array is exhausted.

the stuff i could do to make it look more elegant is swap from a iterative "frozen" C array that only advances when i hit true & use prec succ function for iterative

or option be is a self calling next function that grabs the next link in a list.

either way it is a short code just under 100 lines which i'm happy with since my other attempts that botched hit the 1k mark easily.

[StrmCkr]

not usable for my solver, could implement it in my solver. Code could run a bit slower, what timings would you want?

if you want to share code im all for it: always worth reading some one else input on how they do something .

my current one gets around 300 - 350 puzzles a second in batch mode. with x-chains only active in the solve function.

i cans speed that up significantly by removing duplicate chains { like 1,2 is the same as 2,1} the code on here doesn't have that enabled as its first draft.

[creint]

300 - 350 puzzles a second does tell me how much the function is executed/cores and if all possible x-chains are collected or only the first one.
With 650 lines I have a net solver, which solves up to around SE 10.
But only grouped x-chains should make it very easy.

[StrmCkr]

300 - 350 puzzles a second does tell me how much the function is executed/cores and if all possible x-chains are collected or only the first one.

all of them that are possible to build at each successive step until each puzzle ends in the batch file
calculated on my ryzen 2800+ using all threads {3.ghz not overclocked}.

[Hajime]

Thank you SpAce, that is the confirmation a was looking for.
I will call the methods: Skyscraper, 2-String Kite and Turbot Crane.

Excellent!

X-chain of length 4 has 3 links: A=B-C=D (if not grouped).
Because my code is generalized for all sudoku-types (normal, asterisk,girandola,X,..., jigsaw) my definition is now:
Skyscraper = 2 rows OR 2 columns, the middle link can be any house (eg a diagonal, not necessary a row or col)
2-String Kite = 1 row(col) as the 1st link and 1 col(row) as the 3rd link. The 2nd link may be anything
Turbot Crane= 1 row(col) as the 1st link and 1 col(row) as the 2rd link. The 3nd link may be anything
Otherwise: Turbot Fish, eg 2 diagonals and a row.
Is that acceptable?

Current Source code of X-chain (not yet with Grouped functionality, about 230 lines). Tested but not finished.
Included is X-chain of length 4, which is called Skyscraper, 2-String Kite and Turbot Crane, with above definition.
Works for all types of Sudoku's in a multi Sudoku overlapping puzzle:

Hidden Text: Show

Code: Select all

Runner p runs through all sudoku's of the puzzle eg samurai
Function is_a(p, st) gives true is sudoku p is of type st that has (row,col,box,asterisk,girandola,...,jigsaw)
Function is_candidate(p, r, c, k)  give true if candidate k is in cell(r,c) of sudoku p
Function not_candidate(p, r, c, k, True) logs an elimination of k, if k is present.
Global variable elim_count is incremented after each real candidate elimination
Array house_he_r(t1, h, e) gives row nr of house of type t1, house number h and element e.
Array house_he_c(t1, h, e) gives col nr of house of type t1, house number h and element e.
Array house_rc_h(t1, r, c) gives house-nr of (r,c) if sudoku is of type t1 (reverse function)
Array house_rc_e(t1, r, c) gives element-nr of (r,c) if sudoku is of type t1
Lines starting with ' are comment lines

   '---------------------------------------------
   Private Enum sud_types 'sudoku types
        zero_not_used
        rows         
        cols         
        boxes         
        asterisk     
        girandola     
        sudokuX_D1   
        sudokuX_D2   
        centerdot   
        windoku       
        sudokuP     
        jigsaw       
    End Enum
    Dim sud_hmax() As Short = {0, 9, 9, 9, 1, 1, 1, 1, 1, 9, 9, 9} 'the house totals per sudtype
    Dim sud_names() As String = {"#", "row", "col", "box", "asterisk", "girandola",
          "sudokuX/", "sudokuX\", "centerdot", "windoku", "sudokuP", "jigsaw"}
    Const sud_char As String = "#rcbAG/\DWPJ" 'all types of houses, to skip the first with # is not used

    Dim xgrid(,) As Short
    Dim x_chain_log() As Short 'holds chainlog cells, cell-number like 45 for r4c5
    Dim x_chain_typ() As Short 'holds the type per logged chain cell
   
    Private Sub init_x_chain(p)
        ReDim xgrid(0 To 9, 0 To 9) 'redim initializes the array to zeroes; holds the chain in progress; index 0 is not used
        ReDim x_chain_log(0 To 81)  'also holds the chain in progress; index 0 is not used
        ReDim x_chain_typ(0 To 81)  'also holds the chain types in progress; only needed for chain length 4 (skyscraper etc)
        If is_a(p, sud_types.jigsaw) Then fill_jigsaw(p, sud_types.jigsaw) 'each sudoku in puzzle can have different jigsaw
    End Sub

    Private Sub elim_spectators(p, k, d, r1, c1, r4, c4)
        For t1 = 1 To max_types
            If is_a(p, t1) Then
                Dim h1 = house_rc_h(t1, r1, c1) 'the house where startcell r1c1 is in
                If h1 > 0 Then 'valid house. if h1=0 this cell does not belong to this type t1 eg r1c1 is not in the house of an astersk
                    For t2 = t1 To max_types 't1       ???? todo, if t2=1 to... gives LESS solutions in example :
                        '1.......2.3..4..5...62.14....17.62.............31.28....83.97...2..6..9.3.......6 with some skyscrapers
                        If is_a(p, t2) Then
                            Dim h2 = house_rc_h(t2, r4, c4)
                            If h2 > 0 Then
                                    For e = 1 To 9 'all cells in house h1
                                        Dim er = house_he_r(t1, h1, e), ec = house_he_c(t1, h1, e)
                                        If house_rc_h(t2, er, ec) = h2 Then 'cell is also in house h2
                                            If Not (r1 = er And c1 = ec) And Not (r4 = er And c4 = ec) Then 'not start- or end-cell
                                                If is_candidate(p, er, ec, k) Then
                                                    not_candidate(p, er, ec, k, True)
                                                End If
                                            End If
                                        End If
                                    Next
                            End If
                        End If
                    Next
                End If
            End If
        Next
    End Sub

    Private Sub x_kill_zone(p, k, d, r1, c1, r4, c4)
        'eliminate all candidates k from cells that 'see' (r1,c1) and (r4,c4)
        If d <= 2 Then Exit Sub
        Dim el = elim_count
        elim_spectators(p, k, d, r1, c1, r4, c4)
        If el < elim_count Then
            Dim tt As String = ""
            If d = 4 Then '4 cells linked with 3 links numbered 1,2,3
                If (x_chain_typ(1) = sud_types.rows And x_chain_typ(3) = sud_types.cols) Or
                   (x_chain_typ(1) = sud_types.cols And x_chain_typ(3) = sud_types.rows) Then '1 row and 1 column
                    tt &= "2-string Kite"
                ElseIf (x_chain_typ(1) = sud_types.rows And x_chain_typ(3) = sud_types.rows) Or
                       (x_chain_typ(1) = sud_types.cols And x_chain_typ(3) = sud_types.cols) Then '2 rows or columns
                    tt &= "Skyscraper"
                ElseIf (x_chain_typ(1) = sud_types.rows And x_chain_typ(2) = sud_types.cols) Or 'last house is something else
                       (x_chain_typ(1) = sud_types.cols And x_chain_typ(2) = sud_types.rows) Or
                       (x_chain_typ(3) = sud_types.rows And x_chain_typ(2) = sud_types.cols) Or 'first house is something else
                       (x_chain_typ(3) = sud_types.cols And x_chain_typ(2) = sud_types.rows) Then
                    tt &= "Turbot Crane"
                Else
                    tt &= "Turbot Fish"
                End If
            Else
                tt = "XC [" & d & "] " 'X-chain method
            End If
            x_chain_log_string(p, k, tt, 1, d)
        End If
    End Sub

    Private Sub x_chain_log_string(p, k, txt, frm, till)
        If CB_Logging_On.Checked Then
            Dim s As String = "r" & x_chain_log(frm) \ 10 & "c" & x_chain_log(frm) Mod 10
            For m = frm + 1 To till
                If m Mod 2 = 1 Then s &= "-" Else s &= "="
                s &= "r" & x_chain_log(m) \ 10 & "c" & x_chain_log(m) Mod 10
            Next
            u_m(vbCrLf & txt & " (" & k & ") g" & p & s)
        End If
    End Sub

    Private Function x_2nd_strong(t, r1, c1, p, k, ByRef r2, ByRef c2) As Boolean
        't,r1,c1 must have candidate k
        'find exactly second candidate k in house h at t,c1,r1 and result in r2,c2
        Dim card = 0
        Dim h = house_rc_h(t, r1, c1)
        If h > 0 Then
            For e = 1 To 9
                Dim rt = house_he_r(t, h, e)
                Dim ct = house_he_c(t, h, e)
                If Not (rt = r1 And ct = c1) AndAlso is_candidate(p, rt, ct, k) Then
                    r2 = rt
                    c2 = ct  'found second strong link cell h,e
                    card += 1
                    If card > 1 Then Exit For
                End If
            Next
        End If
        x_2nd_strong = (card = 1)
    End Function

    Dim stop_X_chain As Boolean
    Private Sub x_strong_link(p, k, d, max_depth, r, c, r_org, c_org)
        Application.DoEvents() 'd=depth is counting each strong link, so d=3 => chainlength=6
        If stop_solver Then Exit Sub
        xgrid(r, c) = 2 * d - 1
        x_chain_log(2 * d - 1) = r * 10 + c
        For t1 = 1 To max_types 'type
            If is_a(p, t1) Then 'is this sudoku p of type t1 ?
                x_chain_typ(2 * d - 1) = t1 'logs the type used
                Dim r2, c2 As Integer
                If x_2nd_strong(t1, r, c, p, k, r2, c2) Then 'second candidate in strong link
                    If xgrid(r2, c2) = 0 Then
                        xgrid(r2, c2) = 2 * d
                        x_chain_log(2 * d) = r2 * 10 + c2
                        x_kill_zone(p, k, 2 * d, r_org, c_org, r2, c2)
                        If d < max_depth Then
                            'search further for longer X-chain
                            'start from r2,c2 and find r3,c3 in some house weak link
                            Dim r3, c3 As Integer
                            For t2 = 1 To max_types 'type
                                If is_a(p, t2) Then 'is this sudoku p of type t2 ?
                                    Dim h2 = house_rc_h(t2, r2, c2)
                                    If h2 > 0 Then 'must be a cell in a valid house
                                        x_chain_typ(2 * d) = t2 'logs the type used count
                                        For e = 1 To 9
                                            r3 = house_he_r(t2, h2, e)
                                            c3 = house_he_c(t2, h2, e)
                                            If Not (r3 = r2 And c3 = c2) AndAlso is_candidate(p, r3, c3, k) Then
                                                'found some weak link cell h2,e = r3,c3
                                                If xgrid(r3, c3) = 0 Then 'not in the chain yet
                                                    x_strong_link(p, k, d + 1, max_depth, r3, c3, r_org, c_org)
                                                Else 'collision with chain itself: check x-cycle
                                                    x_cycle(d, p, xgrid(r3, c3), 2 * d + 1, k)
                                                End If
                                                If stop_X_chain Then Exit Sub
                                            End If
                                        Next
                                        x_chain_typ(2 * d) = 0 'x_chain_typ(t2) -= 1 'logs the type used
                                    End If
                                End If
                            Next
                        End If
                        xgrid(r2, c2) = 0
                        x_chain_log(2 * d) = 0
                    Else  'collision with chain itself: check nice loop
                        x_cycle(d, p, xgrid(r2, c2), 2 * d, k)
                        If stop_X_chain Then Exit Sub
                    End If
                End If
                x_chain_typ(2 * d - 1) = 0 'x_chain_typ(t1) -= 1
            End If
        Next
        xgrid(r, c) = 0
    End Sub

    Private Sub x_cycle(d As Integer, p As Integer, start_at As Integer, end_at As Integer, k As Integer)
        'Exit Sub
        If end_at > start_at + 2 Then
            Dim e = elim_count
            x_chain_log(end_at) = x_chain_log(start_at)
            If ((start_at Mod 2 = 0) And (end_at Mod 2 = 0)) Or ((start_at Mod 2 = 1) And (end_at Mod 2 = 1)) Then
                'both even or both odd gives a continuous nice loop
                For m = start_at To end_at - 1
                    elim_spectators(p, k, 2 * d, x_chain_log(m) \ 10, x_chain_log(m) Mod 10,
                    x_chain_log(m + 1) \ 10, x_chain_log(m + 1) Mod 10)
                Next
                If elim_count > e Then x_chain_log_string(p, k, "X-cycle [" & (end_at - start_at) & "]", start_at, end_at)
            Else 'we have a possible discontinued loop
                Dim cand = get_candidates(p, x_chain_log(start_at) \ 10, x_chain_log(start_at) Mod 10)
                If start_at Mod 2 = 1 Then 'Discontinuous Nice Loop, start cell is odd
                    substract_candidates(p, x_chain_log(start_at) \ 10, x_chain_log(start_at) Mod 10, cand Xor (1 << k)) 'leave only k as candidate
                    'we know the solution is "k" for this cell, but here is not the place to put the solution; just eliminate all but k
                Else 'start cell is even and cannot hold k
                    not_candidate(p, x_chain_log(start_at) \ 10, x_chain_log(start_at) Mod 10, k, True)
                End If
                If elim_count > e Then
                    'the x-cycle is not valid anymore
                    stop_X_chain = True
                    x_chain_log_string(p, k, "Discontinuous X-cycle [" & (end_at - start_at) & "]", start_at, end_at)
                    Exit Sub
                End If
                If False Then 'todo, ramp up path to x-cycle cannot be true
                    For m = 1 To start_at - 1
                        If m Mod 2 = 1 Then 'odd members before start_at must all be false so must be k
                            cand = get_candidates(p, x_chain_log(m) \ 10, x_chain_log(m) Mod 10)
                            substract_candidates(p, x_chain_log(m) \ 10, x_chain_log(m) Mod 10, cand Xor (1 << k)) 'leave only k as candidate
                        End If
                    Next
                    If elim_count > e Then
                        Dim s As String = vbCrLf & "Discontinuous X-cycle ramp-up (" & k & ")"
                        For m = 1 To start_at
                            s &= " g" & p & "r" & x_chain_log(m) \ 10 & "c" & x_chain_log(m) Mod 10
                        Next
                        u_m(s)
                    End If
                End If
            End If
        End If
    End Sub

    Private Sub X_chain(m, max_depth)
        current_method(m)
        'If max_depth = 2 Then u_m("2-string Kite, SkyScarper, TurbotFish", True) Else u_m("X-chain", True)
        For p = 1 To sudoku_total
            init_x_chain(p)
            stop_X_chain = False
            For k = 1 To 9
                For r1 = 1 To 9
                    For c1 = 1 To 9
                        If is_candidate(p, r1, c1, k) Then x_strong_link(p, k, 1, max_depth, r1, c1, r1, c1)
                        If stop_X_chain Then Exit For
                    Next
                    If stop_X_chain Then Exit For
                Next
                If stop_X_chain Then Exit For
            Next
        Next
    End Sub