## StormDoku

Programs which generate, solve, and analyze Sudoku puzzles

### StormDoku

This thread is for my Sudoku Solver written in "Turbo pascal" Via Free pascal 2.4+

I have always release my code and software under Licensing

Current code posted here in is designed for Windows operating system.
All inclusive .pas file

my current build of my solver is based on Setwise operations
+ Union of two sets
- Difference of two sets
* Intersection of two sets
= Checks equality of two sets
<> Checks non-equality of two sets
in Checks set membership of an element in a set
".. " operator precedence

Grid space index References
Solving space Data storage and type cast
Screen display functions
Peers building functions
Solving techniques
timer & main body code
Tools : issomorphs,generator,batch

previous builds
6.8 build
Last edited by StrmCkr on Thu May 31, 2018 5:48 am, edited 21 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Grid space index

Constants: Show
Code: Select all
`const       LEFT    = 12;       UP      = 4;       SPACE   = ' ';       dat_file= 'stormduko.dat'; {save file}       dat_file2= 'stormdukoPM.dat';{save pm file}       text_file= 'Generated.txt';       COL1   = lightblue; {preset colors}       COL2   = lightgray;       COLBG  = black;`

Index constants for quicker referencing: Show
Code: Select all
`ConstRx: array[0..80] of integer =   (0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,    3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,    6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8);  Cy: array[0..80] of integer =   (0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,    0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,    0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8);  Bxy: array[0..80] of integer =   (0,0,0,1,1,1,2,2,2,0,0,0,1,1,1,2,2,2,0,0,0,1,1,1,2,2,2,    3,3,3,4,4,4,5,5,5,3,3,3,4,4,4,5,5,5,3,3,3,4,4,4,5,5,5,    6,6,6,7,7,7,8,8,8,6,6,6,7,7,7,8,8,8,6,6,6,7,7,7,8,8,8);  BxyN: array[0..80] of integer =   (0,1,2,0,1,2,0,1,2,3,4,5,3,4,5,3,4,5,6,7,8,6,7,8,6,7,8,    0,1,2,0,1,2,0,1,2,3,4,5,3,4,5,3,4,5,6,7,8,6,7,8,6,7,8,    0,1,2,0,1,2,0,1,2,3,4,5,3,4,5,3,4,5,6,7,8,6,7,8,6,7,8);  {quick look up for each space}  Rset: array [0..8,0..8] of integer =    ( (0,1,2,3,4,5,6,7,8),    (9,10,11,12,13,14,15,16,17),    (18,19,20,21,22,23,24,25,26),    (27,28,29,30,31,32,33,34,35),    (36,37,38,39,40,41,42,43,44),    (45,46,47,48,49,50,51,52,53),    (54,55,56,57,58,59,60,61,62),    (63,64,65,66,67,68,69,70,71),    (72,73,74,75,76,77,78,79,80) );  Cset: array [0..8,0..8] of integer =    ( (0,9,18,27,36,45,54,63,72),    (1,10,19,28,37,46,55,64,73),    (2,11,20,29,38,47,56,65,74),    (3,12,21,30,39,48,57,66,75),    (4,13,22,31,40,49,58,67,76),    (5,14,23,32,41,50,59,68,77),    (6,15,24,33,42,51,60,69,78),    (7,16,25,34,43,52,61,70,79),    (8,17,26,35,44,53,62,71,80) );   Bset: array [0..8,0..8] of integer =    ( (0,1,2,9,10,11,18,19,20),    (3,4,5,12,13,14,21,22,23),    (6,7,8,15,16,17,24,25,26),    (27,28,29,36,37,38,45,46,47),    (30,31,32,39,40,41,48,49,50),    (33,34,35,42,43,44,51,52,53),    (54,55,56,63,64,65,72,73,74),    (57,58,59,66,67,68,75,76,77),    (60,61,62,69,70,71,78,79,80) ); SecSet: array [0..26,0..8] of integer =    ( {row}    (0,1,2,3,4,5,6,7,8),    (9,10,11,12,13,14,15,16,17),    (18,19,20,21,22,23,24,25,26),    (27,28,29,30,31,32,33,34,35),    (36,37,38,39,40,41,42,43,44),    (45,46,47,48,49,50,51,52,53),    (54,55,56,57,58,59,60,61,62),    (63,64,65,66,67,68,69,70,71),    (72,73,74,75,76,77,78,79,80),      {col}    (0,9,18,27,36,45,54,63,72),    (1,10,19,28,37,46,55,64,73),    (2,11,20,29,38,47,56,65,74),    (3,12,21,30,39,48,57,66,75),    (4,13,22,31,40,49,58,67,76),    (5,14,23,32,41,50,59,68,77),    (6,15,24,33,42,51,60,69,78),    (7,16,25,34,43,52,61,70,79),    (8,17,26,35,44,53,62,71,80),    {box}    (0,1,2,9,10,11,18,19,20),    (3,4,5,12,13,14,21,22,23),    (6,7,8,15,16,17,24,25,26),    (27,28,29,36,37,38,45,46,47),    (30,31,32,39,40,41,48,49,50),    (33,34,35,42,43,44,51,52,53),    (54,55,56,63,64,65,72,73,74),    (57,58,59,66,67,68,75,76,77),    (60,61,62,69,70,71,78,79,80) );   secRCb: array [0..26] of integer =   (0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8);   Rsec: array[0..8] of integer =   (0,1,2,3,4,5,6,7,8);   Csec: array[0..8] of integer =   (9,10,11,12,13,14,15,16,17);   bsec: array[0..8] of integer =   (18,19,20,21,22,23,24,25,26);`
Last edited by StrmCkr on Wed May 30, 2018 6:14 am, edited 5 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Data sets and type cast

Type Definition for data space: Show
Code: Select all
`typesector = 0 .. 26;cell = 0 .. 80;digits = 1 .. 9;RCB = 0 .. 8;numberset = set of cell;   {the grid}nums =  set of digits;   {digits 1-9}RCBnums = set of Rcb;  {R,C,B spaces 0 - 8}RCBpeer = set of sector; {RCB peer sectors}tech= array of array of numberset;`

Data storage Space: Show
Code: Select all
`techwrite:  tech;peer: array [cell] of numberset;peer2: array [cell,0..19] of integer; {a quick call version to use the peers}comboset: array [0..510] of nums;        { digits }comboset2: array [0..510] of RCbnums;    { 0-8 cells}combosetR: array [rcb,0..510] of numberset;     {cells for row}combosetC: array [rcb,0..510] of numberset;     {cells for col}combosetB: array [rcb,0..510] of numberset;     {cells for box}combosetS: array [sector,0..510] of numberset;  {listing cells for sector} Rnum:  array[rcb] of numberset; {area peers} Bnum:  array[rcb] of numberset; Cnum:  array[rcb] of numberset; RCBnum: array[sector] of numberset; {RCB call function for easier use} peerRCB: array[sector] of rcbpeer; {RCB peer sectors} DigitRCB: array[digits,sector] of numberset; {RBC function listing active cells for digit N} DigitCell: array[digits] of numberset; { listing every cell with n candidate} NSector: array[sector] of nums; {function listing all  digits for sector} Ssector: array[sector] of nums; {function listing all solved digits for sector} SectorRCB: array[Sector,RCB] of numberset;   {Rbc function listing active cells for a sectors rcb}      X,Y           : integer; {coridinals}      Grid          : String ; {imported grid string}      Count,Countpm : integer; {counts the given clues and pms}      active,unique : boolean;      ch            : char;      iter          : integer;      //variation     : boolean;S:  array [cell] of nums;  {solved grid}PM: array [cell] of nums;  {pm combined view} {RD*CD*BD}IPM: array[cell] of nums; {saved pm combined view} {RD*CD*BD}NM: array [cell] of integer; { # of digits found in cell}Delpm: array [cell] of nums;    {manual deletion of pencil marks}covered: array [cell] of nums;covered2: array [digits] of numberset;combocell: array [0..510] of numberset; { combosets in specific cells Naked}ComboSubset: array [0..510] of numberset; {subset combo in specific cells }{hidden sets}Rn: array [Rcb,digits] of RCBnums;   {nums represet Col #}Cn: array [Rcb,digits] of RCBnums;   {nums represet Row #}Bn: array [Rcb,digits] of RCBnums;   {nums represet Box ordering #}RnSector: array [sector,Digits] of RCBnums;  {saves RCB}{Mini row/Col}BnC: array [Rcb,digits] of RCBnums;   {nums represet  col used in a box  }BnR: array [Rcb,digits] of RCBnums;   {nums represet  row used in a box  }CnB: array [Rcb,digits] of RCBnums;   {nums represet Box  used inside a col }RnB: array [Rcb,digits] of RCBnums;   {nums represet Box  used inside a row }{Naked sets}RC: array[RCB,RCB] of nums;      {# in row x col}BS: array[RCB,RCB] of nums;      {# in box - square}SectorRC: array[sector,rcb] of nums; {# in row x col with in sector}BSR: array[RCB,RCB] of nums;      {# in box - row}BSC: array[RCB,RCB] of nums;      {# in box - Col}B: array[Rcb,digits] of integer;   { exact number of unassigned cells for # given in space}C: array[Rcb,digits] of integer;R: array[Rcb,digits] of integer;Sec:Array[sector,digits] of integer; {exact number of unassigned cells for # givens in a sector}Rd: array[RCB] of nums;Cd: array[RCB] of nums;Bd: array[RCB] of nums;linkset: array[digits,cell,sector,0..5] of numberset;   {digit by cell, sector, class type }{ Strong links0: bivavel,1:  2 cells in a sector2: cell in sector , grouped link to another = all digits in that sector3: cells in sector, as a grouped link to a single cell = all digits in that sector4: cells in sector, as a grouped link to a grouped node = all digits in that sector5: ERI }Wlinkset: array[digits,cell,sector,0..5,0..5] of numberset;   {digit by cell, sector, class type }{ Strong links0: bivavel,1:  2 cells in a sector2: cell in sector , grouped link to another = all digits in that sector3: cells in sector, as a grouped link to a single cell = all digits in that sector4: cells in sector, as a grouped link to a grouped node = all digits in that sector5: ERI }`
Last edited by StrmCkr on Wed May 30, 2018 6:13 am, edited 4 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Displaying txt fuctions

Txt Writing function: Show
Code: Select all
`procedure writexy(x,y:integer; s:string);begin  gotoxy(x,y);  write(s);end;`

Curser position in grid: Show
Code: Select all
`procedure Curser(A,c,d:integer);varxr,yr:integer;i:integer;begin if D = 1 then begin  Gotoxy(3,3); write(BXY[a]);  gotoxy(7,3); write(Rx[a]);  gotoxy(11,3); write(Cy[a]);  gotoxy(15,3); write(Rset[rx[a],cy[a]],' ');  Gotoxy(42,3); write(bsec[BXY[a]],' ',Rsec[Rx[a]],' ',Csec[Cy[a]],' ');  gotoxy(2,6); {displaying the pm grid}  for i:= 1 to 9 do   if (i in ((Rd[rx[a]] * Cd[cy[a]] * Bd[bxy[a]]) * Delpm[a] * covered[a] * pm[a] * ipm[a]) )   and  (s[a]=[])   and ( a in covered2[i])     then      write(I)     else      write(space);  end;  xr:=LEFT + (Cy[a]+1)*4 -2;  yr:=UP + (Rx[a]+1)*2 -1;  gotoxy(xr,yr);  textbackground(c);  if( S[a]=[] )  then     write( SPACE )  else     for i in (S[a]) do         write(i);  gotoxy(xr,yr);end;`

Moves the Curser in the pm box: Show
Code: Select all
`procedure curserpm(A,c:integer);varxr,yr,i:integer;begin  Gotoxy(3,3); write(BXY[a]);  gotoxy(7,3); write(Rx[a]);  gotoxy(11,3); write(Cy[a]);  gotoxy(15,3); write(Rset[rx[a],cy[a]],' ');  Gotoxy(42,3); write(bsec[BXY[a]],' ',Rsec[Rx[a]],' ',Csec[Cy[a]],' ');  gotoxy(2,6); {displaying the pm grid}  for i:= 1 to 9 do   if (i in ((Rd[rx[a]] * Cd[cy[a]] * Bd[bxy[a]]) * Delpm[a] * covered[a] * pm[a] * ipm[a]) )   and  (s[a]=[])   and ( a in covered2[i])     then      write(I)     else      write(space); xr:= (Cy[a]+1)*12 - 9; yr:= up+29 +(Rx[a]+1)*2 -2;  textbackground(c);  gotoxy(xr,yr);end;`

Write PM's to screen
Hidden Text: Show
Code: Select all
`procedure Wpm(R:integer);varA,Xw,Yw,i:integer;beginfor a:= 0 to 80 do begin  textcolor(col2);  if (S[a] <> []) or (R=1)   then     curser(a,colbg,0);  xw:= ( (Cy[a])+1) * 12 - 9 ;  yw:= up + 29 + ((Rx[a])+1)*2-2;  textcolor(5);  gotoxy(xw,yw); For I:= 1 to 9 do    if (I in  (Rd[rx[a]] * Cd[cy[a]] * Bd[bxy[a]] * delpm[a] * covered[a] * pm[a] * Ipm[a] ))   and (a in covered2[i])    then       write(I)      else       write(space); end;textcolor(col2);writexy(20,23,'   ');gotoxy(20,23);write(count);writexy(17,24,'   ');gotoxy(17,24);write(countpm);end;`

Write specific cells Pm's to grid
Hidden Text: Show
Code: Select all
`procedure Wpm2(h,R:integer);varA,Xw,Yw,i:integer;beginfor a:= h to h do begin  textcolor(col2);  if (S[a] <> []) or (R=1)   then     curser(a,colbg,0);  xw:= ( (Cy[a])+1) * 12 - 9 ;  yw:= up + 29 + ((Rx[a])+1)*2-2;  textcolor(5);  gotoxy(xw,yw); For I:= 1 to 9 do    if (I in  (Rd[rx[a]] * Cd[cy[a]] * Bd[bxy[a]] * delpm[a] * covered[a] * pm[a] * Ipm[a] ))   and (a in covered2[i])    then       write(I)      else       write(space); end;textcolor(col2);writexy(20,23,'   ');gotoxy(20,23);write(count);writexy(17,24,'   ');gotoxy(17,24);write(countpm);end;`

Writes Peer's of specific cell's Pm's to screen
Hidden Text: Show
Code: Select all
`procedure Wpm3(h,R:integer);varA,Xw,Yw,i:integer;beginfor a in (peer[h]+[h]) do begin  textcolor(col2);  if (S[a] <> []) or (R=1)   then     curser(a,colbg,0);  xw:= ( (Cy[a])+1) * 12 - 9 ;  yw:= up + 29 + ((Rx[a])+1)*2-2;  textcolor(5);  gotoxy(xw,yw); For I:= 1 to 9 do    if (I in  (Rd[rx[a]] * Cd[cy[a]] * Bd[bxy[a]] * delpm[a] * covered[a] * pm[a] * Ipm[a] ))   and (a in covered2[i])    then       write(I)      else       write(space); end;textcolor(col2);writexy(20,23,'   ');gotoxy(20,23);write(count);writexy(17,24,'   ');gotoxy(17,24);write(countpm);end;procedure techclear;varp,q:integer;beginfor q:=0 to 66 doFor p:=0 to 13 do begingotoxy(118+q,36+p);write(space);end;end;`

Technique Write out
Hidden Text: Show
Code: Select all
`procedure techdisplay(K:char;J:integer);varn,q,p:integer;beginfor q:=0 to 66 doFor p:=0 to 14 do begingotoxy(118+q,35+p);write(space);end;n:= 0;gotoxy(117,35);case k of#60,#64,#65, #66,#67,#68,#85:   begin       textcolor(10);         if ch = #60 then writexy(118,35,'Box Line Reduction');       if ch = #85 then writexy(118,35,'X - Wing {Basic | Franken | Mutant}');      if ch = #67 then writexy(118,35,'Sword Fish {Basic}');       if ch = #64 then writexy(118,35,'Skyscraper | Finned | Sashimi X - Wing');      if ch = #68 then writexy(118,35,'Jelly Fish {Basic}');      if ch = #66 then writexy(118,35,'2 - String Kyte');          if ch = #65 then writexy(118,35,'Empty Rectangle');          textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);          write('(');          textcolor(3);          for q in techwrite[n,11] do           write(q);           textcolor(white);           write('): Base: ');           textcolor(6);           for  p in techwrite[n,0] do             write(p,' ');            textcolor(white);             write('Cover: ');             textcolor(6);           for p in techwrite[n,10] do           write(p,' ');           textcolor(white);           gotoxy(118,38);            write(' =>> ');                   for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> '); textcolor(3);write(p);        textcolor(white);        end;           gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)          end;      end;   #84,#86,#87,#88: begintextcolor(10);    if ch = #84 then writexy(118,35,'Naked Single');    if ch = #86 then writexy(118,35,'Naked Pair');    if ch = #87 then writexy(118,35,'Naked Tripple');   if ch = #88 then writexy(118,35,'Naked Quad');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);        gotoxy(118,37);       Write('Set [ ');       textcolor(3);      for q in techwrite[n,10] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(9);       for q in techwrite[n,0] do        write(q,' ');      textcolor(white);          write(' =>> ');       for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> '); textcolor(3);write(p);        textcolor(white);        end;         gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#59,#61,#62,#63: begintextcolor(10);     if ch = #59 then writexy(118,35,'Hidden Single');     if ch = #61 then writexy(118,35,'Hidden Pair');    if ch = #62 then writexy(118,35,'Hidden Tripple');    if ch = #63 then writexy(118,35,'Hidden Quad');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);        gotoxy(118,37);       Write('Set [ ');       textcolor(9);      for q in techwrite[n,10] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(3);       for q in techwrite[n,0] do        write(q,' ');      textcolor(white);       write(' =>> ');       for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> '); textcolor(3);write(p);        textcolor(white);        end;         gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#97: begin      textcolor(10);       writexy(118,35,'ALS-XZ');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);        gotoxy(118,37);       Write('Set A) [ ');       textcolor(3);      for q in techwrite[n,0] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(9);       for q in techwrite[n,11] do        write(q,' ');      textcolor(white);         gotoxy(118,38);       Write('Set B) [ ');       textcolor(3);      for q in techwrite[n,10] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(9);       for q in techwrite[n,12] do        write(q,' ');      textcolor(white);        gotoxy(118,39);       Write('X: ');       for q in techwrite[n,13] do       textcolor(3);       write(q,' '); textcolor(white);       Write('Z: '); textcolor(3);       for q in techwrite[n,14] do       write(q,' ');textcolor(white);       write(' =>> ');       for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> '); textcolor(3);write(p);        textcolor(white);        end;         gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#104: begin      textcolor(10);       writexy(118,35,'AHS-XZ');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);        gotoxy(118,37);       Write('Set A) [ ');       textcolor(9);      for q in techwrite[n,11] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(3);       for q in techwrite[n,0] do        write(q,' ');      textcolor(white);         gotoxy(118,38);       Write('Set B) [ ');       textcolor(9);      for q in techwrite[n,12] do       write(q,' ');       textcolor(white);       write('] @ ');       textcolor(3);       for q in techwrite[n,10] do        write(q,' ');      textcolor(white);        gotoxy(118,39);       Write('X: ');       for q in techwrite[n,13] do       textcolor(9);       write(q,' '); textcolor(white);       Write('Z: '); textcolor(9);       for q in techwrite[n,14] do       write(q,' ');textcolor(white);       write(' =>> ');       for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> '); textcolor(3);write(p);        textcolor(white);        end;         gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#133: begin      textcolor(10);       writexy(118,35,'W - Wings & Rings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);if [0] * techwrite[n,17] <> []  then begin       write('(');  textcolor(3);  for p in techwrite[n,12] do write(p); textcolor(white); write(') - ');textcolor(9); for p in (techwrite[n,0]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,10]) do write(p); textcolor(white); write(' - (' );textcolor(3);  for p in techwrite[n,12] do write(p); textcolor(white); write(')');end;if [1] * techwrite[n,17] <> []  then begin       gotoxy(118,38);write('(');  textcolor(3);  for p in techwrite[n,12] do write(p); textcolor(white); write(') - ');textcolor(9); for p in (techwrite[n,0]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,16]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,10]) do write(p); textcolor(white); write(' - (' );textcolor(3);  for p in techwrite[n,11] do write(p); textcolor(white); write(')');end;if [2] * techwrite[n,17] <> [] then begingotoxy(118,37);write('(');  textcolor(3);  for p in techwrite[n,12] do write(p); textcolor(white); write(')- ');textcolor(9); for p in (techwrite[n,0]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write('=' );textcolor(3);  for p in techwrite[n,12] do write(p); textcolor(white); write(')- ');textcolor(9); for p in (techwrite[n,10]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white);end;write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#135: begin      textcolor(10);       writexy(118,35,'M - Wings & Rings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);write('(');  textcolor(3);  for p in techwrite[n,10] do write(p); textcolor(white); write(') - ');textcolor(9); for p in (techwrite[n,11]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,0]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,0]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,12]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('- (' );textcolor(3);  for p in techwrite[n,10] do write(p); textcolor(white); write(')');write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#134: begin      textcolor(10);       writexy(118,35,'Split - Wings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);textcolor(9); for p in (techwrite[n,12]) do write(p); textcolor(white); write(' =(' );textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')- ');textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- ');textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('= (' );textcolor(3);  for p in techwrite[n,11] do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#0138,#095: begin      textcolor(10);      if ch = #138 then writexy(118,35,'Local - Wings');      if ch = #095 then writexy(118,35,'Hybrid (Type 1) - Wing');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);textcolor(9); for p in (techwrite[n,12]) do write(p,' '); textcolor(white); write('=(' );textcolor(3); for p in (techwrite[n,15]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,13]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,14]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,11]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#136: begin      textcolor(10);       writexy(118,35,'Local (Type 2) - Wings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);textcolor(9); for p in (techwrite[n,0]) do write(p); textcolor(white); write(' =(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- ');textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white);write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ');textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#110: begin      textcolor(10);       writexy(118,35,'Hybrid (Type 2) - Wings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);      write('(' );textcolor(3); for p in (techwrite[n,15]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,0]) do write(p); textcolor(white); write(' -(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#137: begin      textcolor(10);       writexy(118,35,'Inverted W - Wings & Rings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);      textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('=(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white);write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white);write('=(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,16]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#78: begin      textcolor(10);       writexy(118,35,'Hybrid (Type 3) - Wings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);write('(' );textcolor(3); for p in (techwrite[n,13]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write('=' );textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white); write('-(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white);write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white);write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;#14: begin      textcolor(10);       writexy(118,35,'Hybrid (Type 4 & 5) - Wings');       textcolor(8);       if j = 0 then writexy(118,36,'Found : 0 ');       if j > 0        then         begin         repeat          textcolor(8);          writexy(118,36,'Displaying : ');          write(n+1,' Of ',J,'  ');          textcolor(white);          gotoxy(118,37);write('(' );textcolor(3); for p in ((techwrite[n,16] -(techwrite[n,11]+ techwrite[n,12])) ) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('=(');textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('-(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write('=');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' );textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white);write('=(');textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' );textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write('-(' );textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white);write(')');write(' =>> ');for p:= 1 to 9 do        if techwrite[n,p] <> [] then        begin        gotoxy(118,39+p);        textcolor(red);        for q in techwrite[n,p] do        write(q,' ');        textcolor(white);        write(' <> ');textcolor(3); write(p); textcolor(white);        end;                   gotoxy(118,49);           ch:=readkey;if (ch=#43) or (ch=#45 ) then techclear;           if ch=#43 then n:=n+1;           if ch=#45 then n:=n-1;           if (n) > j-1 then n:=0;           if (n) < 0 then n:=j-1;          until (ch =#13)              end;end;END;textcolor(col2);end;`

