## StormDuko

Programs which generate, solve, and analyze Sudoku puzzles

### StormDuko

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

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
Last edited by StrmCkr on Wed Jan 25, 2017 8:01 am, edited 17 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
Joined: 05 September 2006

### Grid space index

Constants
Hidden Text: 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
Hidden Text: 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) );`
Last edited by StrmCkr on Fri Feb 10, 2017 7:28 am, edited 3 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
Joined: 05 September 2006

### Data sets and type cast

Type Definition for data space
Hidden Text: 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}`

Data storage Space
Hidden Text: Show
Code: Select all
`varpeer: array [cell] of numberset;peer2: array [cell,0..19] of integer; {a quick call version to use the peers}comboset: array [0..511] of nums;        { digits }comboset2: array [0..511] of RCbnums;    { 0-8 cells}combosetR: array [rcb,0..511] of numberset;     {cells for row}combosetC: array [rcb,0..511] of numberset;     {cells for col}combosetB: array [rcb,0..511] of numberset;     {cells for box}combosetS: array [sector,0..511] 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} NSector: array[sector] of nums; {function listing all  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;{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}RnSectorNum: array [sector,Digits] of numberset;  {saves cells}BnC: array [Rcb,digits] of RCBnums;   {nums represet Box col }BnR: array [Rcb,digits] of RCBnums;   {nums represet Box 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;`
Last edited by StrmCkr on Fri Feb 10, 2017 7:29 am, edited 3 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
Joined: 05 September 2006

### Displaying txt fuctions

Write to screen
Hidden Text: Show
Code: Select all
`//writing functions grid layout.procedure writexy(x,y:integer; s:string);begin  gotoxy(x,y);  write(s);end;`

move courser around in main Sudoku grid
Hidden Text: Show
Code: Select all
`{moves the cursers n screen in the givens box & displays some info on the cell active}procedure Curser(A,c:integer);varxr,yr:integer;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(BXY[a]+18,' ',Rx[a],' ',Cy[a]+9,' ');  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:=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;`

move mouse courser around Pencil mark box
Hidden Text: Show
Code: Select all
`{moves the curser on screen in the pm's box}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(BXY[a]+18,' ',Rx[a],' ',Cy[a]+9,' ');  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 pencil marks to screen
Hidden Text: Show
Code: Select all
`{writes the pencil marks to screen}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);  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;`

The grid display
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 6');  writexy(42,24,'Vrs .88');  textcolor(COL1);end;`

The pencil mark grid Display
Hidden Text: Show
Code: Select all
`procedure ViewPM; { pm grid }begintextcolor(27);writexy(50,30,'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;`

help screen info
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,25,'ESC : Exit');  textcolor(67);  writexy(58,4,'Keystroke');  textcolor(24);  writexy(51,6,'Movement:');  textcolor(green);  writexy(50,7,'Arrows    - Direction');  writexy(50,8,'Home      - Goto Col 1 on Row');  writexy(50,9,'End       - Goto Col 9 on Row');  writexy(50,10,'Page up   - Goto Row 1 on Col');  writexy(50,11,'Page down - Goto Row 9 on Col');  writexy(50,12,'Backspace - Delete # in cell');  writexy(50,13,'Delete    - Delete # in cell');  Writexy(50,14,'Tab       - Switch PM | Grid');  writexy(50,15,'1 - 9     - Enter # into cell');  textcolor(24);  writexy(51,17,'Functions:');  textcolor(green); { writexy(50,25,'B        - Batch solve');  }  {writexy(50,22,'G        - Generate a Puzzle'); }  writexy(50,18,'~ or `   - Solve');  writexy(50,19,'R        - Reset Grid');  writexy(50,20,'S        - Save Grid String');  writexy(50,21,'s        - Save Pm state');  writexy(50,22,'L        - Load Saved Grid');  writexy(50,23,'l        - Load Saved Pm');  writexy(50,24,'I        - Import a Grid');  writexy(50,25,'C        - Isomorphic ');  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,22,'F          - N x ( N + K ) Fish');   //writexy(81,30,'T          - N x N Fish');  textcolor(24);  writexy(85,24,'Bent Subset Techniques:');  textcolor(green);  writexy(81,25,'Shift + F6  - XY - Wing');  writexy(81,26,'Shift + F7  - XYZ - Wing');  writexy(81,27,'Shift + F8  - WXYZ - Wing');  writexy(81,29,'B           - Barns');  textcolor(24);  writexy(120,24,'Subset Techniques:');  textcolor(green);  writexy(115,25, 'D          - Sue De Coq');  textcolor(24);  writexy(120,1,'Chain Techniques:');  textcolor(green);  writexy(115,2, 'F11         - W-Wing');  writexy(115,3, 'Shift + 11  - M-Wing');  writexy(115,4, 'F12         - S-Wing');  writexy(115,5, 'Shfit + F12 - L-Wing');  writexy(115,7, 'X           - XY Chain');  textcolor(24);  writexy(120,11,'Almost locked Sets Techniques:');  textcolor(green);  writexy(115,12,'A           - ALS - XZ rule');  writexy(115,13,'H           - AHS - XZ rule');  writexy(115,14,'Y           - ALS - XY rule'); { writexy(115,15,'M           - Muti - Set');   }  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');  textcolor(darkgray);  writexy(78,52,'Copyright © Strmckr 2009 ->> 2017');  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(75,64,' < http://www.gnu.org/licenses// > ');  textcolor(col2);end;`