techdisplay screen
Hidden Text: Show
Code: Select all
`procedure displayTechnique;varn:integer;begintextcolor(6);writexy(142,33,'Technique Applied');textcolor(COL1);writexy(116, 34,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');for n:= 0 to 14 do begin writexy(116,(35+n),'º'); writexy(185,(35+n),'º'); end;writexy(116, 50,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼');end;`

viewgivens
Hidden Text: Show
Code: Select all
`procedure ViewGiven; { grid }begin  textcolor(13);  writexy(26,2,'Stormdoku');  textcolor(COL1);  writexy( LEFT, UP   ,  'ÉÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍ»' );  writexy( LEFT, UP+ 1,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+ 2,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+ 3,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+ 4,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+ 5,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+ 6,  'ÌÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍ¹' );  writexy( LEFT, UP+ 7,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+ 8,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+ 9,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+10,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+11,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+12,  'ÌÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍ¹' );  writexy( LEFT, UP+13,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+14,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+15,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+16,  'º---+---+---º---+---+---º---+---+---º' );  writexy( LEFT, UP+17,  'º   |   |   º   |   |   º   |   |   º' );  writexy( LEFT, UP+18,  'ÈÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍ¼' );  textcolor(13);  writexy(42,23,'Build 7');  writexy(42,24,'Vrs .69');  textcolor(COL1);end;`

View pM'S
Hidden Text: Show
Code: Select all
`procedure ViewPM; { pm grid }begintextcolor(27);writexy(50,31,'Pencil Mark');textcolor(19);writexy( 1 , up+28, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');writexy( 1 , up+29, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+30, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+31, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+32, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+33, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+34, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹');writexy( 1 , up+35, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+36, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+37, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+38, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+39, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+40, 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹');writexy( 1 , up+41, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+42, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+43, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+44, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º');writexy( 1 , up+45, 'º           |           |           º           |           |           º           |           |           º');writexy( 1 , up+46, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼');textcolor(col2);end;`

Hidden Text: Show
Code: Select all
`procedure Help; {info menu}begin  textcolor(lightred);  writexy(2, 2,'Box Row Col Cell');  writexy(42,2,'Sectors');  textcolor(67);  writexy(2,5,'choice');  textcolor(24);  writexy(12,23,'Givens:');  writexy(12,24,'PMs:');  textcolor(green);  writexy(26,23,'ESC : Exit');  textcolor(67);  writexy(58,3,'Keystroke');  textcolor(24);  writexy(51,4,'Movement:');  textcolor(green);  writexy(50,5,'Arrows    - Direction');  writexy(50,6,'Home      - Goto Col 1 on Row');  writexy(50,7,'End       - Goto Col 9 on Row');  writexy(50,8,'Page up   - Goto Row 1 on Col');  writexy(50,9,'Page down - Goto Row 9 on Col');  writexy(50,10,'Backspace - Delete # in cell');  writexy(50,11,'Delete    - Delete # in cell');  Writexy(50,12,'Tab       - Switch PM | Grid');  writexy(50,13,'1 - 9     - Enter # into cell');  textcolor(24);  writexy(51,15,'Functions:');  textcolor(green);  writexy(50,16,'`         - Solve');  writexy(50,17,'~         - Batch solve');  writexy(50,18,'R         - Reset Grid');  writexy(50,19,'E         - Empty Pm Grid');  writexy(50,20,'Shift + S - Save Grid String');  writexy(50,21,'S         - Save Pm state');  writexy(50,22,'Shift + L - Load Saved Grid');  writexy(50,23,'L         - Load Saved Pm');  writexy(50,24,'I         - Import a Grid');  writexy(50,25,'C         - Isomorphic');  writexy(50,26,'P         - P.O.M');  writexy(50,27,'Shift + G - Generate'); // writexy(50,28,'CRTl  + F - Brute Force'); // writexy(50,29,'Shift  + F - Dancing Links');   textcolor(24);  writexy(85,1,'Starter Techniques:');  textcolor(green);  writexy(81,2,'F1          - Hidden Single');  writexy(81,3,'Shift + F1  - Naked Single');  writexy(81,4,'F3          - Hidden Pair');  writexy(81,5,'Shift + F3  - Naked Pair');  writexy(81,6,'F4          - Hidden Triple');  writexy(81,7,'SHift + F4  - Naked Triple');  writexy(81,8,'F5          - Hidden Quad');  writexy(81,9,'Shift + F5  - Naked Quad');  textcolor(24);  writexy(85,11,'Fish Techniques:');  textcolor(green);  writexy(81,12,'F2          - Box Line Reduction');  writexy(81,13,'Shift + F2  - X - Wing');  writexy(81,14,'F6          - Skyscraper');  writexy(81,15,'F7          - Empty Rectangle');  Writexy(81,16,'F8          - 2-String Kyte');  writexy(81,17,'F9          - Sword Fish');  writexy(81,18,'F10         - Jelly Fish');  writexy(81,19,'Shift + F9  - Finned/Sashimi Sword');  writexy(81,20,'Shift + F10 - Finned/Sashimi Jelly');   //writexy(81,30,'T          - N x N Fish');  textcolor(24);  writexy(85,23,'Bent Subset Techniques:');  textcolor(green);  writexy(81,24,'Shift + F6  - XY - Wing');  writexy(81,25,'Shift + F7  - XYZ - Wing');  writexy(81,26,'Shift + F8  - WXYZ - Wing');  writexy(81,28,'B           - Barns');  textcolor(24);  writexy(120,18,'Subset Techniques:');  textcolor(green);  writexy(116,19, 'D          - Sue De Coq');  writexy(116,20, 'J          - D.D.S');  writexy(116,21, 'O          - A.D.D.S');  textcolor(24);  writexy(160,18,'Cover Set Techniques:');  textcolor(green);  writexy(156,19,'F          - N x ( N + K ) Fish');  writexy(156,20,'M          - Muti Sector Locked Set');  textcolor(24);  writexy(120,1,'Named Chain Techniques:');  textcolor(green);  writexy(116,2, 'F11         - W - Wing & Ring');  writexy(116,3, 'Shift + 11  - M - Wing & Ring');  writexy(116,4, 'F12         - S - Wing');  writexy(116,5, 'CRTL  + F12 - L - Wing');  writexy(116,6, 'Shfit + F12 - L2 - Wing');  writexy(116,7, 'CRTL  + F2  - H 1 - Wing');  writexy(116,8, 'N           - H 2 - Wing');  writexy(116,9, 'Shift + N   - H 3 - Wing');  writexy(116,10,'CRTL + N    - H 4 & 5 - Wing');  writexy(116,11,'CRTL + F11  - iW - Wing & Ring');  textcolor(24);  writexy(160,1,'Chain Techniques:');  textcolor(green);  writexy(156,2, 'X           - XY - Chain');  writexy(156,3, 'Shift + X   - A.I.C ');  textcolor(24);  writexy(120,13,'Almost locked Sets Techniques:');  textcolor(green);  writexy(116,14,'A           - ALS - XZ rule');  writexy(116,15,'H           - AHS - XZ rule');  writexy(116,16,'Y           - ALS - XY rule');  textcolor(24);  writexy(120,23,'Transport  Techniques:');  textcolor(green);  writexy(116,24,'Z           - T - XY - Wing');  writexy(116,25,'U           - T - XYZ - Wing');  writexy(116,26,'Q           - T - WXYZ - Wing');  writexy(116,27,'T           - T - Barns');  writexy(116,28,'W           - T - XY-Chain');  writexy(116,29,'G           - T - ALS-XZ');  writexy(116,30,'K           - T - ALS-XY');  writexy(116,31,'V           - T - A.D.D.S');  writexy(50,52,' PM keystroke ');  textcolor(24);  writexy(39,53,'Movment:');  textcolor(green);  writexy(39,54,'Arrows    - Direction');  writexy(39,55,'Home      - Goto Col 1 on Row');  writexy(39,56,'End       - Goto Col 9 on Row');  writexy(39,57,'Page up   - Goto Row 1 on Col');  writexy(39,58,'Page down - Goto Row 9 on Col');  writexy(39,59,'Backspace - Resets PM #s in cell');  writexy(39,60,'Delete    - Resets PM #s in cell');  writexy(39,61,'1 - 9     - Delete # from cell');  writexy(142,52,' Technique Trace ');  textcolor(24);  writexy(130,53,'Movment:');  textcolor(green);  writexy(130,54,'+          - Next in list');  writexy(130,55,'-          - Previous in List');  writexy(130,56,'Enter      - Exit List');  writexy(130,57,'Colour     =');  textcolor(3); write(' Digit,');  textcolor(6); write(' Sector,');  textcolor(9); write(' Cell,');  textcolor(red); write(' Exclusion Cell ');  textcolor(darkgray);  writexy(78,52,'Copyright © Strmckr 2009 ->> 2018');  writexy(73,54,'This program is free software: you can ');  writexy(73,55,'redistribute it and/or modify it under the');  writexy(73,56,'terms of the GNU general public License');  writexy(73,58,'This program is distributed without any ');  writexy(73,59,'warrenty; without even the implied warranty');  writexy(73,60,'of Merchantability or fitness for a ');  writexy(73,61,'particular purpose. See the GNU general');  writexy(73,62,'public license for more details.  ');  writexy(73,64,'< http://www.gnu.org/licenses/gpl-3.0.html > ');  textcolor(col2);end;`
Last edited by StrmCkr on Wed May 30, 2018 6:48 am, edited 11 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

sets all basic data storage areas to zero/filled.
Hidden Text: Show
Code: Select all
`{resets the starting variables to zero or filled}procedure initiate;varxn,n:integer;begin for xn:= 0 to 8 do  begin   Rd[xn]:= [1..9];   Cd[xn]:= [1..9];   Bd[xn]:= [1..9];   covered2[xn+1]:=[0..80];    for n:= 1 to 9 do      begin       S[rset[xn,(n-1)]]:= [];       delpm[rset[xn,(n-1)]]:= [1..9];       covered[rset[xn,(n-1)]]:= [1..9];       Ipm[rset[xn,(n-1)]]:= [1..9];      end;   end;end;`

Fill data tables using the loaded grid
Hidden Text: Show
Code: Select all
`{activates loaded puzzle}procedure setpm;varxn,n:integer;beginfor n:= 1 to 9 do   for xn:= 0 to 80 do     if N in (s[xn])      then        begin         exclude(Rd[Rx[xn]],n);         exclude(Cd[Cy[xn]],n);         exclude(Bd[bxy[xn]],n);        end;end;`

Set's the pm's for a non zero state
Hidden Text: Show
Code: Select all
`procedure setpm2;varxn,n:integer;beginfor xn:= 0 to 8 doRd[xn]:= [1..9];Cd[xn]:= [1..9];Bd[xn]:= [1..9];For n:= 1 to 9 do   for xn:= 0 to 80 do    if n in s[xn]     then        begin         exclude(Rd[Rx[xn]],n);         exclude(Cd[Cy[xn]],n);         exclude(Bd[bxy[xn]],n);        end;end;`

Erase all pm's
Hidden Text: Show
Code: Select all
`procedure emptypm;varxn,n:integer;begin for xn:= 0 to 8 do  begin    for n:= 1 to 9 do      begin       Ipm[rset[xn,(n-1)]]:= [];      end;   end;end;`

Set grid string as loaded puzzle
Hidden Text: Show
Code: Select all
`{place imported 81 char string onto Grid}procedure Arange;varxa,N:integer;dig:string;dig3,dig2: integer;beginN:=0; for xa:=0 to 80 do   begin    inc(n);    dig:=grid[n];    val(dig,dig3,dig2);    if dig3 <>0      then      S[xa]:=[dig3];        end;  setpm;  sbrc;end; `

import a grid string
Hidden Text: Show
Code: Select all
`{loads a grid from a txt file}procedure import;varmyfile:text;ior:integer;filename:string;verifygrid:integer;Begininitiate;repeat      repeat      writexy(2,26,'                                       ');      writexy(2,26, 'file path ');       readln(filename);           if (filename = ('')) or (filename = ('exit'))            then exit           else        writexy(2,27,'                                       ');        writexy(2,28,'                                       ');        assign(myfile,filename);        ior:= 0;        {\$I-}        reset(myfile);        {\$I+}        IOR:=ioresult;      if Ior <> 0      then      writexy(2,27,'file not found')      else       begin        textcolor(yellow );        writexy(2,15,'Import');        delay(300);        writexy(2,15,'       ');        textcolor(col2);       end;      until IoR = 0;      read(myfile,grid);      close(myfile);Verifygrid:= length(Grid);if( verifygrid <> 81) then   writexy(2,28,'incorrect string size => <> 81 ');until verifygrid=81;if verifygrid=81  then   begin   Arange;   wpm(1);   end;end;`

save grid to data_file
Hidden Text: Show
Code: Select all
`{save current grid }procedure save;varf: file of nums;xs:integer;begin assign(F,Dat_file); rewrite(f); for xs:=0 to 80 do   write(f,S[xs]); close(f);end;`

Hidden Text: Show
Code: Select all
`{load from save}procedure load;varF:file of nums;XL:integer;begininitiate;{\$I-} assign(f,Dat_file); reset(f);{\$I+}if Ioresult=0 then begin   for xL:=0 to 80 do    begin      read (f, S[xl]);     end;     close(f); end;setpm;sbrc;wpm(1);end;`

save pm state to file
Hidden Text: Show
Code: Select all
`{save current pm and grid state}procedure savepm;varf: file of nums;xs:integer;beginassign(F,dat_file2);rewrite(f);for xs:= 0 to 80 do  if  s[xs] = []   then    write(F,pm[xs])   else    write(F,s[xs]);close(f);end;`

Hidden Text: Show
Code: Select all
`{load from gird and pm save}procedure loadpm;varF:file of nums;XL:integer;begininitiate;{\$I-} assign(f,Dat_file2); reset(f);{\$I+}if Ioresult=0 then begin   for xL:=0 to 80 do    begin      read (f, Ipm[xl]);      if popcnt(dword(Ipm[xl])) = 1       then           S[xl]:= Ipm[xl];     end;     close(f); end;end;`

Sets all subset data spaces used by solver
Hidden Text: Show
Code: Select all
`procedure SBRC;varxn,n:integer;begincountpm:=0;count:=0;FOR XN:= 0 to 8 do for n:= 1 to 9 do begin nsector[xn]:= []; nsector[xn+9]:= []; nsector[xn+18]:= []; ssector[xn]:= []; ssector[xn+9]:= []; ssector[xn+18]:= []; digitcell[n]:=[];  r[xn,n]:=0;  b[xn,n]:=0;  c[xn,n]:=0;  sec[xn,n]:=0;  sec[xn+9,n]:=0;  sec[xn+18,n]:=0;  Rn[xn,n]:=[];  Cn[xn,n]:=[];  Bn[xn,n]:=[];  RnSector[xn,n]:=[];  RnSector[xn+9,n]:=[];  RnSector[xn+18,n]:=[];  BnR[xn,n]:=[];  BnC[xn,n]:=[]; RnB[xn,n]:=[]; CnB[xn,n]:=[];  RC[xn,(n-1)]:=[];  BS[xn,(n-1)]:=[];  SectorRC[xn,(n-1)]:=[];  SectorRC[xn+9,(n-1)]:=[];  SectorRC[xn+18,(n-1)]:=[];  BSC[xn,(n-1)]:=[];  BSR[xn,(n-1)]:=[];  digitRCb[n,xn]:=[];   digitRCb[n,xn+9]:=[];    digitRCb[n,xn+18]:=[];  nm[rset[xn,(n-1)]]:=0;  PM[rset[xn,(n-1)]]:=[];  end;for xn:= 0 to 80 do begin  if s[xn] = []   then    begin     for n:= 1 to 9 do      if (N in (Rd[rx[xn]] * Cd[cy[xn]] * Bd[bxy[xn]] * delpm[xn] * covered[xn] * IPM[xn]) )       and (xn in covered2[n])       then        begin         inc(R[rx[xn],n]);         inc(C[Cy[xn],n]);         inc(B[Bxy[xn],n]);         inc(sec[rx[xn],n]);         inc(sec[cy[xn]+9,n]);         inc(sec[bxy[xn]+18,n]);         include(Rn[Rx[xn],n],Cy[xn]);         include(Cn[Cy[xn],n],Rx[xn]);         include(Bn[Bxy[xn],n],Bxyn[xn]);         include(RnSector[Rx[xn],n],Cy[xn]);         include(RnSector[Cy[xn]+9,n],Rx[xn]);         include(RnSector[Bxy[xn]+18,n],Bxyn[xn]);         include(BnR[Bxy[xn],n],Rx[xn]);         include(BnC[Bxy[xn],n],Cy[xn]);             include(RnB[Rx[xn],n],Bxy[xn]);       include(CnB[Cy[xn],n],Bxy[xn]);         include(RC[Rx[xn],Cy[xn]],n);         include(BS[Bxy[xn],Bxyn[xn]],n);         include(SectorRC[Rx[xn],Cy[xn]],n);         include(sectorRC[Cy[xn]+9,Rx[xn]],n);         include(SectorRC[Bxy[xn]+18,Bxyn[xn]],n);         include(BSC[Bxy[xn],Cy[xn]],n);         include(BSR[Bxy[xn],Rx[xn]],n);         include(DigitRCB[n,Rx[xn]],xn);         include(DigitRCB[n,Cy[xn]+9],xn);         include(DigitRCB[n,bxy[xn]+18],xn);         include(PM[xn],n);         include(nsector[Rx[xn]],n);         include(nsector[Cy[xn]+9],n);         include(nsector[Bxy[xn]+18],n);             include(digitcell[n],xn);         inc(nm[xn]);         inc(countpm);        end;     end     else        begin        inc(count);      sSector[rx[xn]]:= sSector[rx[xn]] +s[xn];      sSector[cy[xn]+9]:= sSector[cy[xn]+9] +s[xn];      sSector[bxy[xn]+18]:= sSector[bxy[xn]+18] +s[xn];        end;   end;  cellcombo;  links;  wLinks;end;`