Isomorphic transformations
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];      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, R{ow},C{ol},s{tack},B{and},T{ranspose},D{igit}');K:=readkey;  write(': ',K);   end; case K of{R} #114: begin   if not (B in ['1'..'9'])    then     begin   writexy(2,26,' Which Row to move? {1..9}');   B:=readkey;  write(': ',B);     end;   if not (F in ['1'..'9'])    then     begin   writexy(2,27,' 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,26,' Which Col to move? {1..9}');   B:=readkey;  write(': ',B);     end;   if not (F in ['1'..'9'])    then     begin   writexy(2,27,' 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,26,' Which Band to Swap? {1..3}');   B:=readkey;  write(': ',B);     end;    if not (F in ['1'..'3'])    then     begin   writexy(2,27,' 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,26,' Which Stack to Swap? {1..3}');   B:=readkey;  write(': ',B);     end;    if not (F in ['1'..'3'])    then     begin   writexy(2,27,' 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,26,' 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,26,' Which Digit to Swap? {1..9}');   B:=readkey;  write(': ',B);   end;  if not (f in ['1'..'9'] )   then   begin   writexy(2,27,' 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,'                                                                      ');end;  {issomorphic transformation}`
Last edited by StrmCkr on Fri Feb 10, 2017 7:34 am, edited 6 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
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 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  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]:=[];  RnSectorNum[xn,n]:=[];  RnSectorNum[xn+9,n]:=[];  RnSectorNum[xn+18,n]:=[];  BnR[xn,n]:=[];  BnC[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(RnSectorNum[Rx[xn],n],xn);         include(RnSectorNum[Cy[xn]+9,n],xn);         include(RnSectorNum[Bxy[xn]+18,n],xn);         include(BnR[Bxy[xn],n],Rx[xn]);         include(BnC[Bxy[xn],n],Cy[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);         inc(nm[xn]);         inc(countpm);        end;     end     else        inc(count);   end;end;`

Hidden Text: Show
Code: Select all
`procedure Links;varxn,xn2,n,q,cn:integer;beginfor n:= 1 to 9 do for xn:= 0 to 26 do  for xn2:= 0 to 26 do   begin    sli[n,xn,xn2]:=[];    wli[n,xn,xn2]:=[];   end; for n:= 1 to 9 do  for xn:= 0 to 26 do   if (digitrcb[n,xn] <> [])    then     for xn2:= 0 to 26 do     if  (xn2 in peerrcb[xn])     and (digitrcb[n,xn2] <> [])     and ( (digitrcb[n,xn2] * digitrcb[n,xn]) <> [])      then       begin        cn:=0;        for q:= 0 to 80 do         if q in (digitrcb[n,xn] * digitrcb[n,xn2])          then           inc(cn);        if cn > 1 then         wli[n,xn,xn2]:=(digitrcb[n,xn2] * digitrcb[n,xn]);        if cn = 1 then         sli[n,xn,xn2]:= (digitrcb[n,xn] * digitrcb[n,xn2]);       end;end;{links}`
Last edited by StrmCkr on Fri Feb 10, 2017 7:39 am, edited 3 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
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;`

Hidden Text: Show
Code: Select all
`procedure Linkpeers;varxn,xn2,q,n:integer;beginfor xn:= 0 to 26 do for xn2:= 0 to 26 do  linkpeer[xn,xn2]:=[];for n:= 1 to 1 dofor xn:= 0 to 26 do for xn2:= 0 to 26 do  if xn2 in peerrcb[xn]    then      for q:= 0 to 80 do;       if peer[q] * (digitrcb[n,xn] * digitrcb[n,xn2])  = (digitrcb[n,xn] * digitrcb[n,xn2])        then         linkpeer[xn,xn2]:= linkpeer[xn,xn2] + [q];end;`

Row Col box peers
Hidden Text: Show
Code: Select all
`procedure RCBpeers;varxa,xa2:integer;number1,number2,number3:numberset;number4,number5,number6:RcBpeer;beginfor xa:= 0 to 8 do  begin     number1:=[];     number2:=[];     number3:=[];     number4:=[];     number5:=[];     number6:=[];      For xa2:= 0 to 80 do         begin            if Rx[xa2] = xa               then                begin                include(number1,xa2);                include(number4,cy[xa2]+9);                include(number4,bxy[xa2]+18);                end;            if Cy[xa2] = xa               then                begin                include(number2,xa2);                include(number5,rx[xa2]);                include(number5,bxy[xa2]+18);                end;            if bxy[xa2] = xa               then                begin                include(number3,xa2);                include(number6,cy[xa2]+9);                include(number6,rx[xa2]);                end;         end;         Rnum[xa]:= number1;         Cnum[xa]:= number2;         Bnum[xa]:= number3;         RCBnum[xa]:=number1;         RCBnum[xa+9]:=number2;         RCBnum[xa+18]:=number3;         peerRCB[xa]:=number4;         peerRCB[xa+9]:=number5;         peerRCB[xa+18]:=number6;       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 Thu Jan 05, 2017 11:58 am, edited 1 time in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
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: 753
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;beginsbrc;queryperformancecounter (st);case v of#59: Hs(1);#84: Ns(1);#61: Hp(1);#86: Np(1);#62: Ht(1);#87: Nt(1);#63: Hq(1);#88: Nq(1);#89: barns(1,3,1); {xy-wing}#90: barns(1,3,2); {xyz-wing}#91: barns(1,4,0); {wxyz-wing}#60: blr(1);#85: xwing(1);#64: smashi(1);  {skyscrappers, finned & shashimi x-wings}#65: er(1);#66: kyte(1);#67: Swordfish(1);#92: smashiswords(1);#68: jellyfish(1);#93: smashijelly(1);#133: Wwing(1);#134: mwing(1);#135: swing(1);#136: Lwing(1);{#117: URt12456;#104: HUR; }#120: XYchain;#97: alsxz(1);#104: Ahsxz(1);#121: alsxy(1);#98: Barns(1,0,0);#100: Suedecoq(1,0,0);#102:fishfinder;//#116: fishfinder2(5,5);#96:  solve;#126: solve;#99: issomorph('0','s','f');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;end;`

Main program:
Hidden Text: Show
Code: Select all
`program test;  uses crt,windows;//main bodybeginClrscr;window(1,1,220,80);peers;RCBpeers;combo;lookupSectorRBC;initiate;setpm;sbrc;TextBackGround(COLBG);viewgiven;viewpm;help;wpm(0);x:=0; y:=0; repeat     curser( rset[x,y] ,COLBG);     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);      end;        {functions}      {delete charcter in cell}    if ( ch=#8 ) or ( ch=#83 ) or (ch='0')     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]]:=[];         setpm;         sbrc;         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;     {batch solve mode}    if( ch=#98) then {batch};      {bruteforce mode}    if (ch = #102) then begin {bruteforce;  wpm(0);} end;      {solving buttons}    if ch in [#59,#60,#61,#62,#63,#64,#65,#66,#67,#68,#84,#85,#86,#87,#88,#89,#90,#91,#92,#93,#96,#97,#98,#99,#100,#102,#104,#109,#116,#120,#121,#126,#133,#134,#135,#136]           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);         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;             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  (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);  {xy-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,3,2);  {xyz-wing}     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    barns(1,4,0);  {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    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    mwing(1);     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    lwing(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);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    suedecoq(1,0,0);     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    alsxy(1);     if active= true      then       begin        sbrc;       end;   end;if  (countpm2 = countpm)  and (count2 = count)  then   begin    fishfinder;     if active= true      then       begin        sbrc;       end;   end;until  (countpm2=countpm) or (count = 80)end;`
Last edited by StrmCkr on Fri Feb 10, 2017 7:57 am, edited 4 times in total.
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
Joined: 05 September 2006

### Re: StormDuko

updated
2-string kyte, Empty rectangles

i also tweaked the following sections:

index constraints
help screen
function timer
als-xz
Some do, some teach, the rest look it up.

StrmCkr

Posts: 753
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: 753
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: 753
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: 753
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: 753
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: 753
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: 753
Joined: 05 September 2006

Next