Hidden Text: Show
Code: Select all
`procedure links;varn,xn,xn2,yn,g,h:integer;beginfor n:= 1 to 9 do for xn:= 0 to 80 do  for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do  for yn:= 0 to 5 do    linkset[n,xn,xn2,yn]:=[]; for n:= 1 to 9 do  for xn:= 0 to 80 do   {if (pm[xn] * [n] <> []) then}    for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do     if xn in DigitRCB[n,xn2]       then  begin   {bi vavle}  If (nm[xn] = 2)   then     linkset[n,xn,xn2,0]:=linkset[n,xn,xn2,0] + (pm[xn] - [n]);  {bi local}   if ( sec[xn2,n] = 2)   then    linkset[n,xn,xn2,1]:=linkset[n,xn,xn2,1] + (DigitRCB[n,xn2] - [xn]);     { single + grouped}       if  (sec[xn2,n] < 5)  AND (sec[XN2,N] > 2 )     then      for h in peerRCB[xn2] do       if ( [xn] + (DigitRCB[n,xn2] * DigitRCB[n,h]) = DigitRCB[n,xn2] )  and ( [xn] * (DigitRCB[n,xn2] * DigitRCB[n,h] ) = [])        then         begin          linkset[n,xn,xn2,2]:=linkset[n,xn,xn2,2] + (DigitRCB[n,xn2] - [xn]);            {grouped + single}           for G in (DigitRCB[n,xn2] - [xn]) do            linkset[n,g,xn2,3]:=linkset[n,g,xn2,3] + [xn];          end;      {Grouped + grouped}    if  (Sec[xn2,n] > 4)  AND (Sec[XN2,N] < 7 )     then      for h in peerRCB[xn2]  do       begin       if  {(h in [18..26]) and} ( (DigitRCB[n,Bxy[xn]+18]  * DigitRCB[n,xn2]) + (DigitRCB[n,xn2] * DigitRCB[n,h]) = DigitRCB[n,xn2] )        then          linkset[n,xn,xn2,4]:=linkset[n,xn,xn2,4] + ((DigitRCB[n,h] * DigitRCB[n,xn2]) - (DigitRCB[n,Bxy[xn]+18]  * DigitRCB[n,xn2])) ;       if  {(H in [0..8] ) and }( (DigitRCB[n,Rx[xn]]  * DigitRCB[n,xn2]) + (DigitRCB[n,xn2] * DigitRCB[n,h]) = DigitRCB[n,xn2] )        then          linkset[n,xn,xn2,4]:=linkset[n,xn,xn2,4] + ((DigitRCB[n,h] * DigitRCB[n,xn2]) - (DigitRCB[n,Rx[xn]]  * DigitRCB[n,xn2])) ;       if {(H in [9..17] )and }( (DigitRCB[n,Cy[xn]+9]  * DigitRCB[n,xn2]) + (DigitRCB[n,xn2] * DigitRCB[n,h]) = DigitRCB[n,xn2] )        then          linkset[n,xn,xn2,4]:=linkset[n,xn,xn2,4] + ((DigitRCB[n,h] * DigitRCB[n,xn2]) - (DigitRCB[n,Cy[xn]+9]  * DigitRCB[n,xn2])) ;       end;  end;{ writexy(2,60,'link list'); writeln; for n:= 1 to 9 do  for xn:= 0 to 80 do     for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do   for yn:= 0 to 4 do    if linkset[n,xn,xn2,yn] <> []     then     begin     gotoxy(2,61);      write( 'n: ',n,' xn: ',xn,' xn2: ',xn2,' yn: ',yn,' G: ');      for  g in linkset[n,xn,xn2,yn]  do       write(g,' ');       //delay(1500);       writeln;      end;  }end;`

Hidden Text: Show
Code: Select all
`procedure Wlinks;varn,xn,xn2,yn,yn2,g,h:integer;beginfor n:= 1 to 9 do for xn:= 0 to 80 do  for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do  for yn:= 0 to 5 do   for yn2:=0 to 5 do    wlinkset[n,xn,xn2,yn,yn2]:=[];   for n:= 1 to 9 do    for xn:= 0 to 80 do     for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do      for G in peer[xn] do        for h in  ([Rx[g]] + [(Cy[g]+9)] + [(Bxy[g]+18)]) do      begin        if (linkset[n,xn,xn2,0] <> [] )          and  (linkset[n,g,h,0] <> [])                then                 wlinkset[n,xn,xn2,0,0]:= wlinkset[n,xn,xn2,0,0] + [g];       for yn:=  1 to 4 do        for yn2:= 1 to 4 do          if (linkset[n,xn,xn2,yn] <> [])           and (linkset[n,g,h,yn2] <> [])            and  ( (linkset[n,g,h,yn2] + [g] )   * (linkset[n,xn,xn2,yn] + [xn] )  = [])            and( (Peer[xn] * DigitRCB[n,h]) = (DigitRCB[n,h] - linkset[n,g,h,yn2]) )            and( (peer[g] * DigitRCB[n,xn2] ) = (DigitRCB[n,xn2] - linkset[n,xn,xn2,yn] ))             then              begin                wlinkset[n,xn,xn2,yn,yn2]:=wlinkset[n,xn,xn2,yn,yn2] + [g];                wlinkset[n,g,h,yn2,yn]:=wlinkset[n,g,h,yn2,yn] + [xn];              end;       for yn:= 1 to 4 do        if (linkset[n,xn,xn2,0] <> [])        and (linkset[n,g,h,yn] <> [] )        and (linkset[n,g,h,yn] * [xn] <> [xn])         and (Peer[xn] * (DigitRCB[n,h]) <>  DigitRCB[n,h])          then           begin            wlinkset[n,xn,xn2,0,yn]:=wlinkset[n,xn,xn2,0,yn] + [g];            wlinkset[n,g,h,yn,0]:=wlinkset[n,g,h,yn,0] + [xn];           end;       end;{ writexy(2,62,'weak link list'); writeln; for n:= 1 to 9 do  for xn:= 0 to 80 do     for xn2 in ([Rx[xn]] + [(Cy[xn]+9)] + [(Bxy[xn]+18)]) do   for yn:= 0 to 5 do    for yn2:=0 to 5 do    if wlinkset[n,xn,xn2,yn,yn2] <> []     then     begin     gotoxy(2,63);      write( 'n: ',n,' xn: ',xn,' xn2: ',xn2,' yn: ',yn,' yn2: ',yn2,' G: ');      for  g in wlinkset[n,xn,xn2,yn,yn2]  do       write(g,' ');       //delay(1500);       writeln;      end; }end;`

Checks the grid for erroneous states
Hidden Text: Show
Code: Select all
`procedure errorcheck;varXN,N,YN,count,s,f:INTEGER;count2:RCBnums;BeginUNIQUE:= TRUE;  {redundant checks as they are found below}{FOR XN:= 0 TO 80 Do BEGIN //no cell and pm can be empty IF (s[XN] = [])  AND (nm[XN] =0 )  THEN    UNiQUE:= FALSE; //no peer cell of xn, can have the same solved digit FOR N IN S[XN] Do FOR YN IN PEER[XN] DO   IF N IN S[YN]     THEN       UNIQUE:= FALSE;END;  }For xn:= 0 to 26 dobeginif (nsector[xn] <>  [1..9]-ssector[xn] )  { and (nsector[xn] <> [])} {shows mutiple digits pms are missing in full} then  unique:=false;if (Nsector[xn] <> []) and (nsector[xn] = [1..9] - ssector[xn]) then begin Count:= 0; count2:=[];{no sector can have less digits then unsolved cellsno sector can have more digits then unsolved cells}   for n in Nsector[xn] do     begin      inc(count);      count2:= Rnsector[xn,n] + count2;      end;     if popcnt(dword((count2))) <> count      then      unique:= false; if (count > 2)  thencase (count) of3: begin s:=9; F:= 128; end;4: begin s:=9; F:= 254; end;5: begin s:=9; F:= 380; end;6: begin s:=9; F:= 464; end;7: begin s:=9; F:= 500; end;8: begin s:=9; F:= 509; end;9: begin s:=9; F:= 510; end;end; {case count}     { no subset can have less cells then the subset digit count}if  (count > 2)   thenfor yn:= s to f do  if comboset[yn] * Nsector[xn] = comboset[yn]    then    begin     Count:= 0;      count2:=[];   for n in Nsector[xn] * comboset[yn] do     begin      inc(count);      count2:= Rnsector[xn,n] + count2;      end;     if popcnt(dword((count2))) < count      then        unique:= false;    end; end;end;END;`

Sets up a list of Digit combinations in specific cells.
Hidden Text: Show
Code: Select all
`procedure Cellcombo;      { builds a list of active cells for specific comboset}varxn,n,j:integer;begin   for xn:= 0 to 510 do  begin   combocell[xn]:=[];   Combosubset[xn]:=[];  for n in [0..80] do   begin     if (pm[n] * comboset[xn] = pm[n]  )      and (pm[n] - comboset[xn] = [])      and (pm[n] <> [])       then        include(combocell[xn],n);     if (pm[n] * Comboset[xn] <> [] )     and( pm[n] <> [])      then       include(combosubset[xn],n);      end;     end;end;`
Last edited by StrmCkr on Wed May 30, 2018 7:08 am, edited 5 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Peer building functions

Combination set
Hidden Text: Show
Code: Select all
`{combination sets}function next_combination (var v : array of integer; n, k : integer) : boolean;var i, j : integer;begin   if (v[0] = (n - k)) or (k = 0) then   begin      next_combination := false;      exit   end;   i := k - 1;   while (i > 0) and (v[i] = n - k + i) do i := i - 1;   v[i] := v[i] + 1;   j := i;    while (j < k - 1) do       begin         v[j+1] := v[j] + 1;         inc(j);       end;   next_combination := true;end;`

Combo
Hidden Text: Show
Code: Select all
`procedure combo;varvx : array [0..8] of integer;   n,l,m,count : integer;begincount:=0;For m:= 1 to 9 do begin  for n := 0 to 8 do   begin     vx[n] := n;   end;  repeat   begin    for l:= 0 to (m-1)  do     begin      comboset[count]:=comboset[count] + [ (vx[l]+1) ];      comboset2[count]:=comboset2[count] + [ (vx[l]) ];     end;     inc(count);    end;   until (next_combination (vx,9,m) = false);  end;end;`

peers
Hidden Text: Show
Code: Select all
`procedure peers;varxa,xa2,z:integer;number1:numberset;beginfor xa:= 0 to 80 do  begin     number1:=[];     z:=0;      For xa2:= 0 to 80 do       IF (XA <> XA2)        then         if   ((Rx[xa])  in [  Rx[xa2] ] )          or  ((Cy[xa])  in [  Cy[xa2] ] )          or  ((Bxy[xa]) in [ Bxy[xa2] ] )            then             begin              include(number1,xa2);              peer2[xa,z]:=xa2;              inc(z);             end;       peer[xa]:=number1; end;end;`

Sector Row/Col/Box lookup
Hidden Text: Show
Code: Select all
`procedure lookupSectorRBC;varxn,n:integer;a: numberset;beginfor xn:= 0 to 26 do begin nsector[xn]:= [1..9];   for n:= 0 to 8 do    begin      a:=[];       if xn in [0..8]        then         a:=a+ [Rset[xn,n]];       if xn in [9..17]        then         a:=a+ [Cset[xn-9,n]];       if xn in [18..26]        then         a:=a+ [Bset[xn-18,n]];     SectorRCB[xn,n]:=A;   end;  end;end;`
Last edited by StrmCkr on Wed May 30, 2018 7:02 am, edited 2 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Solving Techniques

Hidden Singles
Hidden Text: Show
Code: Select all
`{finds hidden singles}procedure Hs(K:integer);varxn,yn,n:integer;begin  for xn:= 0 to 8 do    for n:= 1 to 9 do      begin      if R[xn,n] = 1       then        For yn:= 0 to 8 do          if Rn[xn,n] = [yn]           then             begin              active:=true;                S[Rset[xn,yn]]:=[n];                exclude(Rd[xn],n);                exclude(Cd[yn],n);                exclude(Bd[bxy[rset[xn,yn]]],n);             end;      if C[xn,n] = 1       then        For yn:= 0 to 8 do          if Cn[xn,n] = [yn]           then             begin              active:=true;                S[Cset[xn,yn]]:=[n];                exclude(Rd[yn],n);                exclude(Cd[xn],n);                exclude(Bd[bxy[rset[yn,xn]]],n);             end;      if B[xn,n] = 1       then        For yn:= 0 to 8 do         if Bn[xn,n] = [yn]           then             begin              active:=true;                S[Bset[xn,yn]]:=[n];                exclude(Rd[Rx[bset[xn,yn]]],n);                exclude(Cd[cy[bset[xn,yn]]],n);                exclude(bd[xn],n);             end;       end;end;  {hidden singles}`

Hidden Pairs
Hidden Text: Show
Code: Select all
`{hidden pairs}procedure HP(k:integer);varxn,yn,n,n2,z:integer;beginFor xn:= 0 to 8 do   For n:= 1 to 8 do    for n2:= (n+1) to 9 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 3 )           and (R[xn,n2] > 0) and (R[xn,n2] < 3 )            then              for yn:= 9 to 44 do                if Rn[xn,n] + Rn[xn,n2] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[rset[xn,z]]:= covered[rset[xn,z]] * [n,n2] * pm[rset[xn,z]];                  end;           If  (C[xn,n] > 0) and (C[xn,n] < 3 )           and (C[xn,n2] > 0) and (C[xn,n2] < 3 )            then              for yn:= 9 to 44 do                if Cn[xn,n] + Cn[xn,n2] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] * [n,n2] * pm[Cset[xn,z]];                  end;           If  (b[xn,n] > 0) and (b[xn,n] < 3 )           and (b[xn,n2] > 0) and (b[xn,n2] < 3 )            then              for yn:= 9 to 44 do                if bn[xn,n] + bn[xn,n2] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[bset[xn,z]]:= covered[bset[xn,z]] * [n,n2] * pm[bset[xn,z]];                  end;        end;end;{hidden pair}`

Hidden Triple
Hidden Text: Show
Code: Select all
`{hidden triples}procedure HT(k:integer);varxn,yn,n,n2,n3,z:integer;beginFor xn:= 0 to 8 do   For n:= 1 to 7 do    for n2:= (n+1) to 8 do     for n3:= (n2+1) to 9 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 4 )           and (R[xn,n2] > 0) and (R[xn,n2] < 4 )           and (R[xn,n3] > 0) and (R[xn,n3] < 4 )            then              for yn:= 45 to 128 do                if Rn[xn,n] + Rn[xn,n2] + Rn[xn,n3] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[rset[xn,z]]:= covered[rset[xn,z]] * [n,n2,n3] * pm[rset[xn,z]];                  end;           If  (C[xn,n] > 0) and (C[xn,n] < 4 )           and (C[xn,n2] > 0) and (C[xn,n2] < 4 )            and (C[xn,n3] > 0) and (C[xn,n3] < 4 )            then              for yn:= 45 to 128 do                if Cn[xn,n] + Cn[xn,n2] + Cn[xn,n3] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] * [n,n2,n3] * pm[Cset[xn,z]];                  end;           If  (b[xn,n] > 0) and (b[xn,n] < 4 )           and (b[xn,n2] > 0) and (b[xn,n2] < 4 )           and (b[xn,n3] > 0) and (b[xn,n3] < 4 )            then              for yn:= 45 to 128 do                if bn[xn,n] + bn[xn,n2] + bn[xn,n3] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[bset[xn,z]]:= covered[bset[xn,z]] * [n,n2,n3] * pm[bset[xn,z]];                  end;        end;end;{hidden triple}`

Hidden Text: Show
Code: Select all
`{hidden Quad}procedure HQ(k:integer);varxn,yn,n,n2,n3,n4,z:integer;BeginFor xn:= 0 to 8 do   For n:= 1 to 6 do    for n2:= (n+1) to 7 do     for n3:= (n2+1) to 8 do      for n4:= (n3+1) to 9 do       begin         If    (R[xn,n] > 0) and (R[xn,n] < 5 )           and (R[xn,n2] > 0) and (R[xn,n2] < 5 )           and (R[xn,n3] > 0) and (R[xn,n3] < 5 )           and (R[xn,n4] > 0) and (R[xn,n4] < 5 )            then              for yn:= 129 to 254 do                if Rn[xn,n] + Rn[xn,n2] + Rn[xn,n3] + Rn[xn,n4] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[rset[xn,z]]:= covered[rset[xn,z]] * [n,n2,n3,n4] * pm[rset[xn,z]];                  end;           If  (C[xn,n] > 0) and (C[xn,n] < 5 )            and (C[xn,n2] > 0) and (C[xn,n2] < 5 )            and (C[xn,n3] > 0) and (C[xn,n3] < 5 )            and (C[xn,n4] > 0) and (C[xn,n4] < 5 )             then              for yn:= 129 to 254 do                if Cn[xn,n] + Cn[xn,n2] + Cn[xn,n3] + CN[xn,n4] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] * [n,n2,n3,n4] * pm[Cset[xn,z]];                  end;           If  (b[xn,n] > 0) and (b[xn,n] < 5 )           and (b[xn,n2] > 0) and (b[xn,n2] < 5 )           and (b[xn,n3] > 0) and (b[xn,n3] < 5 )           and (b[xn,n4] > 0) and (b[xn,n4] < 5 )            then              for yn:= 129 to 254 do                if bn[xn,n] * bn[xn,n2] * bn[xn,n3] * bn[xn,n4] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if z in comboset2[yn]                        then                           covered[bset[xn,z]]:= covered[bset[xn,z]] * [n,n2,n3,n4] * pm[bset[xn,z]];                  end;        end;end;{hidden Quad}`

Naked Single
Hidden Text: Show
Code: Select all
`{naked singles}procedure NS(K:integer);varxn,n:integer;begin For xn:= 0 to 80 do   if nm[xn]=1    then      begin       active:=true;         s[xn]:=PM[xn];         Rd[Rx[xn]]:= Rd[rx[xn]] - s[xn];         Cd[Cy[xn]]:= Cd[cy[xn]] - s[xn];         Bd[Bxy[xn]]:= Bd[bxy[xn]] - s[xn];      end;end; {naked singles}`

Naked Pair
Hidden Text: Show
Code: Select all
`{Naked pairs}procedure NP(k:integer);varxn,yn,n,n2,z:integer;beginFor xn:= 0 to 8 do  For n:= 0 to 7 do    for n2:= (n+1) to 8 do        begin           if(RC[xn,n] <> []) and (RC[xn,n2] <> [])           and (nm[rset[xn,n]] <3) and (nm[rset[xn,n2]] <3)            then             for yn:= 9 to 44 do              if ( RC[xn,n] + RC[xn,n2] = comboset[yn])               then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2] )                        then                           covered[rset[xn,z]]:= covered[rset[xn,z]] - comboset[yn];                  end;           if (RC[n,xn] <> []) and (RC[n2,xn] <> [])           and (nm[rset[n,xn]] < 3 ) and (nm[rset[n2,xn]] <3)            then             for yn:= 9 to 44 do              if (RC[n,xn] + RC[n2,xn] = comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2] )                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] - comboset[yn];                  end;           if (Bs[xn,n] <> []) and (BS[xn,n2] <> [])           and (nm[bset[xn,n]] < 3) and (nm[bset[xn,n2]] <3)            then             for yn:= 9 to 44 do              if (BS[xn,n] + Bs[xn,n2] = comboset[yn] )               then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2] )                        then                           covered[Bset[xn,z]]:= covered[Bset[xn,z]] - comboset[yn];                  end;        end;end;{naked pair}`

Naked Triple
Hidden Text: Show
Code: Select all
`{Naked Triple}procedure NT(k:integer);varxn,yn,n,n2,n3,z:integer;beginFor xn:= 0 to 8 do  For n:= 0 to 6 do    for n2:= (n+1) to 7 do     for n3:= (n2+1) to 8 do        begin           if (RC[xn,n] <> []) and (RC[xn,n2] <> []) and (RC[xn,n3] <> [])           and (nm[rset[xn,n]] <4) and (nm[rset[xn,n2]] <4) and (nm[rset[xn,n3]] < 4 )            then              for yn:= 45 to 128 do               if (RC[xn,n] + RC[xn,n2] + RC[xn,n3] = comboset[yn] )                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if not (z in [n,n2,n3] )                        then                          covered[rset[xn,z]]:= covered[rset[xn,z]] - comboset[yn];                  end;           if (RC[n,xn] <> []) and (RC[n2,xn] <> []) and (RC[n3,xn] <> [])           and (nm[rset[n,xn]] < 4 ) and (nm[rset[n2,xn]] <4)  and (nm[rset[xn,n3]] <4)            then              for yn:= 45 to 128 do               if ( RC[n,xn] + RC[n2,xn] + RC[n3,xn] = comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2,n3] )                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] - comboset[yn];                  end;           if (bS[xn,n] <> []) and (bS[xn,n2] <> []) and (bs[xn,n3] <> [])           and (nm[bset[xn,n]] < 4) and (nm[bset[xn,n2]] <4) and (nm[bset[xn,n3]] <4)            then              for yn:= 45 to 128 do               if(BS[xn,n] + Bs[xn,n2] + BS[xn,n3]= comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2,n3] )                        then                           covered[Bset[xn,z]]:= covered[Bset[xn,z]] - comboset[yn];                  end;        end;end;{naked triple}`

Hidden Text: Show
Code: Select all
`{Naked Quad}procedure Nq(k:integer);varxn,yn,n,n2,n3,n4,z:integer;BeginFor xn:= 0 to 8 do  For n:= 0 to 5 do    for n2:= (n+1) to 6 do     for n3:= (n2+1) to 7 do      for n4:= (n3+1) to 8 do        begin           if (RC[xn,n] <> []) and (RC[xn,n2] <> []) and (RC[xn,n3] <> []) and (RC[xn,n4] <> [])           and (nm[rset[xn,n]] <5) and (nm[rset[xn,n2]] <5) and (nm[rset[xn,n3]] < 5 ) and (nm[rset[xn,n4]] <5)            then             for yn:= 129 to 254 do              if (RC[xn,n] + RC[xn,n2] + RC[xn,n3] + RC[xn,n4] = comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if not (z in [n,n2,n3,n4] )                        then                           covered[rset[xn,z]]:= covered[rset[xn,z]] - comboset[yn];                  end;           if (RC[n,xn] <> []) and (RC[n2,xn] <> []) and (RC[n3,xn] <> []) and (RC[n4,xn] <> [])           and (nm[rset[n,xn]] < 5 ) and (nm[rset[n2,xn]] <5)  and (nm[rset[xn,n3]] <5) and (nm[rset[xn,n4]] <5)            then              for yn:= 129 to 254 do               if  (RC[n,xn] + RC[n2,xn] + RC[n3,xn] + RC[n4,xn]= comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2,n3,n4] )                        then                           covered[Cset[xn,z]]:= covered[Cset[xn,z]] - comboset[yn];                  end;           if (bS[xn,n] <> []) and (bS[xn,n2] <> []) and (bs[xn,n3] <> []) and (bs[xn,n4] <> [])            and (nm[bset[xn,n]] < 5) and (nm[bset[xn,n2]] <5) and (nm[bset[xn,n3]] <5) and (nm[bset[xn,n4]] <5)            then              for yn:=129 to 254 do               if (BS[xn,n] + Bs[xn,n2] + BS[xn,n3] + BS[xn,n4] = comboset[yn] )                then                   begin                    active:= true;                     for z:= 0 to 8 do                       if  not (z in [n,n2,n3,n4])                        then                           covered[Bset[xn,z]]:= covered[Bset[xn,z]] - comboset[yn];                  end;        end;end;{naked quad}`

Box Line reduction
Hidden Text: Show
Code: Select all
`{box line reduction}procedure BLR(k:integer);varxn,sq,n,z:integer;beginfor n:= 1 to 9 do for xn:= 0 to 8 do   if  N  in Bd[xn]    then  for sq:= 0 to 8 do  if sq in (BnR[xn,n] + BnC[xn,n])   then  begin   {type 1 all cells for  a box are in a row }    if  (BNR[xn,n] = [sq] )     then      begin       active:=true;       covered2[n]:= Covered2[n] - (Rnum[sq] - Bnum[xn]);      end;   {type 2 all cells for a row are in 1 box }    if ( Rn[sq,n] - BnC[xn,n] = []  )  and (sq in BnR[xn,n]  )     then      begin       active:= true;       covered2[n]:=covered2[n] - (Bnum[xn] - Rnum[sq]);       end;   {type 1 all cells for  a box are in a  col}   if  (BNC[xn,n] = [sq] )     then      begin       active:=true;       covered2[n]:= Covered2[n] - (Cnum[sq] - Bnum[xn]);      end;     {type 2 all cells for a Col are in 1 box }     if ( Cn[sq,n] - BnR[xn,n] = []  )  and (sq in BnC[xn,n]  )     then      begin       active:= true;        covered2[n]:=covered2[n] - (Bnum[xn] - Cnum[sq]);       end;   end; {xn}end;{box,line reduction}`

X- Wing
Hidden Text: Show
Code: Select all
`{x-wing}procedure xwing(k:integer);varxn,xn2,xn3,yn,n,z:integer;beginFor n:= 1 to 9 doFor xn:= 0 to 7 do for xn2:= (xn+1) to 8 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 3 )           and (R[xn2,n] > 0) and (R[xn2,n] < 3 )            then              for yn:= 9 to 44 do                if Rn[xn,n] + Rn[xn2,n] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn3:= 0 to 8 do                          if not (xn3 in [xn,xn2])                           then                             exclude( covered[Rset[xn3,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 3 )           and (C[xn2,n] > 0) and (C[xn2,n] < 3 )            then              for yn:= 9 to 44 do                if Cn[xn,n] + Cn[xn2,n] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn3:= 0 to 8 do                          if not (xn3 in [xn,xn2])                           then                             exclude( covered[Cset[xn3,z]],n);                  end;     If   (B[xn,n] > 0) and (B[xn,n] < 7 )           and (B[xn2,n] > 0) and (B[xn2,n] < 7 )            then             for yn:= 9 to 44 do              begin                if BNC[xn,n] + BnC[xn2,n] = comboset2[yn]                 then                   begin                    active:= true;                    for xn3:= 0 to 8 do                     if not (xn3 in [xn,xn2])                      then                       for z:= 0 to 8 do                        if Cy[bset[xn3,z]] in comboset2[yn]                          then                           exclude(covered[bset[xn3,z]],n);                   end;                if BNR[xn,n] + BnR[xn2,n] = comboset2[yn]                 then                   begin                    active:= true;                    for xn3:= 0 to 8 do                     if not (xn3 in [xn,xn2])                      then                       for z:= 0 to 8 do                        if Rx[bset[xn3,z]] in comboset2[yn]                          then                           exclude(covered[bset[xn3,z]],n);                   end;             end;        end;end;{x-wing}`

Skyscraper { finned & Sashimi X-wing }
Hidden Text: Show
Code: Select all
`{ Skyscrapers - Finned and or Sashimi x-wings}procedure smashi(k:integer);varxn,xn2,xn3,yn,n,z:integer;Finn:RCBnums;finns:numberset;beginFor n:= 1 to 9 doFor xn:= 0 to 7 do for xn2:= (xn+1)  to 8 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 5 )           and (R[xn2,n] > 0) and (R[xn2,n] < 5 )            then              for yn:= 9 to 44 do                if (( Rn[xn,n] + Rn[xn2,n]) * comboset2[yn] = comboset2[yn] )                 then                   begin                    active:= true;                    finn:= (Rn[xn2,n] + Rn[xn,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                          begin                           if (Rn[xn,n] - comboset2[yn] <> [])                            then                              include(finns,Rset[xn,z]);                           if (Rn[xn2,n] - comboset2[yn] <> [])                            then                              include(finns,Rset[xn2,z]);                           end;                      for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn3:= 0 to 8 do                           if not (xn3 in [xn,xn2])                            and  ( finns * peer[Rset[xn3,z]] = finns )                             then                              exclude(covered[Rset[xn3,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 5 )           and (C[xn2,n] > 0) and (C[xn2,n] < 5 )            then              for yn:= 9 to 44 do                if ((Cn[xn,n] + Cn[xn2,n]) * comboset2[yn] = comboset2[yn])                 then                   begin                    active:= true;                    finn:= (Cn[xn2,n] + Cn[xn,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                          begin                           if (CN[xn,n] - comboset2[yn]  <> [] )                            then                             include(finns,Cset[xn,z]);                            if (CN[xn2,n]  - comboset2[yn]   <> [] )                            then                             include(finns,Cset[xn2,z]);                           end;                    for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn3:= 0 to 8 do                           if not (xn3 in [xn,xn2])                            and  ( finns * peer[Cset[xn3,z]] = finns )                             then                              exclude(covered[Cset[xn3,z]],n);                  end;        end;end;{SMASHI}`

2 - String kite
Hidden Text: Show
Code: Select all
`{2-String Kyte}procedure kyte(k:integer);varn,yn,xn,xa,ya,I,j,xn2,yn2,q:integer;begin for n:= 1 to 9 do    for xa:=0 to 2 do     for ya:=0 to 2 do       for I:= 0 to 2 do         for yn:= (ya*3) to (2+(ya*3)) do     {columns}          begin           xn:=(I+(xa*3));    {rows}           j:= (xa*3)+(ya);    {box}          if  (DigitRCB[n,j+18] * DigitRCB[n,xn] <> [] )     {mini row contains cells}          and (DigitRCB[n,J+18] * DigitRCB[n,yn+9] <> [])    {mini col contains cells}          and ( DigitRCB[n,xn] * DigitRcb[n,yn+9] = [] )     {r&c intersection = []}          and (DigitRCB[n,xn] - (DigitRCB[n,j+18]*DigitRCB[n,xn]) <> [] )      {row has digits out side the box}          and (DigitRCB[n,yn+9] - (DigitRCB[n,j+18]*DigitRCB[n,yn+9]) <> [] )   {col has digits out side the box}          then          for xn2:= 0 to 8 do           if ((xn2 div 3 ) <> (xn div 3) )            then             for yn2:= 0 to 8 do              if ((yn2 div 3) <> (yn div 3))              then                 if  (   DigitRCB[n,xn] = (   DigitRCB[n,xn] * DigitRCB[n,j+18]) +  (DigitRCB[n,xn] * DigitRCB[n,yn2+9]) )                 and (   DigitRCB[n,yn+9] = (   DigitRCB[n,yn+9] * DigitRCB[n,j+18]) +  (DigitRCB[n,yn+9] * DigitRCB[n,xn2]) )                 then                  begin                  active:= true;                  covered2[n]:= covered2[n] - (DigitRCB[n,xn2] * DigitRCB[n,yn2+9]);                 end;          end;end; `

Empty Rectangle
Hidden Text: Show
Code: Select all
` {Empty Rectangle}procedure ER(K:integer);varn,yn,xn,xa,ya,I,j,q,xn2,yn2:integer;begin for n:= 1 to 9 do    for xa:=0 to 2 do     for ya:=0 to 2 do       for I:= 0 to 2 do         for yn:= (ya*3) to (2+(ya*3)) do     {columns}          begin           xn:=(I+(xa*3));    {rows}           j:= (xa*3)+(ya);    {box}           if ( (digitRCB[n,yn+9] * digitrcb[n,j+18] )           +    (digitRCB[n,xn] * digitrcb[n,j+18] )           =    (digitRCB[n,j+18]) )         and  ( DigitRCB[n,j+18] <> [] )         and  ((digitRCB[n,yn+9] * digitrcb[n,j+18] ) - DigitRCB[n,xn]  <> [])         and  ((digitRCB[n,xn] * digitrcb[n,j+18] ) - DigitRCB[n,yn+9]  <> [])            then            begin             for xn2:= 0 to  8 do               if  (R[xn2,n]=2  )               and (DigitRCB[n,xn2] * DigitRCB[n,j+18] = [])               and (DigitRCB[n,xn2] * DigitRCB[n,yn+9] <> [])              then                 for yn2:= 0 to 8 do                  if ((DigitRCB[n,yn2+9] * DigitRCB[n,xn2] ) <> (DigitRCB[n,yn+9] * DigitRCB[n,xn2]))                   and (DigitRCB[n,yn2+9] * DigitRCB[n,xn2] <> [])                   and (DigitRCB[n,yn2+9] * DigitRCB[n,xn] <> [])                   and (DigitRCB[n,yn2+9] * DigitRCB[n,j+18] = [])                    then                      begin                        active:=true;                        Covered2[n]:=Covered2[n] - ( ( DigitRCB[n,yn2+9] * DigitRCB[n,xn] ) - (DigitRCB[n,j+18] * digitrcb[n,yn+9]) );                      end;              for xn2:= 0 to  8 do               if  (C[xn2,n]=2  )               and (DigitRCB[n,xn2+9] * DigitRCB[n,j+18] = [])               and (DigitRCB[n,xn2+9] * DigitRCB[n,xn] <> [])              then                 for yn2:= 0 to 8 do                  if ((DigitRCB[n,yn2] * DigitRCB[n,xn2+9] ) <> (DigitRCB[n,xn] * DigitRCB[n,xn2]))                   and (DigitRCB[n,yn2] * DigitRCB[n,xn2+9] <> [])                   and (DigitRCB[n,yn2] * DigitRCB[n,yn+9] <> [])                   and (DigitRCB[n,yn2] * DigitRCB[n,j+18] = [])                    then                      begin                        active:=true;                        Covered2[n]:=Covered2[n] - ( ( DigitRCB[n,yn2]* DigitRCB[n,yn+9] ) - (DigitRCB[n,j+18]* digitrcb[n,xn]) );                      end;             end;       end;end;{empty rectangle} `

Sword Fish
Hidden Text: Show
Code: Select all
`{sword fish}procedure Swordfish(k:integer);varxn,xn2,xn3,xn4,yn,n,z:integer;beginFor n:= 1 to 9 doFor xn:= 0 to 6 do for xn2:= (xn+1) to 7 do  for xn3:= (xn2+1) to 8 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 4 )           and (R[xn2,n] > 0) and (R[xn2,n] < 4 )           and (R[xn3,n] > 0) and (R[xn3,n] < 4 )            then              for yn:= 45 to 128 do                if Rn[xn,n] + Rn[xn2,n] + Rn[xn3,n]= comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn4:= 0 to 8 do                          if not (xn4 in [xn,xn2,xn3])                           then                             exclude( covered[Rset[xn4,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 4 )           and (C[xn2,n] > 0) and (C[xn2,n] < 4 )           and (C[xn3,n] > 0) and (C[xn3,n] < 4 )            then              for yn:= 45 to 128 do                if Cn[xn,n] + Cn[xn2,n] + Cn[xn3,n] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn4:= 0 to 8 do                          if not (xn4 in [xn,xn2,xn3])                           then                             exclude( covered[Cset[xn4,z]],n);                    end;        end;end;{swordfish}`

Finned Sashimi Sword fish
Hidden Text: Show
Code: Select all
`{Finned Sashimi sword fish}procedure smashiSwords(k:integer);varxn,xn2,xn3,xn4,yn,n,z:integer;Finn:RCBnums;finns:numberset;beginFor n:= 1 to 9 doFor xn:= 0 to 6 do for xn2:= xn+1 to 7 do  for xn3:= (xn2+1) to 8 do        begin         If   (R[xn,n] > 0) and (R[xn,n] < 6 )           and (R[xn2,n] > 0) and (R[xn2,n] < 6 )           and (R[xn3,n] > 0) and (R[xn3,n] < 6 )            then              for yn:= 45 to 128 do                if (( Rn[xn,n] + Rn[xn2,n] + Rn[xn3,n]) * comboset2[yn] = comboset2[yn] )                 then                   begin                    active:= true;                    finn:= (Rn[xn2,n] + Rn[xn,n] + Rn[xn3,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                         begin                         if (Rn[xn3,n] - comboset2[yn] <> [] )                          then                          include(finns,Rset[xn3,z]);                         if (Rn[xn2,n] - comboset2[yn] <> [] )                          then                          include(finns,Rset[xn2,z]);                          if (Rn[xn,n] - comboset2[yn] <> [] )                          then                          include(finns,Rset[xn,z]);                         end;                      for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn4:= 0 to 8 do                           if not (xn4 in [xn,xn2,xn3])                            and  ( finns * peer[Rset[xn4,z]] = finns )                             then                              exclude(covered[Rset[xn4,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 6 )           and (C[xn2,n] > 0) and (C[xn2,n] < 6 )           and  (C[xn3,n] > 0) and (C[xn3,n] < 6 )            then              for yn:= 45 to 128 do                if ((Cn[xn,n] + Cn[xn2,n] + Cn[xn3,n]) * comboset2[yn] = comboset2[yn])                 and (Cn[xn,n] - comboset2[yn] = [])                 then                   begin                    active:= true;                    finn:= (Cn[xn2,n] + Cn[xn,n]+ Cn[xn3,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                          begin                         if (Cn[xn3,n] - comboset2[yn] <> [] )                          then                          include(finns,Cset[xn3,z]);                         if (Cn[xn2,n] - comboset2[yn] <> [] )                          then                          include(finns,Cset[xn2,z]);                          if (Cn[xn,n] - comboset2[yn] <> [] )                          then                          include(finns,Cset[xn,z]);                          end;                    for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn4:= 0 to 8 do                           if not (xn4 in [xn,xn2,xn3])                            and  ( finns * peer[Cset[xn4,z]] = finns )                             then                              exclude(covered[Cset[xn4,z]],n);                  end;        end;end;{SMASHIswords}`

Jelly Fish
Hidden Text: Show
Code: Select all
`{jelly fish}procedure jellyfish(k:integer);varxn,xn2,xn3,xn4,xn5,yn,n,z:integer;beginFor n:= 1 to 9 doFor xn:= 0 to 5 do for xn2:= (xn+1) to 6 do  for xn3:= (xn2+1) to 7 do   for xn4:= (xn3+1) to 8 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 5 )           and (R[xn2,n] > 0) and (R[xn2,n] < 5 )           and (R[xn3,n] > 0) and (R[xn3,n] < 5 )           and (R[xn4,n] > 0) and (R[xn4,n] < 5 )            then              for yn:= 129 to 254 do                if Rn[xn,n] + Rn[xn2,n] + Rn[xn3,n] + Rn[xn4,n]= comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn5:= 0 to 8 do                          if not (xn5 in [xn,xn2,xn3,xn4])                           then                             exclude( covered[Rset[xn5,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 5 )           and (C[xn2,n] > 0) and (C[xn2,n] < 5 )           and (C[xn3,n] > 0) and (C[xn3,n] < 5 )           and (C[xn4,n] > 0) and (C[xn4,n] < 5 )            then              for yn:= 129 to 254 do                if Cn[xn,n] + Cn[xn2,n] + Cn[xn3,n] + Cn[xn4,n] = comboset2[yn]                 then                   begin                    active:= true;                     for z:= 0 to 8 do                       if (z in comboset2[yn])                        then                         for xn5:= 0 to 8 do                          if not (xn5 in [xn,xn2,xn3,xn4])                           then                             exclude( covered[Cset[xn5,z]],n);                    end;        end;end;{jelly fish} `

Finned/ Sashimi Jelly Fish
Hidden Text: Show
Code: Select all
`{Finned Sashimi jelly fish}procedure smashijelly(k:integer);varxn,xn2,xn3,xn4,xn5,yn,n,z:integer;Finn:RCBnums;finns:numberset;beginFor n:= 1 to 9 doFor xn:= 0 to 5 do for xn2:= (xn+1)  to 6 do  for xn3:= xn2+1 to 7 do   for xn4:= (xn3+1) to 8 do       begin         If   (R[xn,n] > 0) and (R[xn,n] < 7 )           and (R[xn2,n] > 0) and (R[xn2,n] < 7 )           and (R[xn3,n] > 0) and (R[xn3,n] < 7 )            and (R[xn4,n] > 0) and (R[xn4,n] < 7 )            then              for yn:= 129 to 254 do                if (( Rn[xn,n] + Rn[xn2,n] + Rn[xn3,n] + Rn[xn4,n]) * comboset2[yn] = comboset2[yn] )                 then                   begin                    active:= true;                    finn:= (Rn[xn2,n] + Rn[xn,n] + Rn[xn3,n] + Rn[xn4,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                         begin                            if (Rn[xn,n] - comboset2[yn] <> [])                           then                            include(finns,Rset[xn,z]);                           if (Rn[xn2,n] - comboset2[yn] <> [])                           then                            include(finns,Rset[xn2,z]);                          if (Rn[xn4,n] - comboset2[yn] <> [])                           then                            include(finns,Rset[xn4,z]);                           if (Rn[xn3,n] - comboset2[yn] <> [])                           then                            include(finns,Rset[xn3,z]);                          end;                      for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn5:= 0 to 8 do                           if not (xn5 in [xn,xn2,xn3,xn4])                            and  ( finns * peer[Rset[xn5,z]] = finns )                             then                              exclude(covered[Rset[xn5,z]],n);                  end;        If   (C[xn,n] > 0) and (C[xn,n] < 7 )           and (C[xn2,n] > 0) and (C[xn2,n] < 7 )           and  (C[xn3,n] > 0) and (C[xn3,n] < 7 )           and  (C[xn4,n] > 0) and (C[xn4,n] < 7 )            then              for yn:= 129 to 254 do                if ((Cn[xn,n] + Cn[xn2,n] + Cn[xn3,n] + Cn[xn4,n]) * comboset2[yn] = comboset2[yn])                { and (Cn[xn,n] - comboset2[yn] = [])                 and (Cn[xn2,n] -  comboset2[yn] = [] ) }                 then                   begin                    active:= true;                    finn:= (Cn[xn2,n] + Cn[xn,n]+ Cn[xn3,n] + Cn[xn4,n]) - comboset2[yn];                    Finns:=[];                     for z:= 0 to 8 do                       if z in finn                         then                          begin                          if (Cn[xn2,n] - comboset2[yn] <> [])                           then                            include(finns,Cset[xn2,z]);                          if (Cn[xn,n] - comboset2[yn] <> [])                           then                            include(finns,Cset[xn,z]);                          if (Cn[xn4,n] - comboset2[yn] <> [])                           then                            include(finns,Cset[xn4,z]);                          if (Cn[xn3,n] - comboset2[yn] <> [])                           then                            include(finns,Cset[xn3,z]);                          end;                    for z:= 0 to 8 do                        if z in comboset2[yn]                         then                          for xn5:= 0 to 8 do                           if not (xn5 in [xn,xn2,xn3,xn4])                            and  ( finns * peer[Cset[xn5,z]] = finns )                             then                              exclude(covered[Cset[xn5,z]],n);                  end;        end;end;{SMASHIjellies}`

N x (N + K) Fish finder
Hidden Text: Show
Code: Select all
`{fish finder}procedure fishfinder;type hold = array of integer; hold2 = array of integer; base2 = array of numberset; base3 = array of numberset; base4 = array of numberset; base5 = array of numberset; base6 = array of numberset; base7 = array of numberset; base8 = array of numberset; base9 = array of numberset; base10 = array of numberset; Rcover2 = array of numberset; Bcover2 = array of numberset; Ccover2 = array of numberset; Cover2 = array of numberset; used2 = array of rcbpeer; used3 = array of rcbpeer; used4 = array of rcbpeer; peered = array of rcbpeer;var a1,b1,a2,b2,a3,b3,z,n,w,w2,w3,p,p2,p3,q,q2,q3,x,s,s2,s3,f,f2,f3,k,k2,l,m,m2:integer; output:text;h:hold;h2:hold2;h3:hold2;use:used2;use2:used3;use3:used4;Base: base2;basei: base3;pbasei: base4;Mbase: base7;Rbase:base8;Cbase:base9;bbASE:base10;mi: base5;pmi: base6;Cover:cover2;Rcover:rcover2;Ccover:Ccover2;Bcover:bcover2;peers:peered;sector:rcbpeer;sector2: array [0..26] of rcbpeer;begin setlength(use,0); setlength(h,0); setlength(base,0); setlength(Cbase,0); setlength(Rbase,0); setlength(Bbase,0); setlength(basei,0); setlength(pbasei,0); setlength(peers,0); setlength(use2,0); setlength(h2,0); setlength(cover,0); setlength(Rcover,(0)); setlength(Ccover,(0)); setlength(Bcover,(0)); setlength(h3,0); setlength(use3,0); setlength(mbase,0); setlength(mi,0); setlength(pmi,0);z:=12;setlength(h,(z));      { stores the active sectors }setlength(use,z);setlength(base,z);setlength(Cbase,z);setlength(Rbase,z);setlength(Bbase,z);setlength(basei,z);setlength(pbasei,z);setlength(peers,z);setlength(mi,z+3);setlength(pmi,z+3);setlength(h2,z+3);setlength(h3,z+3);setlength(use2,z+3);setlength(cover,z+3);    {cover area's}setlength(Rcover,z+3);   {specific cover area's }setlength(Ccover,z+3);setlength(Bcover,z+3); setlength(use3,z+3); setlength(mbase,z+3);for n:= 7 to 7 do    {digits 1 - 9} for z:= 6 to  6 do    {sector size}  begin     sector:=[];      for s:= 0 to 26 do       sector2[s]:=[];       F2:=0;       A1:=0;       b1:=0;        for s:= 26 downto 0 do         begin          if (digitRCB[n,s] <> [])   {makes sure the sector actually has active cells}          and (sec[s,n] < z+5)          then            begin              for s2:= 26 downto 0 do               if  (s2 in peerRCB[s])               and (digitRCB[n,s2] <> [])               and ((digitRCB[n,s2] * digitRCB[n,s]) <> [] )                 then                   begin                     include(sector,s);                     include(sector2[s],s2);                   end;            end;          if (s in sector) and (sector2[s] <> [])           then            begin             inc(f2);             if s > a1 then              A1:=s;              B1:=s;            end;    end;  if (f2 >= z )   then    for s:= a1 downto b1+(z-1) do     if ( s in  (sector *[1,11,14,15,23,26]) )        and (f2 >=z-1)        then          begin { first base untit}           w:=0;    {sector count}           dec(f2);           q:=f2;           h[w]:= s;  {sets the inial base sector}               repeat                   for p:= h[w] downto b1 do     {iterate from starting base down to 0}                     if                        (DigitRCB[n,p] - base[w] <> []) {makes sure the base sector actually has active cells}                        and (q >= (z-1-w))                        and  ( p in ( (sector*[1,11,14,15,23,26])  - use[w]))                         then                          begin {Activate nth unit used}                             inc(w);   {increases sector count}                             dec(q);                             h[w]:= p-1;     {sets the next sector value}                             use[w]:= use[w-1] + [p];                    {set the used values}                             base[w]:= base[w-1] + digitRCB[n,p];            {sets the base value}                             peers[w]:=peers[w-1] + sector2[p];                             basei[w]:= basei[w-1] + (base[w-1] * digitrcb[n,p]);                              if (base[w-1] * digitRCB[n,p])  <> []                                then                                  begin                                   for x:= 0 to 80 do                                    if peer[x] * basei[w] = basei[w]                                     then                                       include(pbasei[w],x);                                  end                                 else                                   pbasei[w]:= pbasei[w-1];                               if p in [0..8]                              then                               Rbase[w]:= Rbase[w-1] +digitRCB[n,p]                              else                                Rbase[w]:= Rbase[w-1];                             if p in [9..17]                              then                               Cbase[w]:= Cbase[w-1] + digitRCB[n,p]                              else                                Cbase[w]:= Cbase[w-1];                             if p in [18..26]                              then                               Bbase[w]:= Bbase[w-1] + digitRCB[n,p]                              else                               Bbase[w]:= Bbase[w-1];                             break;  {exit from loop to iterate forward from the new H[w] value}                          end {end finding nth unit}                          else                           begin                           if w > 0                             then                                dec(h[w]);  { if we are in new starting sector and above logic is false advance the step couny}                            if( w > 0) and (Q < (z-1-w))                              then                                h[w]:=-1;                            end;if( w = z)  {smallest recursion function starting}and ( ( basei[w] = [] )  or  ( ( basei[w] <> [] ) and  ( ( pbasei[w] - base[w] ) <> [] ) ) )then begin k:=0; repeat  l:=0;   if (w = z)     then        begin       F:=0;       A2:=0;       B2:=0;          for x:=  26 downto 0 do            if (x in (( peers[w]) - use[w])  )               and (digitrcb[n,x] * base[w] <> [])               then                begin                inc(f);                 if X > a2                   then                    a2:=x;                    b2:=x;                end;      end;   if (w = z) and (F >= (z+k)) {find cover set}       then        for s2:= a2 downto (b2+(z+k-1)) do          if (digitRCB[n,s2] * base[w] <> [] )          and (S2 in( ( peers[w]*[0,5,6,8,10,12,16,25]) - use[w]))           and(f>=(z+k)-1)        then          begin { first base unit }           w2:=0;           dec(f);           h2[w2]:= s2;           q2:=f;               repeat                   for p2:= h2[w2] downto b2 do                     if (digitRCB[n,p2] * base[w] <> [])                       and (p2 in ( ( peers[w]*[0,5,6,8,10,12,16,25])  - use[w] - use2[w2]  )  )                        and (q2 >= ((z+k)-1-w2))                         then                          begin {Activate nth unit used}                             inc(w2);                             dec(q2);                             h2[w2]:= p2-1;                             use2[w2]:= use2[w2-1] + [p2];                             cover[w2]:= cover[w2-1] + digitRCB[n,p2];                             if p2 in [0..8]                              then                               Rcover[w2]:= Rcover[w2-1] +digitRCB[n,p2]                              else                                Rcover[w2]:= Rcover[w2-1];                             if p2 in [9..17]                              then                               Ccover[w2]:= Ccover[w2-1] + digitRCB[n,p2]                              else                                Ccover[w2]:= Ccover[w2-1];                             if p2 in [18..26]                              then                               Bcover[w2]:= Bcover[w2-1] + digitRCB[n,p2]                              else                               Bcover[w2]:= Bcover[w2-1];                             break;                          end {end finding nth unit}                         else                          begin                           if w2 > 0                             then                                dec(h2[w2]);                             if( w2 > 0) and (Q2 < ((z+k)-1-w2))                              then                                h2[w2]:=-1;                           end;                  if (w2 = z+k) and  (basei[w] = []) and (k <3)                    and ( ( cover[w2] * base[w] ) = base[w] )    {checks that base cells out side the cover*base has no candidates}                    and (  ( ( cover[w2] - base[w] <> [] ) and (w2 = z))                     or     (   ( w2 <= z+1 )                       and  ( (  ( ( Rcover[w2] * Ccover[w2] )  + ( Rcover[w2] * Bcover[w2] ) + ( Ccover[w2] * Bcover[w2] ) )  - base[w] ) <> [] ) )                     or     (   ( w2 > z+1 )                       and  ( ( ( Rcover[w2] * Ccover[w2] * Bcover[w2] ) - base[w] ) <> [] ) )                       )                   then                     begin                    active:=true;                                          if (w2 = z)                        then                         covered2[n]:= covered2[n] - (cover[w2] - base[w]);                    if  ((w2 = z+1) or ( w2 = z))  { 1 or 0 fin sectors - elimiantions in overlaps of cover sectors not in base }                      then                       covered2[n]:= covered2[n] -  (( (Rcover[w2] * Ccover[w2]) + (Rcover[w2] * Bcover[w2]) + ( Ccover[w2] * Bcover[w2]) ) - base[w]) ;                    if (w2 = z+2)  { 2 fin sector - elimiantions in overlaps of cover sectors not in base }                      then                         covered2[n]:=COvered2[n] - ((Rcover[w2] * Bcover[w2] * Ccover[w2])- base[w]);                                         end;                  if (w2 =z+k) and (basei[w] <> [])  and (k <3)                     and (  (cover[w2] * base[w])  = base[w])                     and (  (  (pbasei[w] * ( cover[w2] - base[w]) <> [] ) and (w2 = z))                     or     (   ( w2 <= z+1 )                       and  ( ( pbasei[w] * ( (Rcover[w2] * Ccover[w2]) + (Rcover[w2] * Bcover[w2]) + ( Ccover[w2] * Bcover[w2] ) ) - base[w] ) <> [] ) )                     or     (   (w2 > z+1)                     and ( ( ( pbasei[w] * (Rcover[w2] * Ccover[w2] * Bcover[w2]) ) - base[w] ) <> []) )                    )                      then                         begin                          active:= true;                                                if (w2=z)                       then                         covered2[n]:=covered2[n] -(  (pbasei[w] * cover[w2]) - base[w]);                      if  ((w2 = z+1) or ( w2 = z))  { 1 or 0 fin sectors - elimiantions in overlaps of cover sectors not in base }                         then                           covered2[n]:=covered2[n] -( (pbasei[w] * ((Rcover[w2] * Ccover[w2]) + (Rcover[w2] * Bcover[w2]) + ( Ccover[w2] * Bcover[w2]))) - base[w]);                      if (w2 = z+2)     { 2 fin sector - elimiantions in overlaps of cover sectors not in base }                         then                           covered2[n]:=covered2[n] -((pbasei[w] * (Rcover[w2]*Bcover[w2]*Ccover[w2])) - base[w]);                                             end;                                      if   ( (h2[w2] < b2 ) and (w2 > 0 ) )                   {if any of the follow conditioins are true, then backtrack to previous W2}                   or    ( ( cover[w2] * base[w] )  = base[w])                   or ( (w2 = z+1) and (basei[w] = []) and  ( ( ( Rcover[w2] * Bcover[w2] ) + ( Ccover[w2] * Bcover[w2]) + ( Ccover[w2] * Rcover[w2] ) - base[w] )=[] )  )                   or ( (w2 = z+2) and (basei[w] = []) and  ( ( ( Rcover[w2] * Bcover[w2] * Ccover[w2] ) - base[w]) = [] )  )                  or ( (w2 = z+1) and (basei[w] <> []) and  ( (pbasei[w]* ( ( Rcover[w2] * Bcover[w2] ) + ( Ccover[w2] * Bcover[w2]) + ( Ccover[w2] * Rcover[w2] )) - base[w] )=[] )  )                  or ( (w2 = z+2) and (basei[w] <> []) and  ( ( ( pbasei[w] * ( Rcover[w2] * Bcover[w2] * Ccover[w2] )) - base[w]) = [] )  )                   or (w2 = z+k)                   or (( q2 < ((z+k)-1-w2)) and (w2 > 0))                    then                      repeat                        begin                         dec(w2);                         inc(q2);                         use2[w2+1]:=[];                         Cover[w2+1]:=[];                         rcover[w2+1]:=[];                         Ccover[w2+1]:=[];                         bcover[w2+1]:=[];                         if w2 > 0                           then                             dec(h2[w2]);                         end;                      until ( Q2 >= ((z+k) - 1 - w2)) or (w2 = 0)               until  (w2 = 0)         end;{starting cover untis} if (L = 0)  then   inc(k); until  ( (k>4)  ) or (l=1) or ((k=1) and (z=1)) ; {smallest recursion function end} end;              if ( ( h[w] < b1 ) and (w > 0 ))    {if any of the follow conditioins are true, then backtrack to previous W}                   or (w = z)                   or ( ( q < ( z-1-w) ) and (w > 0)  )                   or (( basei[w] <> []) and (pbasei[w] = []))                     then                      repeat                      begin                         dec(w);                         inc(q);                         base[w+1]:=[];                         Rbase[w+1]:=[];                         Cbase[w+1]:=[];                         Bbase[w+1]:=[];                         basei[w+1]:=[];                         pbasei[w+1]:=[];                         use[w+1]:=[];                         peers[w+1]:=[];                         if w > 0                           then                             dec(h[w]);                      end;                     until ( q >=  (z - 1 - w)) or (w = 0)               until  (w = 0)      end;{starting base untis} end;end; {fish finder}`

W-Wing
Hidden Text: Show
Code: Select all
`procedure Wwing(K:integer);varxn,xn2,n,n2,yn:integer;begin for xn:= 0 to 79 do  if( nm[xn] = 2 )   then     for xn2:= xn+1 to 80 do      if( nm[xn2] = 2 ) and (pm[xn] = pm[xn2])       then         begin          for n:= 1 to 9 do           if N in (pm[xn])            then              for yn:= 0 to 26 do                if (Digitrcb[n,yn] <> [] )                and ((digitrcb[n,yn] * peer[xn]) + (digitrcb[n,yn] * peer[xn2] )  = digitrcb[n,yn] )                 then                  begin                    active:= true;                     for n2:= 1 to 9 do                      if( n2 <> n) and (N2 in (pm[xn]) )                        then                         covered2[n2]:=covered2[n2]  - (peer[xn] * peer[xn2] );                  end;         end;end;  {end W-wing}`

M-Wing
Hidden Text: Show
Code: Select all
`procedure Mwing(k:integer);varxn,xn2,n,n2,yn,yn2,z:integer;beginfor xn:= 0 to 80 do  if (nm[xn] = 2)    then     for xn2:= 0  to 80 do      if (pm[xn] * pm[xn2] = pm[xn]) and (xn2 <> xn)       then         for n:= 1 to 9 do          if n in (pm[xn]*pm[xn2])           then            for yn:= 0 to 26 do             begin                   {row,box,col}                   if (digitrcb[n,yn] <> [] )                   and(digitrcb[n,yn] * ( peer[xn] + [xn2] )  = digitrcb[n,yn] )                    then                      begin                       for  n2:= 1 to 9 do                          if (n2 in (pm[xn]*pm[xn2])) and (n2 <> n)                            then                              begin                              {row}                               for yn2:= 0 to 26 do                                begin                                 if  (digitrcb[n2,yn2] <> [] )                                 and ((digitrcb[n2,yn2] * peer[xn2]) + [xn2] = digitrcb[n2,yn2] )                                  then                                    begin                                     active:=true;                                    for z:= 0 to 80 do                                     if peer[z] *  ([xn] +( digitrcb[n2,yn2] - [xn2]) )= ([xn] +( digitrcb[n2,yn2] - [xn2]) )                                      then                                       covered2[n2]:=covered2[n2] - [z];                                     end;                                end;{end row,box,col}                              end; {end #'s for rows,cols,boxs}                       end; {end  row,col,box}            end;end;{Mwing}`

S-Wing
Hidden Text: Show
Code: Select all
`Procedure Swing(K:integer);varxn,n,n2,j,j2,yn,yn2,z,z2,q,count,count2:integer;beginfor xn:= 0 to 80 do if nm[xn] = 2  then   for n:= 1 to 8 do    if n in pm[xn]     then      for n2:= n+1 to 9 do       if n2 in pm[xn]        then         for J:= 0 to 26 do          if (digitrcb[n,j] <> [])           and (xn in digitrcb[n,j])            then              for yn:= 0 to 26 do               if (yn in  peerrcb[j] )                and (digitrcb[n,yn] <> [])                and not (xn in digitrcb[n,yn])                and (digitrcb[n,yn] * digitrcb[n,j] <> [])                and ( (Digitrcb[n,yn] * digitrcb[n,j])  = ( peer[xn] * digitrcb[n,yn] ) )                 then                  for z:= 0 to 26 do                   if (z in peerrcb[yn])                    and (digitrcb[n,z] <> [] )                    and not (xn in digitrcb[n,z])                    and (digitrcb[n,z] * digitrcb[n,yn] <> [])                    and ((digitrcb[n,z] * digitrcb[n,yn]) + (digitrcb[n,yn] * digitrcb[n,j] ) = digitrcb[n,yn])                    then         for J2:= 0 to 26 do          if (digitrcb[n2,j2] <> [])           and (xn in digitrcb[n2,j2])            then              for yn2:= 0 to 26 do               if (yn2 in  (peerrcb[j2]-[yn]) )                and (digitrcb[n2,yn2] <> [])                and not (xn in digitrcb[n2,yn2])                and (digitrcb[n2,yn2] * digitrcb[n2,j2] <> [])                and ( (Digitrcb[n2,yn2] * digitrcb[n2,j2])  = ( peer[xn] * digitrcb[n2,yn2] ) )                 then                  for z2:= 0 to 26 do                   if (z2 in (peerrcb[z] * peerrcb[yn2]) )                    and (digitrcb[n2,z2] <> [] )                    and not (xn in digitrcb[n2,z2])                    and (digitrcb[n2,z2] * digitrcb[n2,yn2] <> [])                    and ((digitrcb[n2,z2] * digitrcb[n2,yn2]) + (digitrcb[n2,yn2] * digitrcb[n2,j2] ) = digitrcb[n2,yn2])                    then                    if  ( (digitrcb[n2,yn] * digitrcb[n2,z2] ) = (digitrcb[n2,yn] * digitrcb[n2,z2]) )                     and ( (digitrcb[n,yn2] * digitrcb[n,z] ) = (digitrcb[n,yn2] * digitrcb[n,z]) )                     and (( digitrcb[n,yn] * digitrcb[n,z] ) * (digitrcb[n2,yn2] * digitrcb[n2,z2] ) = [])                     then         begin          Count:=0;          count2:=0;          For q:= 0 to 80 do           begin           if q in (digitrcb[n,yn] * digitrcb[n,z])             then              inc(count);              if q in (digitrcb[n2,yn2] * digitrcb[n2,z2])               then                inc(count2);           end;          if ((count in [1])  and ((digitrcb[n2,yn] * Digitrcb[n2,z]) * (digitrcb[n,yn] * Digitrcb[n,z]) <> []) )          or ((count2 in [1])  and ((digitrcb[n,yn2] * Digitrcb[n,z2]) * (digitrcb[n2,yn2] * Digitrcb[n2,z2]) <> []))          then           begin             active:=true;            for q:= 0 to 80 do             begin             if  (count in [1])              and ((digitrcb[n2,yn] * Digitrcb[n2,z]) * (digitrcb[n,yn] * Digitrcb[n,z]) <> [] )              and (( digitrcb[n,yn] * digitrcb[n,z])  = [q])              and (peer[q] * (digitrcb[n2,yn2] * digitrcb[n2,z2])  =  (digitrcb[n2,yn2] * digitrcb[n2,z2]))               then                covered2[n2]:= covered2[n2] -(digitrcb[n,yn] * Digitrcb[n,z]);             if (count2 in [1])              and ((digitrcb[n,yn2] * Digitrcb[n,z2]) * (digitrcb[n2,yn2] * Digitrcb[n2,z2]) <> [])               and (( digitrcb[n2,yn2] * digitrcb[n2,z2])  = [q])              and (peer[q] * (digitrcb[n,yn] * digitrcb[n,z])  =  (digitrcb[n,yn] * digitrcb[n,z]))               then                covered2[n]:= covered2[n] -(digitrcb[n2,yn2] * Digitrcb[n2,z2]);             end;          end;         end;end;{swing}`

L-Wing
Hidden Text: Show
Code: Select all
`Procedure Lwing(k:integer);varn,n2,xn,xn2,j,j2,j3,j4,j5,xj:integer;output:text;beginfor n:= 1 to 9 do for j:= 0 to 26 do   if (digitrcb[n,j] <> [])    and (sec[j,n] <5)     then       for xn:= 0 to 80 do         if (xn in digitrcb[n,j] )         then           for j2:= 0 to 26 do            if (j2 in peerrcb[j])             and (digitrcb[n,j2] <> [] )             and ( (digitrcb[n,j2]* digitrcb[n,j]) + [xn] = digitrcb[n,j])              then              for n2:= 1 to 9 do               if (n2 <> n )                then               for j3:=  0 to 26 do               if (j3 in peerrcb[j2] - [j] )                and ( digitrcb[n,j3] <> [] )                and ( Digitrcb[n2,j3] <> [] )                and ( ( Digitrcb[n,j3] * digitrcb[n,j2] ) <> [] )                and ( ( Digitrcb[n,j3] * digitrcb[n,j2] ) <> ( digitrcb[n,j] * digitrcb[n,j2] ) )                and ( digitrcb[n,j3] * digitrcb[n,j2]  * digitrcb[n,j] = [])                 then                  for j4:= 0 to 26 do                   if (j4 in ((peerrcb[j3]+[j3] ) - [j]) )                   and (Digitrcb[n,j4] <> [] )                   and (digitrcb[n2,j4] <> [])                   and ((digitrcb[n,j4] * digitrcb[n,j3]) <> (Digitrcb[n,j3] * digitrcb[n,j2] ) )                    then                    for xn2:= 0 to 80 do                     if  (xn2 in (digitrcb[n,j3] * digitrcb[n2,j3]))                     and ((digitrcb[n,j3] * digitrcb[n,j2]) + [xn2] = digitrcb[n,j3])                    then                     for j5:= 0 to 26 do                      if (j5 in ((peerrcb[j4]* peerrcb[j]))  )                        and ( digitrcb[n2,j5] <> [])                        and ( ( digitrcb[n2,j5] * digitrcb[n2,j4] )  <> [] )                        and ( ( ( digitrcb[n2,j4] * digitrcb[n2,j5] ) + [xn2] )= digitrcb[n2,j4] )                        and (xn in digitrcb[n,j5])                        and not (xn in (digitrcb[n2,j4] * digitrcb[n2,j5]) )                        then                        {elimination check}                        if (( (peer[xn] * (digitrcb[n2,j5] * digitrcb[n2,j4] )) =  (digitrcb[n2,j5] * digitrcb[n2,j4] ))                        and (n2 in pm[xn]))                        or  ((((digitrcb[n,j5] * digitrcb[n,j4]) - [xn2] ) * ((digitrcb[n2,j5] * digitrcb[n2,j4]) - [xn2] ) <> [])                        and (sec[j4,n2] = 2)  )                          then                          begin                           active:=true;                                               if ((peer[xn] * (digitrcb[n2,j5]*digitrcb[n2,j4] )) =  (digitrcb[n2,j5]*digitrcb[n2,j4] ))                            and (n2 in pm[xn])                            then                            begin                                                        covered2[n2]:= covered2[n2] - [xn];                            end;                          if  (sec[j4,n2] = 2)                            and (((digitrcb[n,j5] * digitrcb[n,j4]) - [xn2] ) * ((digitrcb[n2,j5] * digitrcb[n2,j4]) - [xn2] ) <> [])                             then                               begin                                 covered2[n]:= covered2[n] - ((digitrcb[n2,j5] * digitrcb[n2,j4]) - [xn2] );                                                           end;                                                   end;end; {L2 wings}`

XY - Wing
Hidden Text: Show
Code: Select all
` barns(1,3,1)`

XYZ - Wing
Hidden Text: Show
Code: Select all
` barns(1,3,2) `

WXYZ - wing
Hidden Text: Show
Code: Select all
` barns(1,4,0) `

Barn(s)
Hidden Text: Show
Code: Select all
`procedure Barns(K,M,Q:integer);typehold = array of integer;base = array of numberset;base2 = array of integer;hold2 = array of RCBpeer;varp,S,F,C,w,j,a,b,z,lx,x,g,l,r,count:integer;xs:nums;z1:nums;p2:numberset;lx1:numberset;h: hold;step: base;loc: base2;List: hold2;begin If M = 0  then   L:= 2  else  L:=M;repeatfor p:= 0 to 80 do  if  ( (q = 1) and (nm[p] = 2 ) )  or ( (q = 2) and (nm[p] = 3 ) )  or ( (q = 0) and (nm[p] <=l ) )   then  begin  case L of       1: begin s:=0; F:=8; end;       2: begin s:=9;  F:=44; end;       3: begin s:=45;  F:=128; end;       4: begin s:=129; F:=254;  end;       5: begin s:=255; F:=380; end;       6: begin s:=381; F:=464; end;       7: begin s:=465; F:=500; end;       8: begin s:=501; F:=509; end;       9: begin s:=510; F:=511; end;      end; {Case L}  for C:= s to f do   if  ( pm[p] * Comboset[c] =  pm[p] )   and ( Pm[P] - Comboset[C] = [] )   and ( pm[p] <> [])     then      begin        w:=0; { step count}        setlength(h,w+1);        H[w]:=19;   {starting cell position}        setlength(step,(w+1));   {set the array size to w}        setlength(list,(W+1));    {sets the array size to w}      // setlength(loc,(w+1));  {starting cell}     // loc[w]:=p;       list[w]:=  [Rx[p]] + [(Cy[p]+9)]+ [(Bxy[P]+18)] ; {records active sectors}       step[w]:=[p];  { keeps track of what cells are used at each step W }           repeat            for J:= h[w] downto 0 do             begin               if  ( pm[peer2[p,j]] * Comboset[c] =  pm[peer2[p,j]] )               and ( Pm[Peer2[p,j]] - Comboset[C] = [] )               and ( pm[peer2[p,j]] <> [])               and ( [peer2[p,j]] * step[w] = [])               and ( nm[peer2[p,j]] <= l)                  then                   begin                   inc(w);  {increase step count}                   setlength(h,w+1);   {increase lenght of step starting point array}                  // setlength(loc,(w+1));  {starting cell}                  // loc[w]:=peer2[loc[w-1],j];                  setlength(list,(W+1));                   list[w]:=list[w-1] + [Rx[peer2[p,j]]] + [Cy[peer2[p,j]]+9] + [BXY[peer2[p,j]]+18];                   H[w]:=j-1;                   setlength(step,(w+1));   {set the array size to w}                   step[w]:=step[w-1] + [ peer2[p,j] ] ;  { keeps track of what cells are used at each step W }                   end                  else                   dec(H[w]);               if W = (l-1)                then                 begin                     for a:= 0 to 25 do                      if (RCBnum[a]*step[w] <> [] )                        and (A in list[w] )                        then                         begin                         for B:=  a+1 to 26 do                         if (B in List[w] )                           then                           if  ( RCBnum[B] * step[w] <> [])                           and (( (RCBnum[b]  + RCBnum[a] ) * step[w]) = step[w])                           and ( (RCBnum[a] - RCBnum[b]) * step[w] <> [] )                           and ( (RCBnum[b] - RCBnum[a]) * step[w] <> [] )                            then                             begin                               lx1:=[];                               z1:=[];                              for Z in comboset[c]  do                              if  ( ( (digitrcb[z,a] * step[w] ) <> [])                                 or ( (digitrcb[z,b] * step[w] ) <> [])      )                                   then                                     for  lx in ( LIST[W] ) do                                      if                                         ( ( (digitRCB[z,a] * digitRCB[z,lx] * step[w]) <> [])                                         or                                           ( (digitRCB[z,b] * digitRCB[z,lx] * step[w]) <> []) )                                      and ( (( DigitRCB[z,b] + DigitRCB[z,a]) * digitrcb[z,lx] * step[w])   =  ( (digitrcb[z,a] + digitrcb[z,b]) * step[w] ) )                                        then                                          begin                                           lx1:=lx1+[lx];                                           z1:=z1+[z];                                          end;                                       if (L - (popcnt(dword(z1)) )  = 1  )                                        then                                        begin                                          xs:=[];                                          p2:=[];                                         for x in (comboset[c]  - z1)  do                                         if  ( (digitrcb[x,a] * step[w] ) <> [])                                           and  ( (digitrcb[x,b] * step[w] ) <> [])                                            then                                             begin                                             xs:=xs+[x];                                             p2:= p2 + (( DigitRCB[x,a] + digitrcb[x,b] )*step[w]) ;                                             end;                                         if (p2  <> [] ) and (xs <> [])  and (z1 <> [])      {rule 1, peer cells visbile to all + candidates may be elimianted}                                          then                                          begin                                            for g in ([0..80] - step[w] ) do                                         if ( peer[g] * p2 = p2)                                          and (pm[g] * xs <> [])                                          then                                           begin                                             active:=true;                                            covered[g]:=covered[g] - xs;                                                                                     end;                                           end;                                           {rule 2                                            when  any cell that contains a RCC and contains only  the + candidate and it directly sees all + candidtes; then                                             all cells visible to all the RCC of that number may be excluded for that number. }                                           if (p2 <> []) and (xs <> [])                                           then                                             for G in (p2) do                                               for x in z1 do                                                  if (pm[g] = xs + [x])                                                   and( (peer[g] * p2 ) + [g] = p2  )                                                   then                                                    begin                                                     for  r in ([0..80] - step[w] ) do                                                      if (peer[r] * ((digitRcb[x,a] + digitrcb[x,b]) * (step[w] ) ) =  ((digitRcb[x,a] + digitrcb[x,b]) * (step[w] ) ))                                                     and (x in pm[r]   )                                                      then                                                      begin                                                    active:= true;                                                    covered[r]:= covered[r] - [x];                                                      end;                                                    end;                                       end;  {end count =1}                       if (popcnt(dword(z1))  = L )  and (Z1  = comboset[c])                             then                                begin                                    active:=true;                                                                        for G in (z1*comboset[c]) do                                           begin                                                                                       p2:=(digitrcb[g,a]+digitrcb[g,b])*step[w];                                            for x in  ([0..80] - step[w]) do                                               if (peer[x] * p2  = p2  )                                              and  (g in pm[x] )                                              then                                               begin                                                covered[x]:= covered[x] - [g];                                                                                           end;                                              end;                                  end; {count = 0 }                                 end; {b}                              end;  {a}                 end;               if (W = (L-1)) or (( W>0) and (H[w]= -1))   {back track sequence}                 then                 begin                   repeat                   Dec(w);  {decrese step count}                   setlength(h,w+1);   {reduce lenght of step starting point array}                   //setlength(loc,(w+1));  {starting cell}                   setlength(list,(w+1));                   dec(h[w]);                   setlength(step,(w+1));   {set the array size to w}                   until   (H[w]> -1) or (w=0)                 end;              end;             until  (h[W] = -1)       end;    end; if m = 0  then  inc(L); until (L = m) or (L > 9);  end; {bent almost naked sets}`

Unique Rectangles type 1-6
Hidden Text: Show
Code: Select all
` Code not implemented in current build `

Hidden Unique Rectangles
Hidden Text: Show
Code: Select all
` Code not implemented in current build `

ALS - xz & double linked rule
Hidden Text: Show
Code: Select all
`procedure alsxz(k:integer);varq,xn,xn2,L,l2,J,j2,s,s2,s3,s4,f,f2,f3,f4,yn,yn2,yn3,yn4,n,z,x,ACT,ACT2,g,r:integer;A:nums;a2:numberset;B:nums;B2:numberset;z1:nums;lx1: rcbpeer;begin for xn:= 0 to 26 do    for L:= 1 to 8 do      begin       J:= l+1;      case L of       1: begin s:=0; F:=8; end;       2: begin s:=9; F:=44; end;       3: begin s:=45; F:=128; end;       4: begin s:=129; F:=254; end;       5: begin s:=255; F:=380; end;       6: begin s:=381; F:=464; end;       7: begin s:=465; F:=500; end;       8: begin s:=501; F:=509; end;       9: begin s:=510; F:=511; end;      end; {Case L}      for yn:= S to f do       begin         A:=[];         a2:=[];         ACT:=0;         lx1:=[];         for n:= 0 to 8 do          if (n in comboset2[yn] )             and (Sectorrc[xn,n] <> [])              then               begin               A:= a+ sectorRC[xn,n]; {#'s}               INC(ACT);               a2:=a2+ sectorrcb[xn,n]; {cell's}               lx1:= lx1 + peerrcb[Rx[secset[xn,n]]] + peerrcb[Cy[secset[xn,n]]] + peerrcb[Bxy[secset[xn,n]]];               end;      case J of       1: begin s2:=0; F2:=8; end;       2: begin s2:=9; F2:=44; end;       3: begin s2:=45; F2:=128; end;       4: begin s2:=129; F2:=254; end;       5: begin s2:=255; F2:=380; end;       6: begin s2:=381; F2:=464; end;       7: begin s2:=465; F2:=500; end;       8: begin s2:=501; F2:=509; end;       9: begin s2:=510; F2:=511; end;      end; {Case J}if  (ACT = L) then   for yn2:= S2 to F2 do       if A = comboset[yn2]         then           begin             for xn2 in ( lx1)   do                for L2:= 1 to 8 do      begin       J2:= l2+1;      case L2 of       1: begin s3:=0; F3:=8; end;       2: begin s3:=9; F3:=44; end;       3: begin s3:=45; F3:=128; end;       4: begin s3:=129; F3:=254; end;       5: begin s3:=255; F3:=380; end;       6: begin s3:=381; F3:=464; end;       7: begin s3:=465; F3:=500; end;       8: begin s3:=501; F3:=509; end;       9: begin s3:=510; F3:=511; end;      end; {Case L}      for yn3:= S3 to f3 do      begin         B:=[];         B2:=[];         act2:=0;         for n:= 0 to 8 do            if (n in comboset2[yn3])              AND (sectorRC[xn2,n] <> [])              then               begin               b:= b+ sectorRC[xn2,n];               inc(act2);               b2:=b2+ sectorrcb[xn2,n];             end;      case J2 of       1: begin s4:=0; F4:=8; end;       2: begin s4:=9; F4:=44; end;       3: begin s4:=45; F4:=128; end;       4: begin s4:=129; F4:=254; end;       5: begin s4:=255; F4:=380; end;       6: begin s4:=381; F4:=464; end;       7: begin s4:=465; F4:=500; end;       8: begin s4:=501; F4:=509; end;       9: begin s4:=510; F4:=511; end;      end; {Case J}  if  ( A2 - b2 <> [])  and ( b2 - a2 <> [])  and (act2 = l2)   then    for yn4:= S4 to F4 do    if  (popcnt(dword((comboset2[yn4]*Comboset2[yn2]) ) )   >1 ) {checks that 2nd set of digits shares >=2 digits with first set}       then       if b = comboset[yn4]         then           begin            z1:=[];            z1:=[];              for q in (peerrcb[xn] + peerrcb[xn2] )  do                 for z in (comboset[yn4]*comboset[yn2]  ) do                   if  ( ((digitrcb[z,xn] * a2) * (digitrcb[z,q])) - (a2*b2)  <> []  )                   and  ( ((digitrcb[z,xn2] * b2) * digitrcb[z,q]) - (a2*b2) <> []  )                   and   ( ( digitRCB[z,q] * (a2+b2 ) - (a2*b2)  ) = ( (DigitRCB[z,xn]*a2 ) + (Digitrcb[z,xn2]*b2) ) )                   then                      begin                        z1:=z1+[z];                                       for R in ((comboset[yn4] * comboset[yn2])  - [z]) do                       if (DigitRCB[R,xn] *A2 <> []  )                       and (DigitRCB[R,xn2] * B2 <> [] )                        then                         begin                         active:=true;                                                  for x in [0..80] - (A2+B2)  do                          if  (peer[x]  * ( ( DigitRCB[R,xn] + DigitRCB[R,xn2] ) * (A2+B2)) =  (( DigitRCB[R,xn] + DigitRCB[R,xn2] ) * (A2+B2)) )                          and ( R in pm[x] )                             then                              begin                              active:=true;                              covered[x]:= covered[x] - [r];                                                         end;                         end;                                        end;   {mutiple q sectors for mutiple restircted commons}          if popcnt(dword(z1)) >1          then           begin                       for R in ((comboset[yn4] + comboset[yn2])  - z1) do                       if (DigitRCB[R,xn] *A2 <> []  )                       or (DigitRCB[R,xn2] * B2 <> [] )                        then                         begin                         active:=true;                                                for x in [0..80] - (A2+B2)  do                          begin                          if  (peer[x]  * ( ( DigitRCB[R,xn] + DigitRCB[R,xn2] ) * (A2+B2)) =  (( DigitRCB[R,xn] + DigitRCB[R,xn2] ) * (A2+B2)) )                            and ( R in pm[x] )                             then                              begin                              covered[x]:= covered[x] - [r];                                                       end;                          if  (peer[x] *  ( DigitRCB[R,xn]  * A2) =  ( DigitRCB[R,xn]  * A2) )                            and ( R in pm[x] )                            and (DigitRCB[R,xn] * A2 <> [])                             then                              begin                              active:=true;                              covered[x]:= covered[x] - [r];                                                         end;                           if  (peer[x]  *  ( DigitRCB[R,xn2]  * b2) =  ( DigitRCB[R,xn2]  * B2) )                            and ( R in pm[x] )                            and (DigitRCB[R,xn2] * B2 <> [])                             then                              begin                              active:=true;                              covered[x]:= covered[x] - [r];                                                         end;                          end;                           end;             end; {dual link elimiantions}           end; {yn4}        end;{yn3}       end;{xn2}      end;    {yn2}   end; {yn} end;  {xn}end;{als -xz rule}`

AHS - XZ & double linked rule
Hidden Text: Show
Code: Select all
` Code not implemented in current build `

Als - xy rule
Hidden Text: Show
Code: Select all
`procedure alsxy(k:integer);varq,xn,xn2,xn3,L,l2,l3,J,j2,j3,s,s2,s3,s4,s5,s6,f,f2,f3,f4,f5,f6,yn,yn2,yn3,yn4,yn5,yn6,n,z,x,ACT,ACT2,act3,g,r,q2,z2:integer;A:nums;a2:numberset;B:nums;B2:numberset;c:nums;c2:numberset;z1:nums;lx1: rcbpeer;lx2: rcbpeer;begin for xn:= 0 to 26 do    for L:= 1 to 8 do      begin       J:= l+1;      case L of       1: begin s:=0; F:=8; end;       2: begin s:=9; F:=44; end;       3: begin s:=45; F:=128; end;       4: begin s:=129; F:=254; end;       5: begin s:=255; F:=380; end;       6: begin s:=381; F:=464; end;       7: begin s:=465; F:=500; end;       8: begin s:=501; F:=509; end;       9: begin s:=510; F:=511; end;      end; {Case L}      for yn:= S to f do       begin         A:=[];         a2:=[];         ACT:=0;         lx1:=[];         for n:= 0 to 8 do          if (n in comboset2[yn] )             and (Sectorrc[xn,n] <> [])              then               begin               A:= a+ sectorRC[xn,n]; {#'s}               INC(ACT);               a2:=a2+ sectorrcb[xn,n]; {cell's}               lx1:= lx1 + peerrcb[Rx[secset[xn,n]]] + peerrcb[Cy[secset[xn,n]]] + peerrcb[Bxy[secset[xn,n]]];               end;      case J of       1: begin s2:=0; F2:=8; end;       2: begin s2:=9; F2:=44; end;       3: begin s2:=45; F2:=128; end;       4: begin s2:=129; F2:=254; end;       5: begin s2:=255; F2:=380; end;       6: begin s2:=381; F2:=464; end;       7: begin s2:=465; F2:=500; end;       8: begin s2:=501; F2:=509; end;       9: begin s2:=510; F2:=511; end;      end; {Case J}if  (ACT = L) then   for yn2:= S2 to F2 do       if A = comboset[yn2]         then           begin             for xn2 in (lx1)   do                for L2:= 1 to 8 do      begin       J2:= l2+1;      case L2 of       1: begin s3:=0; F3:=8; end;       2: begin s3:=9; F3:=44; end;       3: begin s3:=45; F3:=128; end;       4: begin s3:=129; F3:=254; end;       5: begin s3:=255; F3:=380; end;       6: begin s3:=381; F3:=464; end;       7: begin s3:=465; F3:=500; end;       8: begin s3:=501; F3:=509; end;       9: begin s3:=510; F3:=511; end;      end; {Case L}      for yn3:= S3 to f3 do      begin         B:=[];         B2:=[];         act2:=0;          lx2:=[];         for n:= 0 to 8 do            if (n in comboset2[yn3])              AND (sectorRC[xn2,n] <> [])              then               begin               b:= b+ sectorRC[xn2,n];               inc(act2);               b2:=b2+ sectorrcb[xn2,n];            lx2:= lx2 + peerrcb[Rx[secset[xn2,n]]] + peerrcb[Cy[secset[xn2,n]]] + peerrcb[Bxy[secset[xn2,n]]];             end;      case J2 of       1: begin s4:=0; F4:=8; end;       2: begin s4:=9; F4:=44; end;       3: begin s4:=45; F4:=128; end;       4: begin s4:=129; F4:=254; end;       5: begin s4:=255; F4:=380; end;       6: begin s4:=381; F4:=464; end;       7: begin s4:=465; F4:=500; end;       8: begin s4:=501; F4:=509; end;       9: begin s4:=510; F4:=511; end;      end; {Case J}  if  ( A2 - b2 <> [])  and ( b2 - a2 <> [])  and (act2 = l2)   then    for yn4:= S4 to F4 do    if  (popcnt(dword((comboset2[yn4]*Comboset2[yn2]) ) )   >=1 ) {checks that 2nd set of digits shares >=2 digits with first set}       then       if b = comboset[yn4]         then           begin              for q in (peerrcb[xn] + peerrcb[xn2] )  do                 for z in (comboset[yn4]*comboset[yn2]  ) do                   if  ( ((digitrcb[z,xn] * a2) * (digitrcb[z,q])) - (a2*b2)  <> []  )                   and  ( ((digitrcb[z,xn2] * b2) * digitrcb[z,q]) - (a2*b2) <> []  )                   and   ( ( digitRCB[z,q] * (a2+b2 ) - (a2*b2)  ) = ( (DigitRCB[z,xn]*a2 ) + (Digitrcb[z,xn2]*b2) ) )                   then                      begin                    for xn3 in ([0..26] {lx2 })   do                for L3:= 1 to 8 do      begin       J3:= l3+1;      case L3 of       1: begin s5:=0; F5:=8; end;       2: begin s5:=9; F5:=44; end;       3: begin s5:=45; F5:=128; end;       4: begin s5:=129; F5:=254; end;       5: begin s5:=255; F5:=380; end;       6: begin s5:=381; F5:=464; end;       7: begin s5:=465; F5:=500; end;       8: begin s5:=501; F5:=509; end;       9: begin s5:=510; F5:=511; end;      end; {Case L}      for yn5:= S5 to f5 do      begin         C:=[];         C2:=[];         act3:=0;         for n:= 0 to 8 do            if (n in comboset2[yn5])              AND (sectorRC[xn3,n] <> [])              then               begin               C:= C+ sectorRC[xn3,n];               inc(act3);               C2:=C2+ sectorrcb[xn3,n];             end;      case J3 of       1: begin s6:=0; F6:=8; end;       2: begin s6:=9; F6:=44; end;       3: begin s6:=45; F6:=128; end;       4: begin s6:=129; F6:=254; end;       5: begin s6:=255; F6:=380; end;       6: begin s6:=381; F6:=464; end;       7: begin s6:=465; F6:=500; end;       8: begin s6:=501; F6:=509; end;       9: begin s6:=510; F6:=511; end;      end; {Case J}      if  (( C2 -  b2 ) <> [])        and (( C2 - A2 ) <> [] )        and (act3 = l3)   then    for yn6:= S6 to F6 do    if  (popcnt(dword((comboset2[yn6]*Comboset2[yn4]) ) )   >=1 ) {checks that 2nd set of digits shares >=2 digits with 2nd set}   and (popcnt(dword((comboset2[yn6]*Comboset2[yn2]) ) )   >=1 ) {checks that 2nd set of digits shares >=2 digits with 1st set}       then       if c = comboset[yn6]         then           begin                                 for q2 in (peerrcb[xn2] + peerrcb[xn3])  do                                 for z2 in (comboset[yn6]*comboset[yn4] - [z] ) do                   if  ( ((digitrcb[z2,xn3] * C2) * (digitrcb[z2,q2])) - (C2*b2)  <> []  )                   and  ( ((digitrcb[z2,xn2] * b2) * digitrcb[z2,q2]) - (C2*b2) <> []  )                   and   ( ( digitRCB[z2,q2] * (C2+b2 ) - (C2*b2)  ) = ( (DigitRCB[z2,xn3]*C2 ) + (Digitrcb[z2,xn2]*b2) ) )                   then                      begin                                                    for R in ((Comboset[yn2]*comboset[yn6]) -[z2,z] ) do                             if (DigitRCB[R,xn] * A2 <> []  )                            and (DigitRCB[R,xn3] * C2 <> [] )                        then                         begin                         active:=true;                                                 for x in [0..80] - (A2+B2+C2)  do                          if  (peer[x]  * ( ( DigitRCB[R,xn] + DigitRCB[R,xn3] ) * (A2+C2)) =  (( DigitRCB[R,xn] + DigitRCB[R,xn3] ) * (A2+C2)) )                          and ( R in pm[x] )                             then                              begin                              active:=true;                              covered[x]:= covered[x] - [r];                                                         end;                         end;                         end;   {q2 }                         end; {yn6 }                        end; {yn5}                      end; {xn3}                   end;   {mutiple q sectors for mutiple restircted commons}           end; {yn4}        end;{yn3}       end;{xn2}      end;    {yn2}   end; {yn} end;  {xn}end;{als -xy rule}[/hidden]`

XY- Chain {remote pairs } [hidden]
Code: Select all
` procedure xychain;  {also hits remote pairs}typeact = array of integer;hold = array of integer;base = array of integer;digit = array of integer;varxn,w,p,p2,p3,n,n2:integer;a:act;h:hold;step: base;z:digit;beginsetlength(a,0);setlength(h,0);setlength(step,0);setlength(z,0);for xn:= 80 downto 0 do    {startin cell} if (nm[xn] = 2)  then     for n:= 1 to 9 do       if  N in pm[xn]         then begin  w:=0;    {step count}  setlength(z,(w+1));  z[w]:=n;  setlength(h,(w+1));  {set the array size to w}  h[w]:=19;        {keeps track of what peer is being used for step W }  setlength(step,(w+1));   {set the array size to w}  step[w]:=xn;  { keeps track of what cells are used at each step W }  setlength(a,0);  {resets the grid as its a "new starting point" }  setlength(a,81);   a[xn]:=1;   {keeps track of what grid digs have been selected already}   repeat    for p:= h[w] downto 0 do    {iteration of peers}      if (a[peer2[step[w],p]] = 0)      and (nm[peer2[step[w],p]]=2)        { if grid digit is not used }      and ( Z[w] in pm[peer2[step[w],p]] )       then         begin           n2:=0;           repeat             n2:=n2+1;           until ((n2 <> z[w]) and (N2 in pm[peer2[step[w],p]]));          h[w]:=h[w]-1;    { advance the peer count for step w}          inc(w);        {increase the step count}          setlength(z,(w+1));          z[w]:=n2;          setlength(h,(w+1));          setlength(step,(w+1));     {increse the array size  to w}          step[w]:=peer2[step[(w-1)],p];   {set the step cell active for the newly created step w}          a[peer2[step[(w-1)],p]]:=1;   {activate the cell as used on the grid}          h[w]:=19;  {set the peer count for the new step w as 19}          break;        end       else         h[w]:=h[w]-1;  {if the above is fasle then advance the peer number}    if ((h[w] < 0 ) and (w > 0))       {applies eliminations}      and (z[w] in pm[xn] )  and (z[w] <> n)         then            for p2:= 0 to 19 do              for p3:= 0 to 19 do                 if ((peer2[xn,p2]) = (peer2[step[w],p3]))  and (a[peer2[xn,p2]]=0)                  then                   begin                    active:=true;                    covered[peer2[xn,p2]]:= covered[peer2[xn,p2]]  - [ z[w] ] ;                   end;  { if ((h[w] < 0 ) and (w > 0))      and (z[w] in pm[xn])  and (z[w] <> n) and ( z[w-1] in pm[step[w]] )         then          for p2:= 0 to 19 do           if peer2[xn,p2] = step[w]            then             begin                writexy(2,60,'xy - loop');                determins if the found chains is actually a loop                elimination code  is not added                 as its covered by succesive runs of the chain code as is:             end;    }    if ((h[w] < 0 )  and (w > 0 ))  {the following resets the step to the previous state}     then      begin       w:=(w-1);       setlength(z,(w+1));       setlength(h,(w+1));       setlength(step,(w+1));       setlength(a,0);       setlength(a,81);        for p:= 0 to w do         a[step[p]]:=1;      end;    until (w = 0) and (h[w] < 0) end;end;`

Sue De Coq
Hidden Text: Show
Code: Select all
`procedure Suedecoq(K,M,Q:integer);typehold = array of integer;base = array of numberset;base2 = array of integer;hold2 = array of RCBpeer;varp,S,F,C,w,j,a,b,z,lx,x,g,l:integer;z1:nums;p2,lx1:numberset;h: hold;step: base;loc: base2;List: hold2;begin If M = 0  then   L:= 2  else  L:=M;repeatfor p:= 0 to 80 do if  ( (q = 1) and (nm[p] = 2 ) )  or ( (q = 2) and (nm[p] = 3 ) )  or ( (q = 0) and (nm[p] <= L ) )  then  begin  case L of       1: begin s:=0; F:=8; end;       2: begin s:=9;  F:=44; end;       3: begin s:=45;  F:=128; end;       4: begin s:=129; F:=254;  end;       5: begin s:=255; F:=380; end;       6: begin s:=381; F:=464; end;       7: begin s:=465; F:=500; end;       8: begin s:=501; F:=509; end;       9: begin s:=510; F:=511; end;      end; {Case L}  for C:= s to f do   if  ( pm[p] * Comboset[c] =  pm[p] )   and ( Pm[P] - Comboset[C] = [] )   and ( pm[p] <> [])     then      begin        w:=0; { step count}        setlength(h,w+1);        H[w]:=19;   {starting cell position}        setlength(step,(w+1));   {set the array size to w}        setlength(list,(W+1));    {sets the array size to w}       // setlength(loc,(w+1));  {starting cell}       list[w]:=  [Rx[p]] + [(Cy[p]+9)]+ [(Bxy[P]+18)] ; {records active sectors}       step[w]:=[p];  { keeps track of what cells are used at each step W }        //loc[w]:=p;           repeat            for J:= h[w] downto 0 do             begin               if  ( pm[peer2[p,j]] * Comboset[c] =  pm[peer2[p,j]] )               and ( Pm[Peer2[p,j]] - Comboset[C] = [] )               and ( pm[peer2[p,j]] <> [])               and ( [peer2[p,j]] * step[w] = [])               and ( nm[peer2[p,j]] <=l)                  then                   begin                   inc(w);  {increase step count}                   setlength(h,w+1);   {increase lenght of step starting point array}                 //  setlength(loc,(w+1));  {starting cell}                 // loc[w]:=peer2[loc[w-1],j];                   setlength(list,(W+1));                   list[w]:=list[w-1] + [Rx[peer2[p,j]]] + [Cy[peer2[p,j]]+9] + [BXY[peer2[p,j]]+18];                   H[w]:=j-1;                   setlength(step,(w+1));   {set the array size to w}                   step[w]:=step[w-1] + [ peer2[p,j] ] ;  { keeps track of what cells are used at each step W }                   end                  else                   dec(H[w]);               if W = (l-1)                then                 begin               {   writexy(2,25,'cells used');                  for g:= 0 to 80 do                   if g in step[w]                    then write(' ,',g);   }                     for a in list[w] do                      if (RCBnum[a]*step[w] <> [] )                        then                         begin                         for B in ( List[w]-[a] )  do                           if ( RCBnum[B] * step[w] <> [])                           then                           if (( (RCBnum[b]  + RCBnum[a] ) * step[w]) = step[w])                           and ( (RCBnum[a] - RCBnum[b]) * step[w] <> [] )                           and ( (RCBnum[b] - RCBnum[a]) * step[w] <> [] )                            then                             begin                               lx1:=[];                               z1:=[];                              for Z in comboset[c]  do                                 if ( ( (digitrcb[z,a] * step[w] ) <> [])                                 or  ( (digitrcb[z,b] * step[w] ) <> [])     )                                   then                                     for  lx in list[w]  do                                       if                                        (  ( (digitRCB[z,a] * digitRCB[z,lx] * step[w]) <> [])                                        or                                      ( (digitRCB[z,b] * digitRCB[z,lx] * step[w]) <> [])  )                                      and ( (( DigitRCB[z,b] + DigitRCB[z,a]) * digitrcb[z,lx] * step[w])  =  ( (digitrcb[z,a] + digitrcb[z,b]) * step[w] ) )                                        then                                          begin                                           lx1:=lx1+[lx];                                           z1:=z1+[z];                                          end;                       if (popcnt(dword(z1))   = L )  and (Z1 = comboset[c])                             then                                begin                                    active:=true;                                 {   writexy(2,60,' Sue De Coq');                                         writexy(2,26,'Sector A: ');                                         write(A);                                         writexy(2,27,'Sector B: ');                                         write(B,' ');                                         writexy(2,28,'resticted common: ');                                         for g:= 1 to 9 do                                         if g in z1 then  write(g,' ');                                         writexy(2,29,'L sector: ');                                         for g:= 0 to 26 do                                          if g in lx1 then  write(g,' ');                                         writeln('z:= ');   }                                         for G in (z1*comboset[c] )   do                                           begin                                          {  write(G,'  @: ');  }                                            p2:=(digitrcb[g,a]*step[w]) +( digitrcb[g,b]*step[w]);                                            for x in ([0..80] - step[w])  do                                            if (peer[x] * p2  = p2  )                                            and  (g in pm[x] )                                              then                                               begin                                                covered[x]:= covered[x] - [g];                                               { write(x,' ');  }                                               end;                                           end;                                  end; {count = 0 }                                 end; {b}                              end;  {a}                 end;               if (W = (L-1)) or (( W>0) and (H[w]= -1))   {back track sequence}                 then                 begin                   repeat                   Dec(w);  {decrese step count}                   setlength(h,w+1);   {reduce lenght of step starting point array}                  // setlength(loc,(w+1));  {starting cell}                  setlength(list,(w+1));                   dec(h[w]);                   setlength(step,(w+1));   {set the array size to w}                   until   (H[w]> -1) or (w=0)                 end;              end;             until  (h[W] = -1)       end;    end; if m = 0  then  inc(L); until (L = m) or (L > 9);  end; {sue de coq}`
Last edited by StrmCkr on Fri Feb 10, 2017 7:54 am, edited 12 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### timer function, and main body code

Function Timer for solving technique execution times
Hidden Text: Show
Code: Select all
`//  command functionsProcedure time(v:char);var st,et,hz:int64;      ms:double;beginsetlength(techwrite,0,0);sbrc;queryperformancecounter (st);case v of#59: Hs(0);#84: Ns(0);#61: Hp(0);#86: Np(0);#62: Ht(0);#87: Nt(0);#63: Hq(0);#88: Nq(0);#89: barns(1,3,1,3); {xy-wing}#90: barns(1,3,2,3); {xyz-wing}#91: barns(1,4,0,4); {wxyz-wing}#60: blr(0);#85: xwing(0);#64: smashi(0);  {skyscrappers, finned & shashimi x-wings}#65: er(0);#66: kyte(0);#67: Swordfish(0);#92: smashiswords(1);#68: jellyfish(0);#93: smashijelly(1);#122: transbarns(1,3,1,3); {T-xy-wing}#117: transbarns(1,3,2,3); {T-xyz-wing}#113: transbarns(1,4,0,4); {T-wxyz-wing}#133: Wwing(0);#137: iWwing(0);#135: mwing(0);#134: swing(0);#0138: l1wing(0);#136: Lwing(0);#095: H1wing(0);#110: H2wing(0);#78:  H3wing(0);#14:  H45wing(0);{#117: URt12456;#104: HUR; }#120: XYchain;#97: alsxz(0);#104: Ahsxz(0);#121: alsxy(1);#98: Barns(1,0,0,6);#116: transbarns(1,0,0,6);#103: transalsxz(1);#107: transalsxy(1);#100: Suedecoq(1,0,9);#106: DDS(1,0,6);#111: ADDS(1,0,6);#109: MSLS(1);#118: TransADDS(1,0,6);#119: Transxychain;#102:fishfinder(3,3);//#116: fishfinder2(5,5);#24: aic(1);#96:  solve;//#06: bruteforce;#99: issomorph('0','s','f');#112: potential;end;      queryperformancecounter (et);      queryperformancefrequency (hz);      ms := (et - st) * 1000.0 / hz;      gotoxy(1,54);      write( 'Total cpu time = ');      gotoxy(1,55);      write(ms:16:8,' millieseconds');      ms := 1 * 1000.0 / ms;      gotoxy(1,57);      write( 'Solving rate = ');      gotoxy(1,58);      write(ms:16:8,' puzzles / second');if active= truethen begin  sbrc;  wpm(1); end;errorcheck;if unique = false  then   begin   textcolor(red);   writexy(28,24,'Error');   end; if unique = True  then   begin   textcolor(yellow);   writexy(28,24,'Valid');   end;textcolor(col2);end;`

Main program:
Hidden Text: Show
Code: Select all
`program test;  uses crt,windows;//main bodybeginClrscr;Window(1,1,220,80);displayTechnique;peers;RCBpeers;combo;lookupSectorRBC;initiate;setpm;sbrc;TextBackGround(COLBG);viewgiven;viewpm;help;wpm(0);x:=0; y:=0; repeat     curser( rset[x,y] ,COLBG,1);     ch:=readkey;    if( ch=' ' )then ch:='0';    if( ch in ['1'..'9']) then      begin       if s[rset[x,y]] <> []        then         begin                rd[rx[rset[x,y]]]:= rd[rx[rset[x,y]]] + s[rset[x,y]];                cd[cy[rset[x,y]]]:= cd[cy[rset[x,y]]] + s[rset[x,y]];                bd[bxy[rset[x,y]]]:= bd[bxy[rset[x,y]]] + s[rset[x,y]];                s[rset[x,y]]:=[ord(ch) - ord('0')];          end        else           s[rset[x,y]]:= [ord(ch) - ord('0')];        setpm;        sbrc;       // wpm(0);       wpm3(rset[x,y],0);      end;        {functions}      {delete charcter in cell}    if ( ch=#8 ) or ( ch=#83 ) or (ch='0')     then      begin          for iter in peer[rset[x,y]]  do           Ipm[iter]:= ipm[iter] + S[rset[x,y]];          ipm[rset[x,y]]:=[1..9];          rd[rx[rset[x,y]]]:=rd[rx[rset[x,y]]]+s[rset[x,y]];          cd[cy[rset[x,y]]]:=cd[cy[rset[x,y]]]+s[rset[x,y]];          bd[bxy[rset[x,y]]]:=bd[bxy[rset[x,y]]]+s[rset[x,y]];          s[rset[x,y]]:=[];          //Ipm[rset[x,y]]:= ;         setpm;         sbrc;         wpm3(rset[x,y],0);         //wpm(0);      end;     {import file}    if( ch=#105 ) then import;     {save grid to file}    if( ch=#83 ) then begin save; end;     {load from saved grid }    if( ch=#76 ) then begin load;  setpm; sbrc; wpm(1); end;      {save pm to file}    if( ch=#115) then begin  savepm; end;     {load pm from saved  }    if( ch=#108 ) then begin  loadpm;  setpm; sbrc; wpm(1); end;    {reset everything}    If( ch=#114 ) then begin initiate; setpm; sbrc; wpm(1); end;    {generate a grid}    if (ch=#71) then begin  generator;  setpm; sbrc; wpm(1) end;     {batch solve mode}    if( ch=#126) then batch;      {bruteforce mode}   { if (ch = #06) then begin bruteforce;  wpm(0); end; CRTl f}   {dancing links}    if (ch = #70) then begin {dlx;  wpm(0);} end;  {shift F}      {clears the pencil mark space to blank }    if (ch = #101) then begin emptypm; setpm; sbrc; wpm(1) end;      {solving buttons}    if ch in [#14,#24,#59,#60,#61,#62,#63,#64,#65,#66,#67,#68,#78,#84,#85,#86,#87,#88,#89,#90,#91,#92,#93,#95,#96,#97,#98,#99,#100,#102,#103,#104,#106,#107,#109,#110,#111,#112,#113,#116,#117,#118,#119,#120,#121,#122,#133,#134,#135,#136,#137,#0138]           then             time(ch);    { arrow keys }    if( ch=#75 ) then Y:=Y-1;    if( ch=#77 ) then Y:=Y+1;    if( ch=#72 ) then x:=x-1;    if( ch=#80 ) then x:=x+1;    { home - end }    if( ch=#71 ) then y:=0;    if( ch=#79 ) then y:=8;    { pageup - pagedown }    if( ch=#73 ) then x:=0;    if( ch=#81 ) then x:=8;    { check position }    if( y<0 ) then y:=8;    if( y>8 ) then begin y:=0; x:=x; end;    if( x<0 ) then x:=8;    if( x>8 ) then x:=0;    { tabs into the pm grid }    if (ch =#9 ) or (ch=#15)      then       repeat        curserpm(rset[x,y],Colbg);        ch:=readkey;        { delete pms }        if( ch in ['1'..'9']) then         begin           for iter:= 1 to 9 do            if iter = ord(ch) - ord('0')             then              delpm[ rset[x,y] ]:=delpm[ rset[x,y] ] - [iter];            sbrc;           // wpm(0);            wpm2(rset[x,y],0);         end;           {resest the pm deletions }         if ( ch=#8 ) or ( ch=#83 ) or (ch='0') then            begin             delpm[ rset[x,y] ]:=[1..9];             Ipm[Rset[x,y]]:=[1..9];             sbrc;             wpm2(rset[x,y],0);            // wpm(0);            end;        { arrow keys }       if( ch=#75 ) then Y:=Y-1;       if( ch=#77 ) then Y:=Y+1;       if( ch=#72 ) then x:=x-1;       if( ch=#80 ) then x:=x+1;        { home - end }       if( ch=#71 ) then y:=0;       if( ch=#79 ) then y:=8;        { pageup - pagedown }       if( ch=#73 ) then x:=0;       if( ch=#81 ) then x:=8;        { check position }       if( y<0 ) then y:=8;       if( y>8 ) then begin y:=0; x:=x; end;       if( x<0 ) then x:=8;       if( x>8 ) then x:=0;     until (ch=#9) or (ch=#15) or (ch=#27);    until (ch=#27);end.`

Solve function
Hidden Text: Show
Code: Select all
`Procedure solve;varCount2,Countpm2: integer;beginrepeatCountpm2:=countpm;count2:= count;if count = 0  then exit;if count = 81 then halt; if  (countpm2 = countpm)  and (count2=count)  then   begin    Hs(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    Ns(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    BLR(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    hp(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    np(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    xwing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    ht(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    nt(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    hq(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,3,1,3);  {xy-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,3,2,3);  {xyz-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    nq(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,4,0,4);  {xyz-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    smashi(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    kyte(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    er(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    swordfish(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    jellyfish(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    smashiswords(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    smashijelly(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) then   begin    wwing(1);     if active= true      then       begin        sbrc;       end;   end; if  (countpm2 = countpm)  and (count2 = count)  then   begin    transbarns(1,3,1,3);     if active= true      then       begin        sbrc;       end;   end;   if  (countpm2 = countpm)  and (count2 = count)  then   begin    transbarns(1,3,2,3);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    mwing(1);     if active= true      then       begin        sbrc;       end;   end;   if  (countpm2 = countpm)  and (count2 = count)  then   begin    transbarns(1,4,0,4);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    swing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    l1wing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    lwing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    h1wing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    h2wing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    h3wing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    h45wing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    iwwing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    xychain;     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,0,0,8);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    suedecoq(1,0,8);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    transbarns(1,0,0,8);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    transxychain;     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) then   begin    alsxz(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) then   begin    ahsxz(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) then   begin    transalsxz(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    alsxy(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    dds(1,0,6);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    adds(1,0,6);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    transadds(1,0,6);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    fishfinder(1,5);     if active= true      then       begin        sbrc;       end;   end;until  (countpm2=countpm) or (count = 81);end;`

Solve version 2 used in generator
Hidden Text: Show
Code: Select all
`Procedure solve2(K:integer);varCount2,Countpm2: integer;beginrepeatCountpm2:=countpm;count2:= count;if count = 81 then halt;if  (countpm2 = countpm)  and (count2 = count)  and (k >0 )  then   begin    BLR(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >8 )  then   begin    hp(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)   and (k >8 )  then   begin    np(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >5 )  then   begin    xwing(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >5 )  then   begin    ht(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)   and (k >5 )  then   begin    nt(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)   and (k >5 )  then   begin    hq(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)   and (k >10 )  then   begin    barns(1,3,1,3);  {xy-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >11 )  then   begin    barns(1,3,2,3);  {xyz-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >5 )  then   begin    nq(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) and (k >12 )  then   begin    barns(1,4,0,4);  {xyz-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >15 )  then   begin    smashi(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >15 )  then   begin    kyte(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) and (k >16 )  then   begin    er(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >16 )  then   begin    swordfish(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >16 )  then   begin    jellyfish(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  and (k >16)  then   begin    smashiswords(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count) and (k >16)  then   begin    smashijelly(1);     if active= true      then       begin        sbrc;       end;   end;until  (countpm2=countpm) or (count = 81)end; `
Last edited by StrmCkr on Wed May 30, 2018 7:24 am, edited 6 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Tools

Issomorphic Transformation
Hidden Text: Show
Code: Select all
` procedure issomorph(K2,B2,F2:char);varK,B,F:char;xn,n:integer;S2:  array [cell] of nums;  {solved grid copy}beginfor xn:= 0 to 80 do s2[xn]:=S[xn];for xn:= 0 to 8 do  begin   Rd[xn]:= [1..9];   Cd[xn]:= [1..9];   Bd[xn]:= [1..9];   covered2[xn+1]:=[0..80];    for n:= 1 to 9 do      begin      // S[rset[xn,(n-1)]]:= [];       delpm[rset[xn,(n-1)]]:= [1..9];       covered[rset[xn,(n-1)]]:= [1..9];      Ipm[rset[xn,(n-1)]]:= [1..9];      end;   end;k:=k2;b:=b2;f:=f2;if not (K in ['d','t','s','b','c','r']) then   beginwritexy(2,25,' Which area to move?');writexy(2,26,'R{ow},C{ol},s{tack},B{and},T{ranspose},D{igit}');K:=readkey;gotoxy(23,25); write(': ',K);   end; case K of{R} #114: begin   if not (B in ['1'..'9'])    then     begin   writexy(2,27,' Which Row to move? {1..9}');   B:=readkey;  write(': ',B);     end;   if not (F in ['1'..'9'])    then     begin   writexy(2,28,' Swaping with Row?');   case B of    #49,#50,#51 : write(' 1,2,3');    #52,#54,#55 : write(' 4,5,6');    #56,#57,#58 : write(' 7,8,9');   end;   F:=readkey; write(': ',F);    end;   for xn:=0 to 8 do    begin    s[Rset[(ord(b)-48)-1,xn]]:= S2[Rset[(ord(f)-48)-1,xn]];    s[Rset[(ord(f)-48)-1,xn]]:= S2[Rset[(ord(b)-48)-1,xn]];    end;  end;  {row}{C} #99: begin  if not (B in ['1'..'9'])    then     begin   writexy(2,27,' Which Col to move? {1..9}');   B:=readkey;  write(': ',B);     end;   if not (F in ['1'..'9'])    then     begin   writexy(2,28,' Swaping with Col?');   case B of    #49,#50,#51 : write(' 1,2,3');    #52,#54,#55 : write(' 4,5,6');    #56,#57,#58 : write(' 7,8,9');   end;   F:=readkey; write(': ',F);    end;   for xn:=0 to 8 do    begin    s[Cset[(ord(b)-48)-1,xn]]:= S2[Cset[(ord(f)-48)-1,xn]];    s[Cset[(ord(f)-48)-1,xn]]:= S2[Cset[(ord(b)-48)-1,xn]];    end; end; {col}{Band} #98: begin    if not (B in ['1'..'3'])    then     begin   writexy(2,27,' Which Band to Swap? {1..3}');   B:=readkey;  write(': ',B);     end;    if not (F in ['1'..'3'])    then     begin   writexy(2,28,' Swaping with Band? {1..3}');   F:=readkey;  write(': ',F);      end;   For xn:= 0 to 8 do    for n:= 0 to 2 do      begin        s[Rset[(((ord(b)-48)-1)*3+n),xn]]:=s2[Rset[(((ord(f)-48)-1)*3+n),xn]];        s[Rset[(((ord(f)-48)-1)*3+n),xn]]:=s2[Rset[(((ord(b)-48)-1)*3+n),xn]];      end; end;  {Band}{stack} #115: begin     if not (B in ['1'..'3'])    then     begin   writexy(2,27,' Which Stack to Swap? {1..3}');   B:=readkey;  write(': ',B);     end;    if not (F in ['1'..'3'])    then     begin   writexy(2,28,' Swaping with Stack? {1..3}');   F:=readkey;  write(': ',F);      end;   For xn:= 0 to 8 do    for n:= 0 to 2 do      begin        s[Cset[(((ord(b)-48)-1)*3+n),xn]]:=s2[Cset[(((ord(f)-48)-1)*3+n),xn]];        s[Cset[(((ord(f)-48)-1)*3+n),xn]]:=s2[Cset[(((ord(b)-48)-1)*3+n),xn]];      end; end; {stack}{Transpose} #116: begin if not(k2 in['t']) then writexy(2,27,' Transposing Grid (main diagonal reflection)'); for xn:= 0 to 8 do  for n:= 0 to 8 do   begin     S[Rset[xn,n]]:=s2[Cset[xn,n]];     s[Cset[n,xn]]:=S2[Rset[n,xn]];    end; end; {Transpose}{D} #100: begin  if not (b in ['1'..'9'] )   then   begin  writexy(2,27,' Which Digit to Swap? {1..9}');   B:=readkey;  write(': ',B);   end;  if not (f in ['1'..'9'] )   then   begin   writexy(2,28,' Swaping with Digit {1..9}');   F:=readkey;  write(': ',F);    end;   For xn:= 0 to 80 do   begin    if S2[xn]= [ord(b)-48 ]      then      s[xn]:=[ord(F)-48];    if S2[xn]= [ord(F)-48 ]      then      s[xn]:=[ord(B)-48];    end; end;   end; setpm; Sbrc; wpm(1);writexy(2,25,'                                               ');writexy(2,26,'                                               ');writexy(2,27,'                                               ');writexy(2,28,'                                               ');end;  {issomorphic transformation}// 46,656 potential  single digit grids.`

Pattern OverLay Method
Hidden Text: Show
Code: Select all
`procedure potential;typehold = array of integer;base = array of numberset;digit = array of numberset;varlocked:  array [digits] of numberset;deleted:  array [digits] of numberset;stuff: array [digits] of numberset;xn,w,p,n,q:integer;output: text;step: base;h: hold;z:digit;beginfor N:= 1 to 9 dobeginlocked[n]:=[];deleted[n]:=[];stuff[n]:= [];for xn:= 0 to 80 do begin  if s[xn] = [n]   then      locked[n]:= locked[n]+ [xn];   if (s[xn] <> [n] ) and not( n in pm[xn])    then     deleted[n]:= deleted[n] + [xn];  end; end;{startin cell}  {delete the exsiting output if you want to rebuild it unhash this sectionassign(output,'C:\sudoku\pom\output.txt');erase(output);rewrite(output);close(output);  }assign(output,'c:\sudoku\pom\exclusions.txt');erase(output);rewrite(output);close(output);{smashes all prebuilt  txt files  of potential solutions for digits 1-9  } for n:= 1 to 9 do  begin    case n of      1: assign(output,'C:\sudoku\pom\1.txt');      2: assign(output,'C:\sudoku\pom\2.txt');      3: assign(output,'C:\sudoku\pom\3.txt');      4: assign(output,'C:\sudoku\pom\4.txt');      5: assign(output,'C:\sudoku\pom\5.txt');      6: assign(output,'C:\sudoku\pom\6.txt');      7: assign(output,'C:\sudoku\pom\7.txt');      8: assign(output,'C:\sudoku\pom\8.txt');      9: assign(output,'C:\sudoku\pom\9.txt');     end;erase(output);rewrite(output);close(output);end;setlength(step,0);setlength(z,0);setlength(h,0); for xn:= 80 downto 72 do  begin  w:=0;    {step count}  setlength(h,(w+1));  {set the array size to w}  h[w]:=xn;        {starting point for first substep}  setlength(step,(w+1));   {set the array size to w}  step[w]:= [xn];  { keeps track of what cells are used at each step W }  setlength(z,w+1);  {prevent occupy "new starting point" }  z[w]:= peer[xn] + [xn]; {used cells  starting point}   repeat    for p:= h[w] downto (72-((w+1)*9)) do    {iteration of peers}      if  p in ([0..80] - z[w] ) // added check used state       then         begin          h[w]:=h[w]-1;    { advance the peer count for step w}          inc(w);        {increase the step count}          setlength(h,(w+1));          setlength(step,(w+1));     {increse the array size  to w}          step[w]:= step[w-1] + [p] ;   {set the step cell active for the newly created step w}          h[w]:= 71 - ((w)*9) ;  {set the new step w as 71 potential choice cells}          setlength(z,w+1);  { increase size to w}          z[w]:= z[w-1] +  peer[p] + [p]; {used cells  new  point}          break;        end       else          h[w]:=h[w]-1;  {if the above is false then advance the peer number}if w = 8  then   begin {generate the whole list to a specific fileassign(output,'C:\sudoku\pom\output.txt');append(output);for n in step[w] do    write(output,n,' ');    writeln(output);    close(output); } for n:= 1 to 9 do  begin    case n of      1: assign(output,'C:\sudoku\pom\1.txt');      2: assign(output,'C:\sudoku\pom\2.txt');      3:  assign(output,'C:\sudoku\pom\3.txt');      4: assign(output,'C:\sudoku\pom\4.txt');      5: assign(output,'C:\sudoku\pom\5.txt');      6: assign(output,'C:\sudoku\pom\6.txt');      7: assign(output,'C:\sudoku\pom\7.txt');      8:  assign(output,'C:\sudoku\pom\8.txt');      9:  assign(output,'C:\sudoku\pom\9.txt');       end;  if ( step[w]  * locked[n] = locked[n] )  and ( step[w] * deleted[n] = [] )   then     begin       append(output);       for q in (step[w] - locked[n])  do        write(output, q,' ');        writeln(output);        close(output);        stuff[n]:= stuff[n] + (step[w] - locked[n]);     end;end; { N choice} end;   {w=8}    if ((h[w] < 0 )  and (w > 0 ))      or (w=8)      or ( ( [0..80] - z[w] = [] ) and (W < 8) and (w > 0) )       or ( (h[w] < (72 - ( (w+1)*9) ) )  and (w > 0)  )    {the following resets the step to the previous state}     then      repeat      begin       w:=(w-1);       setlength(h,(w+1));       h[w]:= h[w];       setlength(step,(w+1));       setlength(z,w+1);        end;       until   ( w = 0 ) or (h[w] > ((71 - (w+1)*9))  )    until ((w = 0) and (h[w] < 0) ) or  ( ( w = 0) and (h[w] < (72 -( (w+1)*9) ) ) ) end; for n:= 1 to 9 do if  (stuff[n] <> []) and (stuff[n] *  ([0..80]  -  (locked[n] + deleted[n]) ) = stuff[n]) and (  (([0..80]  -  (locked[n] + deleted[n]) ) - stuff[n])  <> [] )  then    begin     assign(output,'C:\sudoku\pom\exclusions.txt');     append(output);        write(output,n, ' @: ');        for xn:= 0 to 80 do        if  ( xn  in  (([0..80]  -  (locked[n] + deleted[n])) - stuff[n]) )         then           write(output,xn,' ');           writeln(output);           close(output);     end;end; `

Grid Generator
Hidden Text: Show
Code: Select all
`procedure generator;typehold= array of integer;Varxn,n,k,g2,w,j:integer;used:numberset;attempt: nums;h:hold;s2: array [cell] of nums;output: text;beginRandomize;For J:= 1 to 1 do {# of grids to generate} begininitiate;setpm;sbrc;//wpm(1);w:=0;setlength(h,0);for k in [0..80] do s2[k]:=[];used:=[0..80];   repeatbegin  xn:= (Random(82) -1);   if (xn in used)   and ((S[xn] = [])  and (nm[xn] > 1) )    then       begin        inc(w);        setlength(h,w+1);        h[w]:=xn;        attempt:=pm[xn];         repeat         n:= Random(10);          if (n in pm[xn] )  and ( n in attempt)            then              begin               attempt:=attempt - [n];               Rd[Rx[xn]]:=  rd[Rx[xn]] + S[xn];               Cd[Cy[xn]]:=  Cd[Cy[xn]] + S[xn];               Bd[Bxy[xn]]:= Bd[Bxy[xn]] + S[xn];               s[xn]:=[n];               setpm;               sbrc;              // wpm(1);errorcheck;              if unique = true               then               begin              solve2(w);               setpm;               sbrc;errorcheck;              // wpm(1);                 end; {solving techniques included}               if unique = true                then                  used:= used - [xn];  {removes cell from selectable}               if  unique = false  {back tracks current selected and implmented digit}                  then                  begin                   Rd[Rx[xn]]:=  rd[Rx[xn]] + S[xn];                   Cd[Cy[xn]]:=  Cd[Cy[xn]] + S[xn];                   Bd[Bxy[xn]]:= Bd[Bxy[xn]] + S[xn];                   s[xn]:=[];                     for k:= 0 to 8 do                     begin                      covered2[k+1]:=[0..80];                       for g2:= 1 to 9 do                        covered[Rset[k,(g2-1)]]:=[1..9];                      end;                     setpm;                    sbrc;                   //wpm(1);                   end; {back track current lvl}              end;        until (unique = true) or (attempt = []);      end;  if (attempt = []) and (unique = true)             then                   begin                   used:= used + [h[w]];                   dec(w);                   setlength(h,w+1);                   xn:=h[w];                   Rd[Rx[xn]]:=  rd[Rx[xn]] + S[xn];                   Cd[Cy[xn]]:=  Cd[Cy[xn]] + S[xn];                   Bd[Bxy[xn]]:= Bd[Bxy[xn]] + S[xn];                   s[xn]:=[];                     for k:= 0 to 8 do                     begin                      covered2[k+1]:=[0..80];                       for g2:= 1 to 9 do                        covered[Rset[k,(g2-1)]]:=[1..9];                      end;                    setpm;                    sbrc;                    //wpm(1)                 end;end;    until (used = []) or (Countpm = 0 ) or (countpm <  count)  or (count + countpm = 81) or (Countpm+count < 81)  or  (countpm <  (81 - count)) ; //wpm(1); if (count+ countpm  =81)  then    begin     for N:= W downto 1 do        begin           xn:=h[n];                   S2[xn]:=s[xn];                   Rd[Rx[xn]]:=  rd[Rx[xn]] + s[xn];                   Cd[Cy[xn]]:=  Cd[Cy[xn]] + s[xn];                   Bd[Bxy[xn]]:= Bd[Bxy[xn]] + s[xn];                   s[xn]:=[];                     for k:= 0 to 8 do                     begin                      covered2[k+1]:=[0..80];                       for g2:= 1 to 9 do                        covered[Rset[k,(g2-1)]]:=[1..9];                      end;                    setpm;                    sbrc;                    //wpm(1);           solve2(w);            setpm;            sbrc;           // wpm(1);           if (count + countpm = 81)             then              begin               // writexy(2,61,'delted a number');                //wpm(1);               end              else               begin                 // writexy(2,61,'undo delete');                   Rd[Rx[xn]]:=  rd[Rx[xn]] + S[xn];                   Cd[Cy[xn]]:=  Cd[Cy[xn]] + S[xn];                   Bd[Bxy[xn]]:= Bd[Bxy[xn]] + S[xn];                   s[xn]:=s2[xn];                   s2[xn]:=[];                     for k:= 0 to 8 do                     begin                      covered2[k+1]:=[0..80];                       for g2:= 1 to 9 do                        covered[Rset[k,(g2-1)]]:=[1..9];                      end;                    setpm;                    sbrc;                    //wpm(1);              end;         END;   end;gotoxy(2,60);assign(output,'C:\sudoku\Generator\Generated.txt'); append(output);  writeln(output);       for k:= 0 to 80 do        if s[k] <> []         then           begin             for G2:= 1 to 9 do               if g2 in s[k]                then                 write(output,g2)           end        else          write(output,'.');       close(output);end; { generate j puzzles}end;`

Batch mode solver
Hidden Text: Show
Code: Select all
` {batch solve a file}procedure batch;varmyfile:text;ior:integer;filename:string;verifygrid:integer;G2,S2:real;st,et,hz:int64;ms:double;Begininitiate;sbrc;wpm(0);G2:=0;S2:=0;    repeat;     writexy(2,26,'                                       ');      writexy(2,26, 'file path ');       readln(filename);           if (filename = ('')) or (filename = ('exit'))            then exit           else        writexy(2,27,'                                       ');        writexy(2,28,'                                       ');        assign(myfile,filename);        ior:= 0;        {\$I-}        reset(myfile);        {\$I+}        IOR:=ioresult;      if Ior <> 0      then      writexy(2,27,'file not found')      else       begin        textcolor(yellow );        writexy(2,15,'Import');        delay(300);        writexy(2,15,'       ');        textcolor(col2);       end;      until IoR = 0;     queryperformancecounter (st);      repeat        begin          initiate;           readln(myfile,Grid);           Verifygrid:= length(Grid);          if verifygrid = 81            then             begin               arange;               g2:=g2+1;               solve;                if Count=81                   then                     s2:=s2+1;              {  if count= 81                then                begin                 writexy(2,60,'active ');                 write(round(g2));                 delay(100);                end;    }                if (count + countpm) <80 then begin wpm(1); break; end;                end;           end;         until eof(myfile);        close(myfile);      queryperformancecounter (et);      queryperformancefrequency (hz);      ms := (et - st) * 1000.0 / hz;      gotoxy(1,54);      write( 'Total cpu time = ');      gotoxy(1,55);      write(ms:16:4,' millieseconds');      ms := G2 * 1000.0 / ms;      gotoxy(1,57);      write( 'Solving rate = ');      gotoxy(1,58);      write(ms:16:4,' puzzles / second');   gotoxy(2,30);   write('Solved ',round(S2),' | ',round(G2),' Puzzles');   end;`
Last edited by StrmCkr on Wed May 30, 2018 7:16 am, edited 2 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

updated:

Barns,
sue de coq,
isomorphic transformation,
xy,xyz,wxyz - wings {via barns coding}

Sector Row/Col/Box lookup

modified the following:
Data storage Space
help screen info
Sets all subset data spaces used by solver
Function Timer for solving technique execution times
Main program
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

added a .pass file to first post containing all current source code.

modified
help screen,
function Timer
main body,
Skyscaper {improved run time}
Box line reduction - found a coding error improved run time

finned/sashimi swordfish { rows & cols types}
Finned/sashimi jellyfish {Rows & cols types}
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

Rebuilt

Box line reduction code - massive code improvements on run time, simplified elimination procedure and reduced cycle counts drastically.
1300 ~ puzzles/second vs 53~k puzzles/second {is my single cycle timer change on a fixed example grid. }

source file changed to include new code:

notes:
sue de cog's and Barns + affiliated types seem to only work on example grids but not singular construction on an empty grid.
have to rebuild the code to sort that issue out.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

tweaked :
empty rectangle section

{minor bug fix }

row or Col with 2 cells ending in same band/stack as the box incorrectly applying eliminations from the selected box

added 2 lines of code only.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

updated:
source file

debugging:
sue de coq's
barn

found the errors in both codes ->> had an extra ";" which bugged the whole elimination section of the code
debugging also found cases that are skipping potential eliminations

Solve function

modified:

help screen
timer
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

### Re: StormDuko

rebuilt

als-xz code - simplified and speed up the code

notes: source not updated yet
Some do, some teach, the rest look it up.

StrmCkr

Posts: 834
Joined: 05 September 2006

Next