The New Sudoku Players' Forum

by **StrmCkr** » Wed Mar 02, 2016 3:56 pm

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

Screen size for the application:
width: 240
height: 360
Font size: 8*12
Font type: Raster Fonts

I have always release my code and software under Licensing

Current code posted here in is designed for Windows operating system.
Source Files, testing txt files and Stormdoku8.88.exe

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
Load,Save and initiate a Grid
Peers building functions
MAin body
Issomorphic
PatternOverlayMethod
Hidden/Naked subsets
Fishing
Named wings
A.L.S
Chains
D.D.S
Transport
MSLS

previous builds
7.69
6.8 build

by **StrmCkr** » Wed Mar 02, 2016 3:56 pm

Constants: Show

Index constants for quicker referencing: Show

cell reference guide: Show

by **StrmCkr** » Wed Mar 02, 2016 4:01 pm

Type: Show

Var: Show

Code: Select all: Var X,Y : integer; {coridinals} Grid : String ; {imported grid string} Count,Countpm,Scount: integer; {counts the given clues and pms} active,unique,table,unique2,zero: boolean; ch : char; iter : integer; //variation : boolean; Acell: numberset; {on cells} Ocell: numberset; { off cells} S: sgrid; {the solved grid} NSector: numsector; { removed sectors by s cells solved } delpm: deletepm ; {manual deletion of pencilmarks} Ipm:importpm; {loaded copy of pencilmarks} SectorN:sectornums; //[sector] of nums; {function listing all digits for sector } Ssector:solvedsector; //[sector] of nums; {function listing all solved digits for sector} covered: cov; // [cell] of nums; - technique removals by cell for n covered2: cov2; // [digits] of numberset; - technique removals by digits for cells techwrite: tech; {array holding technique data for writing to screen} {builds sets of N size digits/rcb } comboset: array [0..510] of nums; { 1-9 used for digits} comboset2: array [0..510] of RCbnums; { 0-8 used for R/C/B & position } {peer cells} peer: array [cell] of numberset; peer2: array [cell,0..19] of integer; {a quick call version to use the peers iterativly} {looks up the sectors a cell is from} CellSec: array [cell] of RCBpeer; { a quick call version for sectors a cell is in} {displays all cells for the sector used or not} RCBnum: array[sector] of numberset; {RCB call function listing all potential cells for easier use} {displays the intersecting sectors for each sector selected} peerRCB: array[sector] of rcbpeer; {RCB peer sectors of selected sector} {displays the sector of a combos set} SectorRCB: array[Sector,0..510] of numberset; {sector by combset2, looks up RCB for the comboset and displays the cells.} combosetS: array [sector,0..510] of numberset; {listing cells for sector based on digit combination set} secover: array[sector,sector] of RCBnums; {marks which "positions" overlap for 2 sectors} {hidden sets} RnSector: RNumSector; // [sector,Digits] of RCBnums; {saves RCB} {Mini row/Col} BnC: BoxnCol;// [Rcb,digits] of RCBnums; {nums represet col used in a box } BnR: BoxnRow;// [Rcb,digits] of RCBnums; {nums represet row used in a box } CnB: ColnBox;// [Rcb,digits] of RCBnums; {nums represet Box used inside a col } RnB: RownBox;// [Rcb,digits] of RCBnums; {nums represet Box used inside a row } {empty rectangle intersection} ERI:emptyRecint; // [RCB,digits] of RCBnums; {square x digit saving box } {Naked sets} SectorRC:SectorRowCol; //[sector,rcb] of nums; {# in row x col with in sector} {counts each digit} Sec:Secs; // [sector,digits] of integer; {exact number of unassigned cells for # givens in a sector} NM: nakedmarks; // [cell] of integer; { # of digits found in cell} PM: pencilmarks; // [cell] of nums; {pm combined view of nsector - dpm,Ipm,covered,covered2} {postions listings by area} DigitCell: digitcells; //[digits] of numberset; { listing every cell with n candidate} DigitRCB: DigitRowColBox;//[sector,digits] of numberset; {RBC function listing active cells for digit N} {combination sets for cells,sectors} combocell: ComboCells; //[0..510] of numberset; { combosets in specific cells Naked whole grid} ComboSubset: Combosubsets; //[0..510] of numberset; {subset combo in specific cells whole grid} ComboNum: Combonums;//[0..510,sector] of nums; {sector looking up postion set saving all numbers in those cells} {naked} HComboNum: Hcombonums; // [0..510,sector] of RCBnums; {sector looking up Digit set saving all position of those cells} {hidden} {als & ahs data base} als: almostlockedset; {sector,cell size, digit size, position listed by comboset for the sector, digits used listed by comboset} ahs: almosthiddenset; {sector,cell size, digit size, digits listed by comboset for the sector, position used listed by comboset} {link type data base} Linkset : stronglk; // array [ 0..9][0..6][0..9] of numberset[0..80]//setwise {digit selected[1..9]} {0: bivavel, 1: 2 cells in a sector 2: cell in sector , grouped link to another = all digits in that sector 3: cells in sector, as a grouped link to a single cell = all digits in that sector 4: cells in sector, as a grouped link to a grouped node = all digits in that sector 5: ERI max 6: ERI all styles 7: ALS} { internal data as: 0 starting digit, 1 active cell, 2 linked cells, 3 link digit, 4 sector start cells are in, 5 sector the link cells are is in. 6 start - digit swap is applicable 0 = off 7 end digit swap is applicable 0 = off 8 potential elimination cells ..start cell 9 potential elimination for ...end cell 10 als stuff 11 als stuff 12 - sister link }

chain display: Show

Code: Select all: procedure Chaindisplay(K:char;J:integer); var n,q,p,g,h,w,f,m:integer; l:char; begin {for q:=0 to 66 do For p:=0 to 23 do begin gotoxy(118+q,35+p); write(space); end;} techclear(0); l:=K; n:= 0; gotoxy(117,35); case k of #11,#13, #20,#22,#24,#25,#26, #59, #60,#61,#62,#63,#64,#66,#67,#68,#69, #74,#78, #84,#85,#86,#87,#88, #92,#93,#94,#95,#97, #100,#106,#109,#110,#111, #120,#121, #133,#134,#135,#136,#137,#138: begin textcolor(10); if l = #84 then writexy(118,35,'Naked Single'); if l = #86 then writexy(118,35,'Naked Pair'); if l = #87 then writexy(118,35,'Naked Tripple'); if l = #88 then writexy(118,35,'Naked Quad'); if l = #59 then writexy(118,35,'Hidden Single'); if l = #61 then writexy(118,35,'Hidden Pair'); if l = #62 then writexy(118,35,'Hidden Tripple'); if l = #63 then writexy(118,35,'Hidden Quad'); if l = #60 then writexy(118,35,'Box Line Reduction'); if l = #85 then writexy(118,35,'X - Wing - Basic | Franken | Mutant'); if l = #20 then writexy(118,35,'X - Wing - Smashi | Finned'); if l = #64 then writexy(118,35,'Skyscraper'); if l = #66 then writexy(118,35,'2 - String Kyte'); if l = #67 then writexy(118,35,'Swordfish - Basic'); if l = #92 then writexy(118,35,'Swordfish - Smashi | Finned'); if l = #68 then writexy(118,35,'Jelly Fish - Basic'); if l = #93 then writexy(118,35,'Jellyfish - Smashi | Finned'); if l = #97 then writexy(118,35,'Almost Locked Set - XZ'); if l = #121 then writexy(118,35,'Almost Locked Set - XY'); if l = #25 then writexy(118,35,'Almost almost Locked Set - 2RC Rule'); if l = #22 then writexy(118,35,'N^A.L.S - N^RC Rule'); if l = #106 then writexy(118,35,'Distributed Disjointed Subsets'); if l = #111 then writexy(118,35,'Almost Distributed Disjointed Subsets'); if l = #100 then writexy(118,35,'Sue de Coq'); if l = #69 then writexy(118,35,'Death Blossom'); if l = #24 then writexy(118,35,'X - Chain'); if l = #120 then writexy(118,35,'XY - Chain'); if l = #26 then writexy(118,35,'Alternating Interface Chain'); if l = #11 then writexy(118,35,'ALS - Chain'); if l = #13 then writexy(118,35,'A.I.C + ALS - Chain'); if l = #133 then writexy(118,35,'W - Wings | Rings'); if l = #135 then writexy(118,35,'M - Wings | Rings'); if l = #134 then writexy(118,35,'Split - Wing'); if l = #136 then writexy(118,35,'Local Type 2 Wing'); if l = #138 then writexy(118,35,'Local Type 3 Wing'); if l = #94 then writexy(118,35,'Strong - Wings | Rings'); if l = #95 then writexy(118,35,'Hybrid Type 1 - Wings'); if l = #110 then writexy(118,35,'Hybrid Type 2 - Wings'); if l = #78 then writexy(118,35,'Hybrid Type 3 - Wings'); if l = #137 then writexy(118,35,'Inverted W Wings | Rings'); if l = #109 then writexy(118,35,'Sk Loop'); if l = #74 then writexy(118,35,'Multi Sector Locked Set'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); G:=0; H:=0; F:=0; for q in techwrite[n,0] do G:=q; for q in techwrite[n,1] do h:=q; if l in [#11,#13,#24,#26,#120] then for q in techwrite[n,1] do h:=(q+1)*4; if l in [#22] then for q in techwrite[n,1] do h:=(q+1)*2; if g = 0 then //naked subset begin textcolor(white); gotoxy(118,37); Write('Set ',char(ord(65+f)),' [ '); textcolor(3); for q in techwrite[n,2] do write(q,' '); textcolor(white); write('] @ '); textcolor(9); for q in techwrite[n,3] do write(q,' '); textcolor(white); end; if g = 1 then // hidden subset begin textcolor(white); gotoxy(118,37); Write('Set [ '); textcolor(9); for q in techwrite[n,2] do write(q,' '); textcolor(white); write('] @ '); textcolor(3); for q in techwrite[n,3] do write(q,' '); textcolor(white); end; if g = 2 then //fish begin textcolor(white); gotoxy(118,37); write('('); textcolor(3); for q in techwrite[n,2] do write(q); textcolor(white); write('): Base: '); textcolor(6); for p in techwrite[n,3] do write(p,' '); textcolor(white); write('Cover: '); textcolor(6); for p in techwrite[n,4] do write(p,' '); textcolor(white); end; if g = 3 then //als types begin w:=2; f:=0; repeat begin textcolor(white); gotoxy(118,37+F); Write('Set ',char(ord(65+f)),' [ '); textcolor(3); for q in techwrite[n,w] do write(q,' '); textcolor(white); write('] @ '); textcolor(9); for q in techwrite[n,w+1] do write(q,' '); textcolor(white); F:=F+1; w:=w+2; end until w >=(3+h-2); gotoxy(118,37+f); Write('RC: ');textcolor(3); for q in techwrite[n,3+h-1] do write(q,' '); textcolor(white); Write('Z: '); textcolor(3); for q in techwrite[n,3+h] do write(q,' ');textcolor(white); end; if g = 4 then begin w:=2; f:=0; m:=0; repeat begin textcolor(white); gotoxy(118+m,37+f); Write(' ('); textcolor(3); for q in techwrite[n,w] do write(q); textcolor(white); Write(') '); textcolor(9); for q in techwrite[n,w+1] do write(q,' '); textcolor(white); Write('= '); textcolor(9); for q in techwrite[n,w+2] do write(q,' '); textcolor(white); Write('('); textcolor(3); for q in techwrite[n,w+3] do write(q); textcolor(white); Write(')'); m:=m+32; w:=w+4; if w <(3+(h)-2) then write(' - '); if m > 64 then begin m:=0; f:=f+1;end; end until w >(3+(h)-2); end; if g = 5 then //msls types begin textcolor(white); gotoxy(118,37); Write('Away Set [ '); textcolor(3); for q in techwrite[n,2] do write(q,' '); textcolor(white); write('] @ '); textcolor(6); for q in techwrite[n,3] do write(q,' '); textcolor(white); textcolor(white); gotoxy(118,38); Write('Home Set [ '); textcolor(3); for q in techwrite[n,4] do write(q,' '); textcolor(white); write('] @ '); textcolor(6); for q in techwrite[n,5] do write(q,' '); textcolor(white); gotoxy(118,39+f); Write('covers: ');textcolor(3); for q in techwrite[n,6] do write(q,' '); textcolor(white); Write('cells: '); textcolor(3); for q in techwrite[n,7] do write(q,' ');textcolor(white); F:=F+3; end; //elimimimination cells write(' =>> '); for p:= 1 to 9 do if techwrite[n,p+h+3] <> [] then begin gotoxy(118,38+F+p); textcolor(red); for q in techwrite[n,p+h+3] do write(q,' '); textcolor(white); write(' <> '); textcolor(3);write(p); textcolor(white); end; gotoxy(118,39+f+9); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(1); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; end; textcolor(col2); end; //chaindisplay

Tech clear: Show

Tech Display: Show

Code: Select all: {writing function for technique sets} procedure techdisplay(K:char;J:integer); var n,q,p:integer; l:char; begin for q:=0 to 66 do For p:=0 to 14 do begin gotoxy(118+q,35+p); write(space); end; l:=K; n:= 0; gotoxy(117,35); case k of #65,#102: begin textcolor(10); if l = #65 then writexy(118,35,'Empty Rectangle'); if l = #102 then writexy(118,35,'Fish Finder'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); if l = #65 then writexy(118,35,'Empty Rectangle'); if l = #102 then writexy(118,35,'Fish Finder'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); write('('); textcolor(3); for q in techwrite[n,11] do write(q); textcolor(white); write('): Base: '); textcolor(6); for p in techwrite[n,0] do write(p,' '); textcolor(white); write('Cover: '); textcolor(6); for p in techwrite[n,10] do write(p,' '); textcolor(white); if L = #102 then begin textcolor(white); if techwrite[n,12] <> [] then begin write('Extra Covers: '); textcolor(6); for p in techwrite[n,12] do write(p,' '); end; textcolor(white); end; gotoxy(118,38); write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,39+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> '); textcolor(3);write(p); textcolor(white); end; gotoxy(118,49); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; #104: begin textcolor(10); writexy(118,35,'AHS-XZ'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); writexy(118,35,'AHS-XZ'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); Write('Set A) [ '); textcolor(9); for q in techwrite[n,11] do write(q,' '); textcolor(white); write('] @ '); textcolor(3); for q in techwrite[n,0] do write(q,' '); textcolor(white); gotoxy(118,38); Write('Set B) [ '); textcolor(9); for q in techwrite[n,12] do write(q,' '); textcolor(white); write('] @ '); textcolor(3); for q in techwrite[n,10] do write(q,' '); textcolor(white); gotoxy(118,39); Write('X: '); for q in techwrite[n,13] do textcolor(9); write(q,' '); textcolor(white); Write('Z: '); textcolor(9); for q in techwrite[n,14] do write(q,' ');textcolor(white); write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,39+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> '); textcolor(3);write(p); textcolor(white); end; gotoxy(118,49); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; #23: begin textcolor(10); if l = #23 then writexy(118,35,'ALS - W - Wings & Rings'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); if l = #23 then writexy(118,35,'ALS - W - Wings & Rings'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); if [0] * techwrite[n,17] <> [] then begin Write('Set A) [ '); textcolor(3); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('] @ ' ); {numbers} textcolor(9); for p in (techwrite[n,11]) do write(p,' '); textcolor(white); {cells} gotoxy(118,38); Write('Set B) [ '); textcolor(3); for p in (techwrite[n,10]) do write(p,' '); textcolor(white); write('] @ '); {numbers} textcolor(9); for p in (techwrite[n,12]) do write(p,' '); textcolor(white); {cells} gotoxy(118,39);write('RC: ( '); textcolor(3); for p in (techwrite[n,16]) do write(p,' '); textcolor(white); write(') , linked: ,( '); {numbers} textcolor(3); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write(') ' ); {number} textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write(' = ' ); {cells} textcolor(9); for p in techwrite[n,14] do write(p,' '); textcolor(white); write(' ( '); {cells} textcolor(3); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write(') ' ); {number} end; if [1] * techwrite[n,17] <> [] then begin gotoxy(118,40); textcolor(3); for p in (techwrite[n,19]) do write(p,' '); textcolor(white); write(') ' ); {number} textcolor(9); for p in (techwrite[n,18]) do write(p,' '); textcolor(white); write(' = ' ); {cells} textcolor(9); for p in techwrite[n,20] do write(p,' '); textcolor(white); write(' ( '); {cells} textcolor(3); for p in (techwrite[n,19]) do write(p,' '); textcolor(white); write(') ' ); {number} end; write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,40+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> ');textcolor(3); write(p); textcolor(white); end; gotoxy(140,50); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; #1: begin textcolor(10); if l=#1 then writexy(118,35,'ALS - M - Wings & Rings'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); if l=#1 then writexy(118,35,'ALS - M - Wings & Rings'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); write('('); textcolor(3); for p in techwrite[n,10] do write(p); textcolor(white); write(') - '); textcolor(9); for p in (techwrite[n,11]) do write(p,' '); textcolor(white); write('-(' ); textcolor(3); for p in (techwrite[n,0]) do write(p); textcolor(white); write(')- ' ); textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('=('); textcolor(3); for p in (techwrite[n,0]) do write(p); textcolor(white); write(')= '); textcolor(9); for p in (techwrite[n,12]) do write(p,' '); textcolor(white); write('=('); textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')= ' ); textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('- (' ); textcolor(3); for p in techwrite[n,10] do write(p); textcolor(white); write(')'); write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,39+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> ');textcolor(3); write(p); textcolor(white); end; gotoxy(118,49); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; #4: begin textcolor(10); if l=#4 then writexy(118,35,'ALS -Split - Wings'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); if l=#4 then writexy(118,35,'ALS -Split - Wings'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); textcolor(9); for p in (techwrite[n,12]) do write(p,' '); textcolor(white); write(' =(' ); textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')= ' ); textcolor(9); for p in (techwrite[n,13]) do write(p,' '); textcolor(white); write('-('); textcolor(3); for p in (techwrite[n,10]) do write(p); textcolor(white); write(')- '); textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('-('); textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')- '); textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('= (' ); textcolor(3); for p in techwrite[n,11] do write(p); textcolor(white); write(')= ' ); textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,39+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> ');textcolor(3); write(p); textcolor(white); end; gotoxy(118,49); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; #14: begin textcolor(10); writexy(118,35,'Hybrid (Type 4 & 5) - Wings'); textcolor(8); if j = 0 then writexy(118,36,'Found : 0 '); if j > 0 then begin repeat textcolor(10); writexy(118,35,'Hybrid (Type 4 & 5) - Wings'); textcolor(8); writexy(118,36,'Displaying : '); write(n+1,' Of ',J,' '); textcolor(white); gotoxy(118,37); write('(' ); textcolor(3); for p in ((techwrite[n,16] -(techwrite[n,11]+ techwrite[n,12])) ) do write(p); textcolor(white); write(')- ' ); textcolor(9); for p in (techwrite[n,14]) do write(p,' '); textcolor(white); write('=('); textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write(')= ' ); textcolor(9); for p in (techwrite[n,0]) do write(p,' '); textcolor(white); write('-(' ); textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white); write('='); textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')- ' ); textcolor(9); for p in (techwrite[n,10]) do write(p,' '); textcolor(white);write('=('); textcolor(3); for p in (techwrite[n,12]) do write(p); textcolor(white); write(')= ' ); textcolor(9); for p in (techwrite[n,15]) do write(p,' '); textcolor(white); write('-(' ); textcolor(3); for p in (techwrite[n,11]) do write(p); textcolor(white);write(')'); write(' =>> '); for p:= 1 to 9 do if techwrite[n,p] <> [] then begin gotoxy(118,39+p); textcolor(red); for q in techwrite[n,p] do write(q,' '); textcolor(white); write(' <> ');textcolor(3); write(p); textcolor(white); end; gotoxy(118,49); ch:=readkey; if (ch=#43) or (ch=#45 ) then techclear(0); if ch=#43 then n:=n+1; if ch=#45 then n:=n-1; if (n) > j-1 then n:=0; if (n) < 0 then n:=j-1; until (ch =#13) end; end; END; textcolor(col2); end;

by **StrmCkr** » Wed Mar 02, 2016 4:20 pm

Txt Writing function: Show

Curser position in grid: Show

Moves the Curser in the pm box: Show

Write PM's to screen: Show

tech display screen: Show

view givens: Show

View PM: Show

Code: Select all: procedure ViewPM; { pm grid } begin textcolor(27); writexy(50,33,'Pencil Mark'); textcolor(19); 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, 'º-----------+-----------+-----------º-----------+-----------+-----------º-----------+-----------+-----------º'); writexy( 1 , up+47, 'º | | º | | º | | º'); writexy( 1 , up+48, 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); textcolor(col2); end;

Extended Tables: Show

Code: Select all: procedure viewspace; var n,xn,q:integer; begin textcolor(67); writexy(1,66,' Extension Tables: '); textcolor(darkgray); write('updates while out of PM grid'); textcolor(6); writexy(50,68,'Row - # x Col'); textcolor(19); writexy( 1 , 69, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1,70+xn); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in Rnsector[xn,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1 , 71+xn,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50,68+12,'Col - # x Row'); textcolor(19); writexy( 1, 69+12, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1,70+xn+12); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in Rnsector[xn+9,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1 , 71+xn+12,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50,68+24,'Box - # x square'); textcolor(19); writexy( 1 , 69+24, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1,70+xn+24); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in Rnsector[xn+18,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1 , 71+xn+24,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50,68+36,'Mini Row - # x Col'); textcolor(19); writexy( 1 , 69+36, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1,70+xn+36); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in BnR[xn,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1 , 71+xn+36,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50+110,68,'Mini Col - # x Row'); textcolor(19); writexy( 1+110 , 69, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1+110,70+xn); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in BnC[xn,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1+110 , 71+xn,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50+110,68+12,'Mini Row - # x Box'); textcolor(19); writexy( 1+110 , 69+12, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1+110,70+xn+12); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in RnB[xn,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1+110 , 71+xn+12,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50+110,68+24,'Mini Col - # x Box'); textcolor(19); writexy( 1 +110, 69+24, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1+110,70+xn+24); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in CnB[xn,n] then write(q) else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1+110 , 71+xn+24,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(6); writexy(50+110,68+36,'ERI(Box) - # x position'); write(' Note:'); textcolor(red); write(' pseudo eri'); textcolor(19); writexy( 1+110 , 69+36, 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for xn:= 0 to 8 do begin gotoxy(1+110,70+xn+36); write('º '); for n:= 1 to 9 do begin if n <> 1 then write(' | '); textcolor(8); for q:= 0 to 8 do if q in ERI[xn,n] then begin if pm[secset[xn+18,q]] * [N] = [] then textcolor(red) else textcolor(8); write(q); end else write(space); textcolor(19); if n = 9 then write(' º'); end; if xn = 8 then writexy( 1+110 , 71+xn+36,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼'); end; textcolor(col2); Gotoxy(1,1); end;

help Menu: 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,'Unsolved:'); writexy(12,25,'PMs:'); textcolor(green); writexy(26,23,'ESC : Exit'); textcolor(67); writexy(58,1,'Keystroke'); textcolor(24); writexy(51,2,'Movement:'); textcolor(green); writexy(50,3,'Arrows - Direction'); writexy(50,4,'Home - Goto Col 1 on Row'); writexy(50,5,'End - Goto Col 9 on Row'); writexy(50,6,'Page up - Goto Row 1 on Col'); writexy(50,7,'Page down - Goto Row 9 on Col'); writexy(50,8,'Backspace - Delete # in cell'); writexy(50,9,'Delete - Delete # in cell'); Writexy(50,10,'Tab - Switch PM | Grid'); writexy(50,11,'CRTL + \ - Extended Grids'); writexy(50,12,'1 - 9 - Enter # into cell'); textcolor(24); writexy(51,14,'Functions:'); textcolor(green); writexy(50,15,'` - Solve'); writexy(50,16,'~ - Batch solve'); writexy(50,17,'R - Reset Grid'); writexy(50,18,'E - Empty Pm Grid'); writexy(50,19,'Ctrl + S - Save Grid String'); writexy(50,20,'S - Save Pm state'); writexy(50,21,'Shift + L - Load Saved Grid'); writexy(50,22,'L - Load Saved Pm'); writexy(50,23,'I - Import a Grid'); writexy(50,24,'C - Isomorphic'); writexy(50,25,'Crtl + Q - Automorphic'); writexy(50,26,'P - P.O.M'); writexy(50,27,'Crtl + G - Generate'); // writexy(50,29,'CRTl + F - Brute Force'); writexy(50,28,'Shift + F - Dancing Links'); textcolor(24); writexy(85,1,'Starter Techniques:'); textcolor(green); writexy(81,2,'F1 - Hidden Single'); writexy(81,3,'Shift + F1 - Naked Single'); writexy(81,4,'F3 - Hidden Pair'); writexy(81,5,'Shift + F3 - Naked Pair'); writexy(81,6,'F4 - Hidden Triple'); writexy(81,7,'SHift + F4 - Naked Triple'); writexy(81,8,'F5 - Hidden Quad'); writexy(81,9,'Shift + F5 - Naked Quad'); textcolor(24); writexy(85,11,'Fish Techniques:'); textcolor(green); writexy(81,12,'F2 - Box Line Reduction'); writexy(81,13,'Shift + F2 - X - Wing'); writexy(81,14,'F6 - Skyscraper'); writexy(81,15,'F7 - Empty Rectangle'); Writexy(81,16,'F8 - 2-String Kyte'); writexy(81,17,'F9 - Sword Fish'); writexy(81,18,'F10 - Jelly Fish'); writexy(81,19,'Crtl + T - Finned/Sashimi Xwing'); writexy(81,20,'Shift + F9 - Finned/Sashimi Sword'); writexy(81,21,'Shift + F10 - Finned/Sashimi Jelly'); //writexy(81,30,'T - N x N Fish'); textcolor(24); writexy(85,23,'Bent Subset Techniques:'); textcolor(green); writexy(81,24,'Shift + F6 - XY - Wing'); writexy(81,25,'Shift + F7 - XYZ - Wing'); writexy(81,26,'Shift + F8 - WXYZ - Wing'); writexy(81,28,'B - Barns'); textcolor(24); writexy(120,27,'Subset Techniques:'); textcolor(green); writexy(116,28, 'D - Sue De Coq'); writexy(116,29, 'Shift + E - Death Blossom'); writexy(116,30, 'J - D.D.S'); writexy(116,31, 'O - A.D.D.S'); textcolor(24); writexy(160,18,'Cover Set Techniques:'); textcolor(green); writexy(156,19,'F - N x ( N + K ) Fish'); writexy(156,20,'M - SK Loop'); writexy(156,21,'Shift + J - Muti Sector Locked Set'); textcolor(24); writexy(120,1,'Named Chain Techniques:'); textcolor(green); writexy(116,2, 'F11 - W - Wing & Ring'); writexy(116,3, 'Shift + F11 - M - Wing & Ring'); writexy(116,4, 'F12 - S - Wing'); writexy(116,5, 'Shfit + F12 - L2 - Wing'); writexy(116,6, 'Crtl + F12 - L3 - Wing'); writexy(116,7, 'Crtl + F1 - Strong - Wing & Ring'); writexy(116,8, 'Crtl + F2 - H 1 - Wing'); writexy(116,9, 'N - H 2 - Wing'); writexy(116,10,'Shift + N - H 3 - Wing'); writexy(116,11,'Crtl + N - H 4 & 5 - Wing'); writexy(116,12,'Crtl + F11 - iW - Wing & Ring'); textcolor(24); writexy(160,1,'Chain Techniques:'); textcolor(green); writexy(156,2,'Crtl + X - X - Chain '); writexy(156,3,'X - XY - Chain'); writexy(156,4,'Crtl + Z - A.I.C '); writexy(156,5,'Crtl + K - ALS - Chain'); writexy(156,6,'Crtl + M - A.I.C + ALS - Chain'); textcolor(24); writexy(160,8,'Symetrical Placement Techniques: semi functioning'); textcolor(green); writexy(156,9, 'Crtl + J -Fixed Boxes'); writexy(156,10,'Crtl + F -Boxes move in bands'); writexy(156,11,'Crtl + P -Boxes move Triangular'); writexy(156,12,'Crtl + U -Rotational Symmetries'); writexy(156,13,'Crtl + R -Diagonal Symmetries'); writexy(156,14,'Crtl + E -Stick Symmetries'); writexy(156,15,'* -All Symmetries'); textcolor(24); writexy(120,15,'Almost locked Sets Techniques:'); textcolor(green); writexy(116,16,'A - ALS - XZ rule '); writexy(116,17,'H - AHS - XZ rule '); writexy(116,18,'Y - ALS - XY rule '); writexy(116,19,'Crtl + Y - AALS - 2RC rule'); writexy(116,20,'Crtl + V - N^ALS - N^RC rule'); textcolor(24); writexy(120,22,'Named ALS + Chain Techniques:'); textcolor(green); writexy(116,23,'Crtl + W - ALS - W - Wing & Ring'); writexy(116,24,'Crtl + A - ALS - M - Wing & Ring'); writexy(116,25,'Crtl + D - ALS - S - Wing & Ring'); textcolor(24); writexy(160,23,'Transport Techniques:'); textcolor(green); writexy(156,24,'Z - T - XY - Wing'); writexy(156,25,'U - T - XYZ - Wing'); writexy(156,26,'Q - T - WXYZ - Wing'); writexy(156,27,'T - T - Barns'); writexy(156,28,'W - T - XY-Chain'); writexy(156,29,'G - T - ALS-XZ'); writexy(156,30,'K - T - ALS-XY'); writexy(156,31,'V - T - A.D.D.S'); writexy(50,56,' PM keystroke '); textcolor(24); writexy(39,57,'Movment:'); textcolor(green); writexy(39,58,'Arrows - Direction'); writexy(39,59,'Home - Goto Col 1 on Row'); writexy(39,60,'End - Goto Col 9 on Row'); writexy(39,61,'Page up - Goto Row 1 on Col'); writexy(39,62,'Page down - Goto Row 9 on Col'); writexy(39,63,'Backspace - Resets PM #s in cell'); writexy(39,64,'Delete - Resets PM #s in cell'); writexy(39,65,'1 - 9 - Delete # from cell'); textcolor(67); writexy(162,61,'Technique Trace '); textcolor(24); writexy(162,62,'Movment:'); textcolor(green); writexy(162,63,'+ - Next in list'); writexy(162,64,'- - Previous in List'); writexy(162,65,'Enter - Exit List'); writexy(162,66,'Colour ='); textcolor(3); write(' Digit,'); textcolor(6); write(' Sector,'); textcolor(9); write(' Cell,'); textcolor(red); write(' Exclusion Cell '); textcolor(darkgray); writexy(76,56,'Copyright © Strmckr 2009 ->> 2022'); writexy(72,57,'This program is free software: you can '); writexy(72,58,'redistribute it and/or modify it under the'); writexy(72,59,'terms of the GNU general public License'); writexy(72,60,'This program is distributed without any '); writexy(72,61,'warrenty; without even the implied warranty'); writexy(72,62,'of Merchantability or fitness for a '); writexy(72,63,'particular purpose. See the GNU general'); writexy(72,64,'public license for more details. '); writexy(72,65,'< http://www.gnu.org/licenses/gpl-3.0.html > '); textcolor(col2); end;

Displays curser location & uniqueness: Show

by **StrmCkr** » Wed Mar 02, 2016 4:36 pm

sets all basic data storage: Show

Erase PM: Show

Arrange: Show

Import: Show

save: Show

Load from save: Show

save PM: Show

load PM: Show

SBRC: Show

Code: Select all: {Sets all subset data spaces used by solver} procedure SBRC; var xn,n:integer; begin active:= false; countpm:=0; count:=0; Scount:=0; setlength(Rnsector,0); setlength(Rnsector,27); setlength(sectorRC,0); setlength(sectorRC,27); setlength(Sec,0); setlength(Sec,27); setlength(nm,0); setlength(nm,81); setlength(pm,0); setlength(pm,81); setlength(digitcell,0); setlength(digitcell,10); setlength(digitrcb,0); setlength(Digitrcb,81); setlength(BnR,0); setlength(BnR,9); setlength(BnC,0); setlength(BnC,9); setlength(RnB,0); setlength(RnB,9); setlength(CnB,0); setlength(CnB,9); setlength(sectorN,0); setlength(sectorN,27); setlength(Ssector,0); setlength(Ssector,27); for xn in ocell do begin for n:= 1 to 9 do if not(N in (nsector[rx[xn]] + nsector[cy[xn]+9] + nsector[bxy[xn]+18] + delpm[xn] + IPM[xn] + covered[xn]) ) and not (xn in covered2[n]) then begin inc(sec[rx[xn],n]); inc(sec[cy[xn]+9,n]); inc(sec[bxy[xn]+18,n]); include(RnSector[Rx[xn],n],Cy[xn]); include(RnSector[Cy[xn]+9,n],Rx[xn]); include(RnSector[Bxy[xn]+18,n],Bxyn[xn]); include(BnR[Bxy[xn],n],Rx[xn]); include(BnC[Bxy[xn],n],Cy[xn]); include(RnB[Rx[xn],n],Bxy[xn]); include(CnB[Cy[xn],n],Bxy[xn]); include(SectorRC[Rx[xn],Cy[xn]],n); include(sectorRC[Cy[xn]+9,Rx[xn]],n); include(SectorRC[Bxy[xn]+18,Bxyn[xn]],n); include(DigitRCB[Rx[xn],n],xn); include(DigitRCB[Cy[xn]+9,n],xn); include(DigitRCB[bxy[xn]+18,n],xn); include(sectorN[Rx[xn]],n); include(sectorN[Cy[xn]+9],n); include(sectorN[Bxy[xn]+18],n); include(digitcell[n],xn); include(PM[xn],n); inc(nm[xn]); inc(countpm) end; inc(count); end; for xn in acell do if S[xn] <> [] then begin inc(scount); sSector[rx[xn]]:= sSector[rx[xn]] +s[xn]; sSector[cy[xn]+9]:= sSector[cy[xn]+9] +s[xn]; sSector[bxy[xn]+18]:= sSector[bxy[xn]+18] +s[xn]; end; ERIntersection; {changed these to call from the programs that need them speeding up others that do not use it} // cellcombo; // links; // wLinks; //alsfinder; //ahsfinder; end;

Link builder: Show

Code: Select all: Procedure links;{rebuild} var N,xn,xn2,q,j,a,b,c,d,e,m,n2,f,l,w,yn,f2,count,count2:integer; output: text; used,x,x2,z,z2:numberset; begin cellcombo; setlength(Linkset,10,8,0); for n:= 1 to 9 do begin q:=-1; A:=-1; b:=-1; c:=-1; D:=-1; e:=-1; l:=-1; w:=-1; used:=[]; for xn:= 0 to 26 do begin {bivavle cell} if DigitRCB[xn,n] <> [] then begin for J in (DigitRCB[xn,n]-used) do if nm[j] = 2 then begin include(used,j); inc(q); setlength(linkset[n][0],q+1); include(linkset[n][0][q,0],n); include(linkset[n][0][q,1],j); linkset[n][0][q,2]:=[j]; for m in (pm[j]-[n]) do begin include(linkset[n][0][q,3],m); linkset[n][0][q,9]:= peer[j] * digitcell[m]; end; linkset[n][0][q,4]:=cellsec[j]; linkset[n][0][q,5]:=CellSec[j]; linkset[n][0][q,6]:=[n]; linkset[n][0][q,7]:=[m]; linkset[n][0][q,8]:= peer[j] * digitcell[n] ; linkset[n][0][q,10]:=[]; linkset[n][0][q,11]:=[]; end; end;{bivavle} {bi local} if (sec[xn,n] = 2 ) then for J in DigitRCB[xn,n] do begin inc(a); setlength(linkset[n][1],a+1); include(linkset[n][1][a,0],n); include(linkset[n][1][a,1],j); linkset[n][1][a,2]:= Digitrcb[xn,n] - [j]; include(linkset[n][1][a,3],n); //include(linkset[n,1,a,4],xn); linkset[n][1][a,4]:=cellsec[j] {- [xn]}; // xn on to sectors might need to add it again for m in digitRCB[xn,n] -[j] do linkset[n][1][a,5]:=cellsec[m]{-[xn]}; // xn on to sectors might need to add it again linkset[n][1][a,6]:=pm[j]-[n]; linkset[n][1][a,7]:=pm[m]-[n]; linkset[n][1][a,8]:=peer[j]*digitcell[n] {-[m]}; linkset[n][1][a,9]:=peer[m]*digitcell[n] {-[j]}; linkset[n][1][a,10]:=[]; linkset[n][1][a,11]:=[] end; {bilocal} { single + grouped & Grouped + single} if (sec[xn,n] <5) and (Sec[xn,n] >2) then for J in DigitRCB[xn,n] do for m in peerRCB[xn] do if ((DigitRCB[m,n] * DigitRCB[xn,n]) + [j] = DigitRCB[xn,n] ) and not ( J in DigitRCB[m,n]) then begin { single + grouped} inc(b); setlength(linkset[n][2],b+1); include(linkset[n][2,b,0],n); include(linkset[n][2,b,1],j); linkset[n][2,b,2]:= Digitrcb[xn,n] - [j]; include(linkset[n][2,b,3],n); linkset[n][2,b,4]:=cellsec[j] {- [xn]}; include(linkset[n][2,b,5],m); linkset[n][2,b,6]:=pm[j]-[n]; linkset[n][2,b,7]:=[0]; linkset[n][2,b,9]:= Digitrcb[m,n]- (DigitRCB[m,n] * DigitRCB[xn,n]) ; linkset[n][2,b,8]:= peer[j]* digitcell[n]-(DigitRCB[m,n] * DigitRCB[xn,n]); linkset[n][2][b,10]:=[]; linkset[n][2][b,11]:=[]; { grouped + single} inc(c); setlength(linkset[n][3],c+1); include(linkset[n][3,c,0],n); linkset[n][3,c,1]:= Digitrcb[xn,n] - [j]; include(linkset[n][3,c,2],j); include(linkset[n][3,c,3],n); include(linkset[n][3,c,4],m); linkset[n][3,c,5]:= cellsec[j] {- [xn] }; linkset[n][3,c,6]:=[0]; linkset[n][3,c,7]:=pm[j]-[n]; linkset[n][3,c,9]:= peer[j] * digitcell[n]-(DigitRCB[m,n] * DigitRCB[xn,n]); linkset[n][3,c,8]:= DigitRCB[m,n] -(DigitRCB[m,n] * DigitRCB[xn,n]) ; linkset[n][3][c,10]:=[]; linkset[n][3][c,11]:=[]; end; {Grouped + grouped} if (sec[xn,n] <7) and (Sec[xn,n] >3) then for J in peerrcb[xn] do for m in (peerrcb[xn]-[0..j]) do if ((DigitRCB[j,n] * DigitRCB[xn,n]) + (DigitRCB[m,n] * DigitRCB[xn,n]) = (DigitRCB[xn,n])) and (DigitRCB[j,n] * DigitRCB[m,n] = [] ) then begin count:= 0; count2:=0; for f2 in (DigitRCB[j,n] * DigitRCB[xn,n]) do inc(count); for f2 in (DigitRCB[m,n] * DigitRCB[xn,n]) do inc(count2); if (count > 1) and (count2 >1) then begin inc(d); setlength(linkset[n][4],d+1); include(linkset[n][4,d,0],n); linkset[n][4,d,1]:=(DigitRCB[xn,n] * Digitrcb[j,n]); linkset[n][4,d,2]:=(DigitRCB[xn,n] * DigitRCB[m,n]); include(linkset[n][4,d,3],n); include(linkset[n][4,d,4],J); include(linkset[n][4,d,5],m); linkset[n][4,d,6]:=[0]; linkset[n][4,d,7]:=[0]; linkset[n][4,d,9]:= DigitRCB[m,n] - (DigitRCB[xn,n] * DigitRCB[m,n]); linkset[n][4,d,8]:= DigitRCB[j,n] - (DigitRCB[xn,n] * DigitRCB[j,n]); linkset[n][4][d,10]:=[]; linkset[n][4][d,11]:=[]; inc(d); setlength(linkset[n][4],d+1); include(linkset[n][4,d,0],n); linkset[n][4,d,2]:=(DigitRCB[xn,n] * Digitrcb[j,n]); linkset[n][4,d,1]:=(DigitRCB[xn,n] * DigitRCB[m,n]); include(linkset[n][4,d,3],n); include(linkset[n][4,d,4],m); include(linkset[n][4,d,5],j); linkset[n][4,d,6]:=[0]; linkset[n][4,d,7]:=[0]; linkset[n][4,d,9]:= DigitRCB[j,n] - (DigitRCB[xn,n] * DigitRCB[j,n]); linkset[n][4,d,8]:= DigitRCB[m,n] - (DigitRCB[xn,n] * DigitRCB[m,n]); linkset[n][4][d,10]:=[]; linkset[n][4][d,11]:=[]; end; end; // max er as others are covered in class 1,2,3,4 if (sec[xn,n] <6) and (Sec[xn,n] >4) and (xn in [18..26]) and (popcnt(dword(eri[xn-18,n])) = 1) then for J in eri[xn-18,n] do begin inc(w); setlength(linkset[n][5],w+1); include(linkset[n][5,w,0],n); linkset[n][5,w,1]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][5,w,2]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]); include(linkset[n][5,w,3],n); include(linkset[n][5,w,4], rx[secset[xn,j]]); include(linkset[n][5,w,5], Cy[secset[xn,j]]+9); linkset[n][5,w,6]:=[0]; linkset[n][5,w,7]:=[0]; linkset[n][5,w,8]:= DigitRCB[Rx[secset[xn,j]],n] - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][5,w,9]:= DigitRCB[Cy[secset[xn,j]]+9,n] - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]); linkset[n][5][w,10]:=[]; linkset[n][5][w,11]:=[]; inc(w); setlength(linkset[n][5],w+1); include(linkset[n][5,w,0],n); linkset[n][5,w,2]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][5,w,1]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]); include(linkset[n][5,w,3],n); include(linkset[n][5,w,5], rx[secset[xn,j]]); include(linkset[n][5,w,4], Cy[secset[xn,j]]+9); linkset[n][5,w,6]:=[0]; linkset[n][5,w,7]:=[0]; linkset[n][5,w,9]:= DigitRCB[Rx[secset[xn,j]],n] - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][5,w,8]:= DigitRCB[Cy[secset[xn,j]]+9,n] - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]); linkset[n][5][w,10]:=[]; linkset[n][5][w,11]:=[]; end; //end; // (2 cells)min -> (5cells) max er for "er code" if (sec[xn,n] <6) and (Sec[xn,n] >1) and (xn in [18..26]) then for J in eri[xn-18,n] do begin inc(e); setlength(linkset[n][6],e+1); include(linkset[n][6,e,0],n); linkset[n][6,e,1]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][6,e,2]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]); include(linkset[n][6,e,3],n); include(linkset[n][6,e,4], rx[secset[xn,j]]); include(linkset[n][6,e,5], Cy[secset[xn,j]]+9); linkset[n][6,e,6]:=[0]; linkset[n][6,e,7]:=[0]; linkset[n][6,e,8]:= DigitRCB[Rx[secset[xn,j]],n] - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][6,e,9]:= DigitRCB[Cy[secset[xn,j]]+9,n] - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]); linkset[n][6][e,10]:=[]; linkset[n][6][e,11]:=[]; inc(e); setlength(linkset[n][6],e+1); include(linkset[n][6,e,0],n); linkset[n][6,e,2]:=(DigitRCB[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][6,e,1]:=(DigitRCB[xn,n] * DigitRCB[Cy[secset[xn,j]]+9,n]); include(linkset[n][6,e,3],n); include(linkset[n][6,e,5], rx[secset[xn,j]]); include(linkset[n][6,e,4], Cy[secset[xn,j]]+9); linkset[n][6,e,6]:=[0]; linkset[n][6,e,7]:=[0]; linkset[n][6,e,9]:= DigitRCB[Rx[secset[xn,j]],n] - (Digitrcb[xn,n] * Digitrcb[Rx[secset[xn,j]],n]); linkset[n][6,e,8]:= DigitRCB[Cy[secset[xn,j]]+9,n] - (Digitrcb[xn,n] * Digitrcb[Cy[secset[xn,j]]+9,n]); linkset[n][6][e,10]:=[]; linkset[n][6][e,11]:=[]; end; // strong link builder for als // not reversable as this code generates the reverse automatically for F:= high(als) downto 0 do if (als[F,0] = xn) and (n in comboset[als[f,4]]) and (als[f,1] >1 ) // no bivavles //and (als[f,1] <8 ) // disable this during testing and (als[F,1]+1 = als[F,2]) // n cells can only n+1 digits then for J in (comboset[als[f,4]] - [n]) do begin inc(l); setlength(linkset[n][7],L+1); include(linkset[n][7][L][0],n); linkset[n][7][L][1]:= digitcell[n] * Combosets[als[f][0],als[f][3]]; linkset[n][7][L][2]:= digitcell[j] * Combosets[als[f][0],als[f][3]]; include(linkset[n][7][L][3],j); x:=[0..26]; for m in digitcell[n] * Combosets[als[f][0],als[f][3]] do x:= x * cellsec[m]; linkset[n,7,l,4]:=x; x2:=[0..26]; for m in digitcell[j] * Combosets[als[f][0],als[f][3]] do x2:= x2 * cellsec[m]; linkset[n,7,l,5]:=x2; linkset[n][7,l,6]:=[0]; linkset[n][7,l,7]:=[0]; z:=[]; z2:=[]; for m in [0..80] do if peer[m] * (digitcell[n] * Combosets[als[f][0],als[f][3]]) = (digitcell[n] * Combosets[als[f][0],als[f][3]]) then include(z,m); linkset[n,7,l,8]:=linkset[n,7,l,8]+z; for m in [0..80] do if peer[m] * (digitcell[j] * Combosets[als[f][0],als[f][3]]) = (digitcell[j] * Combosets[als[f][0],als[f][3]]) then include(z2,m); linkset[n,7,l,9]:=linkset[n,7,l,9]+z2; linkset[n][7][l][10]:=Combosets[als[f][0],als[f][3]]; linkset[n][7][l][11]:=comboset[als[f,4]]; end; end; end; //delete(linkset[1,1],1,1); for n2 in [1..9] do for xn in [1..1] do begin for J:= low(linkset[n2][xn]) to ((high(linkset[n2][xn]))-1) do for M:= j+1 to high(linkset[n2][xn]) do if (linkset[n2][xn][j][1] * linkset[n2][xn][m][1] = linkset[n2][xn][j][1]) and (linkset[n2][xn][j][2] * linkset[n2][xn][m][2] = linkset[n2][xn][j][2]) then begin delete(linkset[n2,xn],m,1); break; end; end; // writting txt file output to verify manually assign(output,'C:\sudoku\stronglink.txt'); erase(output); rewrite(output); close(output); for n2 in [1..9] do for xn in [0..7] do for J:= low(linkset[n2][xn]) to high(linkset[n2][xn]) do begin append(output); writeln(output); write(output,'#',n2,' | '); write(output,'type:',xn,' | '); for n:= low(linkset[n2][xn,j]) to high(linkset[n2][xn,j]) do begin for M in linkset[n2][xn,j,n] do write(output,m,','); write(output,' | '); end; close(output); end; end;{strong link builder}

error checker: Show

Cell combinations: Show

ERI finder: Show

ALS finder: Show

AHS finder: Show

by **StrmCkr** » Wed Mar 02, 2016 4:57 pm

Combination set: Show

Combo: Show

peers: Show

RCBpeers: Show

Sector Row Col Box lookup: Show

set cell sector: Show

sector overlaps marker: Show

by **StrmCkr** » Wed Mar 02, 2016 5:18 pm

Timer Control: Show

Code: Select all: {Timmer for executing solving commands} // command functions Procedure time(v:char); var st,et,hz:int64; ms:double; begin setlength(techwrite,0,0); sbrc; queryperformancecounter (st); case v of #59: Hs(0); #84: Ns(0); #61: Hp(0); #86: Np(0); #62: Ht(0); #87: Nt(0); #63: Hq(0); #88: Nq(0); #89: barns(1,3,1,3); {xy-wing} #90: barns(1,3,2,3); {xyz-wing} #91: barns(1,4,0,4); {wxyz-wing} #60: blr(0); #85: xwing(0); #20:smashi(0); {finned/sashi x-wings} #64: sky(0); {skyscrappers} #65: er(0); #66: kyte(0); #67: Swordfish(0); #92: smashiswords(0); #68: jellyfish(0); #93: smashijelly(0); #122: transbarns(1,3,1,3); {T-xy-wing} #117: transbarns(1,3,2,3); {T-xyz-wing} #113: transbarns(1,4,0,4); {T-wxyz-wing} #133: Wwing(1); #137: iWwing(1); #135: mwing(1); #134: swing(1); #136: L2wing(1); #0138: l3wing(1); #94: Strongwing(1); #095: H1wing(1); #110: H2wing(1); #78: H3wing(1); #14: H45wing(0); { #117: URt12456; #104: HUR; } #24: xchain(1); #120: XYchain(1); #26: AIC(1); #13: AICWals(1); #97: alsxz(0); #104: Ahsxz(0); #121: alsxy(0); #25: AAls2RC(0); #11:AlsME(1); #22:NalsNRC(1); #23: alsWwing(0); #1: alsMwing(0); #4: alsSwing(0); #98: Barns(1,0,0,6); #116: transbarns(1,0,0,6); #103: transalsxz(1); #107: transalsxy(1); #100: Suedecoq(1,1,2); #69: DeathBlossom(1,2,3); #106: DDS(1,0,9); #111: ADDS(1,0,9); #109: skloop(1); #74: msls(1); #118: TransADDS(1,0,6); #119: Transxychain(0); #102:fishfinder(0,0,0); //#116: fishfinder2(3,5); #96: solve; //#06: bruteforce; #99: issomorph('0','s','f'); // manual puzzle swapping. #10: Symetricalplacements(#10);// FixedBoxes; #6: Symetricalplacements(#6);// BoxesMnBands; #16: Symetricalplacements(#16);// boxesMTri; #21: Symetricalplacements(#21);// rotsym; #18: Symetricalplacements(#22);// diasym; #5: Symetricalplacements(#5);//sticks; #42: Symetricalplacements(#42);//all; #17: Symetricalplacements(#17);// automorph finder; #112: potential; end; queryperformancecounter (et); queryperformancefrequency (hz); ms := (et - st) * 1000.0 / hz; gotoxy(1,54); write( 'Total cpu time = '); gotoxy(1,55); write(ms:16:8,' millieseconds'); ms := 1 * 1000.0 / ms; gotoxy(1,57); write( 'Solving rate = '); gotoxy(1,58); write(ms:16:8,' puzzles / second'); if active= true then begin sbrc; errorcheck; wpm(0,0,0); end; if v =#96 then wpm(0,0,0); if v = #99 then wpm(1,0,0); end;

Main Body: Show

Code: Select all: program stormdoku; //notes popcnt(dword(set variable))); // counts # elments in a set uses crt,windows,Largesets,generics.collections;//,Dialogs; {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} {$include Global.pas} //virables {$include writexy.pas} // screen writing tool {$include location.pas} // writes sector/b/r/c locations per cell {$include Curser.pas} // moves around the grid screen {$include Curserpm.pas} // moves around the pm screen {$include viewtables.pas} // extended table view {$include WPM.pas} // displaying data function {$include techdisplay.pas} // write to screen functions for technique sets {$include chaindisplay.pas} // writting function for chain codes{upgrading techdisplay} {$include Griddisplay.pas} // grid layout setup {$include help.pas} // information for keystrokes {$include tools.pas}// builds the peers list and combination sets {$include errorcheck.pas} // checks the grid for invalid states {$include startuptools.pas} // intiation tools for grid starting points {$include CellCombo.pas} // {runs after sbrc calls} builds data tables for the 0..510 combinations for sets in sectors and cells {$include ERIfinder.pas} // builds the ERI tables {$include alsbuilder.pas} // {runs after sbrc calls} als & ahs data builder} {$include Stronglinkbuilder.pas} // runs after sbrc call,: strong link data builder {$include sbrc.pas} // calculator tool for setting variables {$include Load.pas} // loads a saved data file {$include save.pas} // save a grid to data file {$include import.pas} // imports a 81 character string and aranges it on the grid {$include SymetricalPlacement.pas} // collection of gurths symetrical methods for solving {$include solvingtechniques.pas} // all solving tools added todate {$include Solve.pas} // solving code that searches all techniques on a given grid {$include BatchSolve.pas} // batch - solving code for a txt file containing puzzles {$include TimeControl.pas} // controls the execution of solving commands {$include dlx_solve.pas} // dancing links unique proticals {$include GenSolver.pas} // solving techniques added to generator {$include DLX.pas} // dancing links execution calls {$include generator.pas} // grid generator - has a odd glitch and will crash sometimes //main body begin Clrscr; Window(1,1,240,240); table:=false; Unique:=true; TextBackGround(COLBG); peers; RCBpeers; combo; setCellsec; lookupSectorRBC; sectoroverlap; viewgiven; viewpm; Help; displayTechnique; initiate; wpm(0,0,0); x:=0; y:=0; repeat curser( rset[x,y] ,COLBG,1); ch:=readkey; {add a digit to cell } if( ch=' ') then ch:='0'; if( ch in ['1'..'9']) then begin if s[rset[x,y]] <> [] then begin nsector[rx[rset[x,y]]]:= Nsector[rx[rset[x,y]]] - s[rset[x,y]]; nsector[cy[rset[x,y]]+9]:= nsector[cy[rset[x,y]]+9] - s[rset[x,y]]; nsector[bxy[rset[x,y]]+18]:= nsector[bxy[rset[x,y]]+18] - s[rset[x,y]]; s[rset[x,y]]:=[ord(ch) - ord('0')]; nsector[rx[rset[x,y]]]:= Nsector[rx[rset[x,y]]] + [ord(ch) - ord('0')]; nsector[cy[rset[x,y]]+9]:= nsector[cy[rset[x,y]]+9] + [ord(ch) - ord('0')]; nsector[bxy[rset[x,y]]+18]:= nsector[bxy[rset[x,y]]+18] + [ord(ch) - ord('0')]; for iter in peer[rset[x,y]] do if s[iter]<> [] then begin nsector[rx[iter]]:= Nsector[Rx[iter]] + s[iter]; nsector[cy[iter]+9]:= Nsector[cy[iter]+9] + s[iter]; nsector[bxy[iter]+18]:= Nsector[bxy[iter]+18] + s[iter]; end; end else begin nsector[rx[rset[x,y]]]:= Nsector[rx[rset[x,y]]] +[ord(ch) - ord('0')]; nsector[cy[rset[x,y]]+9]:= nsector[cy[rset[x,y]]+9] + [ord(ch) - ord('0')]; nsector[bxy[rset[x,y]]+18]:= nsector[bxy[rset[x,y]]+18] + [ord(ch) - ord('0')]; s[rset[x,y]]:= [ord(ch) - ord('0')]; exclude(ocell,rset[x,y]); include(Acell,rset[x,y]); end; sbrc; errorcheck; wpm(0,1,rset[x,y]); end; {delete charcter in cell} if ( ch=#8 ) or ( ch=#83 ) or (ch='0') then begin for iter in peer[rset[x,y]] do Ipm[iter]:= ipm[iter] - S[rset[x,y]]; ipm[rset[x,y]]:=[]; nsector[rx[rset[x,y]]]:= Nsector[rx[rset[x,y]]] - s[rset[x,y]]; nsector[cy[rset[x,y]]+9]:= nsector[cy[rset[x,y]]+9] - s[rset[x,y]]; nsector[bxy[rset[x,y]]+18]:= nsector[bxy[rset[x,y]]+18] - s[rset[x,y]]; s[rset[x,y]]:=[]; for iter in peer[rset[x,y]] do if s[iter]<> [] then begin nsector[rx[iter]]:= Nsector[Rx[iter]] + s[iter]; nsector[cy[iter]+9]:= Nsector[cy[iter]+9] + s[iter]; nsector[bxy[iter]+18]:= Nsector[bxy[iter]+18] + s[iter]; end; exclude(Acell,rset[x,y]); include(ocell,rset[x,y]); sbrc; errorcheck; wpm(0,1,rset[x,y]); end; {functions} { 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 y:=0; if( x < 0 ) then x:=8; if( x > 8 ) then x:=0; if( ch=#105 ) then import; {load from saved grid } if( ch=#76 ) then begin load; sbrc; wpm(1,0,0); errorcheck; end; {load pm from saved } if( ch=#108 ) then begin loadpm; sbrc; wpm(1,0,0); errorcheck; end; {import file} {save grid to file} if( ch=#19 ) then save; {save pm to file} if( ch=#115) then begin savepm; end; {reset everything} If( ch=#114 ) then begin initiate; sbrc; wpm(1,0,0); end; {clears the pencil mark space to blank } if (ch = #101) then begin emptypm; wpm(1,0,0) end; {turn on or off extended table generation} if (ch=#28) then begin if table = true then table:=false else table:= True; if table = true then begin sbrc; viewspace; end; textcolor(darkgray); if table = true then writexy(6,67,' Enabled '); if table = false then writexy(6,67,' Disabled '); textcolor(col2); end; {batch solve mode} if( ch=#126) then batch; {dancing links} if (ch = #70) then begin dlx; end; {shift F} {generate a grid} if (ch=#7) then begin generator; sbrc; wpm(1,0,0) end; {solving buttons} if ch in [#1,#4,#5,#6,#10,#11,#13,#14,#16,#17,#18,#20,#21,#22,#23,#24,#25,#26]+ [#42,#59,#60,#61,#62,#63,#64,#65,#66,#67,#68,#69] + [#74,#78,#84,#85,#86,#87,#88,#89,#90,#91,#92,#93,#94,#95]+ [#96,#97,#98,#99,#100,#102,#103,#104,#106,#107,#109]+ [ #110,#111,#112,#113,#116,#117,#118,#119,#120,#121]+ [#122,#133,#134,#135,#136,#137,#0138] then time(ch); { tabs into the pm grid } if (ch =#9 ) or (ch=#15) then repeat curserpm(rset[x,y],Colbg,1); ch:=readkey; { delete pms } if( ch in ['1'..'9']) then begin for iter:= 1 to 9 do if iter = ord(ch) - ord('0') then begin delpm[ rset[x,y] ]:=delpm[ rset[x,y] ] + [iter]; Ipm[ rset[x,y] ]:=Ipm[ rset[x,y] ] + [iter]; end; sbrc; errorcheck; wpm(0,2,rset[x,y]); end; {resest the pm deletions } if ( ch=#8 ) or ( ch=#83 ) or (ch='0') then begin delpm[ rset[x,y] ]:=[]; Ipm[ rset[x,y] ]:=[]; sbrc; errorcheck; wpm(0,2,rset[x,y]); 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; if (ch=#9 ) or (ch =#15) or (ch=#27 ) then begin if table = true then begin sbrc; viewspace; end; end; until (ch=#9) or (ch=#15) or (ch=#27); until (ch=#27); end.

solver: Show

Code: Select all: Procedure solve; var Count2,Countpm2: integer; begin repeat Countpm2:=countpm; count2:= count; if scount = 0 then break; {solved is empty grid is empty} if count = 0 then break; {no more empty cells} if unique = false then break; {errors on the grid} if (countpm2 = countpm) and (count2=count) then begin Hs(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin Ns(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin BLR(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin hp(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin np(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin xwing(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin ht(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin nt(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin hq(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin barns(1,3,1,3); //xy-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin barns(1,3,2,3); //xyz-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin nq(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin barns(1,4,0,4); //xyz-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin sky(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 smashi(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(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transbarns(1,3,1,3); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transbarns(1,3,2,3); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin mwing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transbarns(1,4,0,4); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin swing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin l2wing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin l3wing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin h2wing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin h3wing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin h45wing(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin iwwing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin xchain(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin xychain(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin barns(1,0,0,8); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin suedecoq(1,0,9); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin DeathBlossom(1,2,3); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transbarns(1,0,0,8); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transxychain(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin alsxz(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin ahsxz(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin alsMwing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin alsWwing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin alsSwing(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transalsxz(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin alsxy(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transalsxy(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin Aals2RC(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin dds(1,0,9); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin adds(1,0,6); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin transadds(1,0,6); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin aic(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin AlsME(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin aicwals(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin NalsNRC(0); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin fishfinder(1,5,1); if active= true then begin sbrc; end; end; errorcheck; until (countpm2=countpm) or (scount = 81) or (unique=false); end;

Generator sovler: Show

Code: Select all: Procedure solve2(K:integer); var Count2,Countpm2: integer; begin repeat Countpm2:=countpm; count2:= count; if count = 81 then break; if (countpm2 = countpm) and (count2 = count) and (k >0 ) then begin BLR(1); if active= true then begin sbrc; end; end; { if (countpm2 = countpm) and (count2 = count) and (k >8 ) then begin hp(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >8 ) then begin np(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >5 ) then begin xwing(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >5 ) then begin ht(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >5 ) then begin nt(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >5 ) then begin hq(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >10 ) then begin barns(1,3,1,3); //xy-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >11 ) then begin barns(1,3,2,3); //xyz-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >5 ) then begin nq(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >12 ) then begin barns(1,4,0,4); //xyz-wing if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >15 ) then begin sky(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >15 ) then begin kyte(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >16 ) then begin er(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >16 ) then begin swordfish(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >16 ) then begin jellyfish(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) then begin smashi(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >16) then begin smashiswords(1); if active= true then begin sbrc; end; end; if (countpm2 = countpm) and (count2 = count) and (k >16) then begin smashijelly(1); if active= true then begin sbrc; end; end;} until (countpm2=countpm) or (count = 81) end;

batch solver: Show

Code: Select all: {batch solve a file} procedure batch; var myfile:text; ior:integer; filename:string; verifygrid:integer; G2,S2:real; st,et,hz:int64; ms:double; Begin initiate; sbrc; wpm(0,0,0); G2:=0; S2:=0; repeat; writexy(2,26,' '); writexy(2,26, 'file path '); readln(filename); if (filename = ('')) or (filename = ('exit')) then exit else writexy(2,27,' '); writexy(2,28,' '); assign(myfile,filename); ior:= 0; {$I-} reset(myfile); {$I+} IOR:=ioresult; if Ior <> 0 then writexy(2,27,'file not found') else begin textcolor(yellow ); writexy(2,15,'Import'); delay(300); writexy(2,15,' '); textcolor(col2); end; until IoR = 0; queryperformancecounter (st); repeat begin initiate; readln(myfile,Grid); Verifygrid:= length(Grid); if verifygrid = 81 then begin arange; sbrc; errorcheck; g2:=g2+1; if unique = true then solve; if sCount=81 then s2:=s2+1; if (unique = false) then begin wpm(1,0,0); break; end; end; end; until eof(myfile); close(myfile); queryperformancecounter (et); queryperformancefrequency (hz); ms := (et - st) * 1000.0 / hz; gotoxy(1,54); write( 'Total cpu time = '); gotoxy(1,55); write(ms:16:4,' millieseconds'); ms := G2 * 1000.0 / ms; gotoxy(1,57); write( 'Solving rate = '); gotoxy(1,58); write(ms:16:4,' puzzles / second'); gotoxy(2,30); write('Solved ',round(S2),' | ',round(G2),' Puzzles'); end;{batch solve}

Technique linker: Show

DLX: Show

Dlx_solve: Show

Code: Select all: {$include exact.pas} {$link exact.o} {$linklib msvcrt} const undef = -1; var e : pexact_t; nvdlxh, nvdlxe : longint; vdlxa : array [0..80] of integer; vdlxh : array [0..729+324] of longint; vdlxe : array [0..4*729] of longint; procedure dlx_init_declare (); var n, r, c, b, d : integer; begin for n := 0 to 728 do vdlxh[n] := (exact_col shl 16) or n; for n := 0 to 324 do vdlxh[729+n] := (exact_row shl 16) or n; nvdlxh := 729 + 324; nvdlxe := 0; for r := 0 to 8 do for c := 0 to 8 do begin b := 3 * (r div 3) + (c div 3); for d := 0 to 8 do begin vdlxe[nvdlxe] := ( (9*r+c) shl 16) or (81*r+9*c+d); inc (nvdlxe); vdlxe[nvdlxe] := ( (81+9*r+d) shl 16) or (81*r+9*c+d); inc (nvdlxe); vdlxe[nvdlxe] := ((162+9*c+d) shl 16) or (81*r+9*c+d); inc (nvdlxe); vdlxe[nvdlxe] := ((243+9*b+d) shl 16) or (81*r+9*c+d); inc (nvdlxe); end; end; end; function dlx_solve (var a : array of integer) : integer; var n, r, c, d, i : integer; sp : ^longint; begin exact_reset (e); exact_declare (e, nvdlxh, nvdlxe, vdlxh, vdlxe); for r := 0 to 8 do begin for c := 0 to 8 do begin if a[9*r+c] <> undef then begin n := 81*r+9*c+a[9*r+c]; if (exact_pushable (e, n) = 0) then begin {writeln (stderr, 'conflicting input at r', r+1, 'c', c+1, 'd', a[9*r+c]+1);} exit (0); end; exact_push (e, n); end; end; end; sp := exact_solve (e, @n); if (sp = nil) then exit (0); for i := 0 to n-1 do begin r := sp[i] div 81; c := (sp[i] div 9) mod 9; d := sp[i] mod 9; a[9*r+c] := d; end; sp := exact_solve (e, @n); if (sp <> nil) then exit (2); exit (1); end;

exact used by dlx: Show

Code: Select all: {$ifndef exact_read} {$define exact_read} const exact_row = 1; exact_col = 2; type row_bitmap = bitpacked array [0..728] of boolean; col_bitmap = bitpacked array [0..728] of boolean; ent_bitmap = bitpacked array [0..531440] of boolean; pexact_rchead_t = ^exact_rchead_t; pexact_lrudrc_t = ^exact_lrudrc_t; exact_lrudrc_t = record left : pexact_lrudrc_t; right : pexact_lrudrc_t; up : pexact_lrudrc_t; down : pexact_lrudrc_t; row : pexact_rchead_t; col : pexact_rchead_t; end; exact_rchead_t = record links : exact_lrudrc_t; id : longint; count : longint; b : longint; end; exact_t = record root : exact_rchead_t; rchead_count : longint; lrudrc_count : longint; rchead_chunk : pexact_rchead_t; lrudrc_chunk : pexact_lrudrc_t; rowid_to_rowhead : ^longint; colid_to_colhead : ^longint; rowid_map : ^row_bitmap; colid_map : ^col_bitmap; entry_map : ^ent_bitmap; num_cols : longint; num_rows : longint; sum_b : longint; simple : longint; can_declare : longint; iteration_in_progress : longint; lock : longint; level : longint; soln_stack : ^longint; soln_stack_capacity : longint; num_push : longint; col_stack : pointer; filter_pos : ^longint; filter_stack : pointer; filter_stack_capacity : longint; cache : pexact_rchead_t; cache_branching_factor : longint; level_f : pointer; level_p : pointer; filter_f : pointer; filter_p : pointer; end; pexact_t = ^exact_t; exact_level_t = function (param : longint; sz : longint; var soln : array of longint) : longint; cdecl; exact_filter_t = function (param : longint; sz : longint; var soln : array of longint; colid : longint) : longint; cdecl; pexact_filter_t = ^exact_filter_t; pexact_level_t = ^exact_level_t; function exact_alloc: pexact_t; cdecl; external; procedure exact_free (e:pexact_t); cdecl; external; procedure exact_reset (e:pexact_t); cdecl; external; function exact_declare_row (e:pexact_t; i:longint; b:longint): longint; cdecl; external; function exact_declare_col (e:pexact_t; j:longint; u:longint): longint; cdecl; external; function exact_declare_entry (e:pexact_t; i:longint; j:longint): longint; cdecl; external; function exact_declare (e:pexact_t; nh:longint; nv:longint; h:plongint; v:plongint): longint; cdecl; external; function exact_can_declare (e:pexact_t): longint; cdecl; external; function exact_solve (e:pexact_t; n:plongint): plongint; cdecl; external; function exact_reset_solve (e:pexact_t): longint; cdecl; external; function exact_is_row (e:pexact_t; i:longint): longint; cdecl; external; function exact_is_col (e:pexact_t; j:longint): longint; cdecl; external; function exact_is_entry (e:pexact_t; i:longint; j:longint): longint; cdecl; external; function exact_num_rows (e:pexact_t): longint; cdecl; external; function exact_num_cols (e:pexact_t): longint; cdecl; external; function exact_get_rows (e:pexact_t; i:plongint): longint; cdecl; external; function exact_get_cols (e:pexact_t; j:plongint): longint; cdecl; external; function exact_push (e:pexact_t; j:longint): longint; cdecl; external; function exact_pop (e:pexact_t): longint; cdecl; external; function exact_pushable (e:pexact_t; j:longint): longint; cdecl; external; function exact_can_push (e:pexact_t): longint; cdecl; external; function exact_num_push (e:pexact_t): longint; cdecl; external; function exact_get_push (e:pexact_t; j:plongint): longint; cdecl; external; function exact_level (e:pexact_t; l:pexact_level_t; p:longint): longint; cdecl; external; function exact_filter (e:pexact_t; f:pexact_filter_t; p:longint): longint; cdecl; external; function exact_check (e:pexact_t): longint; cdecl; external; {$endif}

Generator: Show

Code: Select all: procedure generator; type hold= array of integer; Solved2 = array of nums; using = array of numberset; Var q,n,k,g2,w,j,iter:integer; used:using; attempt: nums; h:hold; s2: solved2; output: text; begin initiate; begin q:=81; Sbrc; w:=0; setlength(used,0); setlength(used,w+1); setlength(h,0); setlength(s2,0); setlength(s2,81); repeat randomize; repeat //while not (q in (ocell-used[w])) and ((ocell-used[w]) <> []) do begin q:=random(82)-1; end; write(' '); until (pm[q] <> []) and (nm[q]> 1) or ((ocell-used[w])=[]); attempt:=pm[q]; repeat if attempt <> [] then begin while not (n in attempt) do n:=random(10); end; S[q]:=[n]; nsector[Rx[q]]:=nsector[rx[q]] + [n]; nsector[Cy[q]+9]:=nsector[Cy[q]+9] + [n]; nsector[Bxy[q]+18]:=nsector[Bxy[q]+18] + [n]; include(Acell,q); exclude(ocell,q); //writexy(2,60,''); // write(q,' ',n,' ',unique,' ',w); Sbrc; errorcheck; if unique = false then begin attempt:=attempt -[n]; S[q]:=[]; nsector[Rx[q]]:=nsector[rx[q]] - [n]; nsector[Cy[q]+9]:=nsector[Cy[q]+9] - [n]; nsector[Bxy[q]+18]:=nsector[Bxy[q]+18] - [n]; include(ocell,q); exclude(acell,q); for iter in peer[q] do if s[iter] <> [] then begin for J in s[iter] do nsector[Rx[iter]]:=nsector[rx[iter]] + [j]; nsector[Cy[iter]+9]:=nsector[Cy[iter]+9] + [j]; nsector[Bxy[iter]+18]:=nsector[Bxy[iter]+18] + [j]; end; sbrc; end; until (unique = true) or (attempt = []); if (attempt = [] ) then include(used[w],q); if unique = true then begin inc(w); setlength(h,w+1); setlength(used,w+1); h[w]:=q; end; if (unique = false) and (attempt = []) {back track down a level if this step cant add a digit} then begin q:=h[w]; include(ocell,q); exclude(acell,q); nsector[Rx[q]]:=nsector[rx[q]] - S[q]; nsector[Cy[q]+9]:=nsector[Cy[q]+9] - s[q]; nsector[Bxy[q]+18]:=nsector[Bxy[q]+18] - s[q]; for iter in peer[q] do if s[iter] <> [] then begin for J in s[iter] do nsector[Rx[iter]]:=nsector[rx[iter]] + [j]; nsector[Cy[iter]+9]:=nsector[Cy[iter]+9] + [j]; nsector[Bxy[iter]+18]:=nsector[Bxy[iter]+18] + [j]; end; S[q]:=[]; dec(w); setlength(h,w+1); setlength(used,w+1); sbrc; end; if ( ocell * used[w] = ocell) or (zero = true) {back track down two levels if all cells cant add a digit} then begin for k:= 0 to 1 do begin q:=h[w]; include(ocell,q); exclude(acell,q); nsector[Rx[q]]:=nsector[rx[q]] - S[q]; nsector[Cy[q]+9]:=nsector[Cy[q]+9] - s[q]; nsector[Bxy[q]+18]:=nsector[Bxy[q]+18] - s[q]; for iter in peer[q] do if s[iter] <> [] then begin for J in s[iter] do nsector[Rx[iter]]:=nsector[rx[iter]] + [j]; nsector[Cy[iter]+9]:=nsector[Cy[iter]+9] + [j]; nsector[Bxy[iter]+18]:=nsector[Bxy[iter]+18] + [j]; end; S[q]:=[]; dec(w); setlength(h,w+1); setlength(used,w+1); sbrc; end; end; //writexy(2,61,''); // write(q,' ',n,' ',unique,' ',w); dlx; // if zero = true then writexy(2,66,'zero solutions'); until (unique = true) and (unique2 = true); wpm(1,0,0); end; gotoxy(2,60); assign(output,'C:\sudoku\Generator\Generated.txt'); append(output); writeln(output); for k:= 0 to 80 do if s[k] <> [] then begin for G2:= 1 to 9 do if g2 in s[k] then write(output,g2) end else write(output,'.'); close(output); end;

by **StrmCkr** » Wed Mar 02, 2016 6:25 pm

Issomorph changing tool: Show

Code: Select all: procedure issomorph( K2,B2,F2:Char); var K,B,F:char; xn,xl,n:integer; S2: array [cell] of nums; {solved grid copy} begin for xn:= 0 to 80 do begin s2[xn]:=S[xn]; end; initiate; for xn:= 0 to 80 do s[xn]:=s2[xn]; k:=k2; b:=b2; f:=f2; if not (K in ['d','t','s','b','c','r','m','p']) then begin writexy(2,29,' Which area to move?'); writexy(2,30,' D{igit},R{ow},C{ol},S{tack},B{and},T{ranspose},M{irror},P{ivot}'); K:=readkey; gotoxy(23,29); write(': ',K); end; case K of {R} #114: begin if not (B in ['1'..'9']) then begin writexy(2,31,' Which Row to move? {1..9}'); B:=readkey; write(': ',B); end; if not (F in ['1'..'9']) then begin writexy(2,32,' Swaping with Row?'); case B of #49,#50,#51 : write(' 1,2,3'); #52,#53,#54 : write(' 4,5,6'); #55,#56,#57 : 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,31,' Which Col to move? {1..9}'); B:=readkey; write(': ',B); end; if not (F in ['1'..'9']) then begin writexy(2,32,' Swaping with Col?'); case B of #49,#50,#51 : write(' 1,2,3'); #52,#53,#54 : write(' 4,5,6'); #55,#56,#57 : 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,31,' Which Band to Swap? {1..3}'); B:=readkey; write(': ',B); end; if not (F in ['1'..'3']) then begin writexy(2,32,' 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,31,' Which Stack to Swap? {1..3}'); B:=readkey; write(': ',B); end; if not (F in ['1'..'3']) then begin writexy(2,32,' 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,31,' Transposing Grid (Diagonal reflection & Anti Diagonal Reflection)'); if not (b in ['1'..'2'] ) then begin writexy(2,32,' Diagonal / Anti Diagonal ? {1,2} '); B:=readkey; write(': ',B); end; if b = '1' then begin for xn:= 0 to 8 do for n:= 0 to 8 do begin S[Rset[xn,n]]:=s2[Cset[xn,n]]; end; end; if b = '2' then begin for xn:= 8 downto 0 do for n:= 8 downto 0 do begin S[Rset[n,xn]]:=s2[Cset[8-n,8-xn]]; end; end; end; {Transpose} {D} #100: begin if not (B in ['1'..'9'] ) then begin writexy(2,31,' Which Digit to Swap? {1..9}'); B:=readkey; write(': ',B); end; if not (F in ['1'..'9'] ) then begin writexy(2,32,' Swaping with Digit {1..9}'); F:=readkey; write(': ',F); end; For xn:= 0 to 80 do begin if S2[xn]= [ord(b)-48 ] then begin s[xn]:=[ord(F)-48]; end; if S2[xn]= [ord(F)-48 ] then s[xn]:=[ord(B)-48]; end; end; {Mirror} #109: begin if not(k2 in['m']) then writexy(2,31,' Mirror Grid (Reflection)'); if not (b in ['1'..'2'] ) then begin writexy(2,32,' Horizontal / Vertical ? {1,2}'); B:=readkey; write(': ',B); end; if B ='1' then begin for n:= 0 to 8 do for xn:= 0 to 8 do S[rset[xn,n]]:=S2[Rset[(8-xn),n]]; end; if B ='2' then begin for n:= 0 to 8 do for xn:= 0 to 8 do S[Cset[xn,n]]:=S2[Cset[(8-xn),n]]; end; end; {Pivot/quater turn} #112: begin if not(k2 in['p']) then writexy(2,31,' Pivot Grid ( 1/4 turn)'); if not (b in ['1'..'2'] ) then begin writexy(2,32,' Left / Right ? {1,2}'); B:=readkey; write(': ',B); end; if b = '1' then begin for xn:= 0 to 8 do for n:= 8 downto 0 do begin S[Cset[xn,(8-n)]]:=s2[Rset[xn,n]]; end; end; if b = '2' then begin for xn:= 8 downto 0 do for n:= 0 to 8 do begin S[Cset[xn,n]]:=s2[Rset[(8-xn),n]]; end; end; end; {pivit} end; if not (K2 in ['d','t','s','b','c','r','m','p']) then begin writexy(2,29,' '); writexy(2,30,' '); writexy(2,31,' '); writexy(2,32,' '); end; for xL:=0 to 80 do if s[xl] <> [] then begin nsector[Rx[xl]]:=nsector[rx[xl]] + s[xl]; nsector[Cy[xl]+9]:=nsector[cy[xl]+9] + s[xl]; nsector[bxy[xl]+18]:=nsector[Bxy[xl]+18] + s[xl]; exclude(ocell,xl); include(Acell,xl); end; {sbrc; errorcheck; wpm(1,0,0);} end; {issomorphic transformation}

isso morpher 2: Show

Code: Select all: {used by codes for faster translations} procedure issomorph2( K2,b2,f2:Char{b2,f2:char}); var K:char; xn,yn,xl,n,n2,b,f:integer; S5: array [cell] of nums; {solved grid copy} c2: array [rcb] of numberset; {col} r2: array [rcb] of numberset; {row} d2: array [digits] of numberset; {digits} temp: numberset; begin for xn in rcb do begin r2[xn]:=rcbnum[xn]; c2[xn]:=rcbnum[xn+9]; d2[xn+1]:=[]; end; for xn:= 0 to 80 do begin for n in s[xn] do include(d2[n],xn); s5[xn]:=S[xn]; end; initiate; k:=k2; b:=ord(b2)-49; f:=ord(f2)-49; case K of {R} #114: begin temp:=r2[b]; r2[b]:=r2[f]; r2[f]:=temp; end; {row} {C} #99: begin temp:=c2[b]; c2[b]:=c2[f]; c2[f]:=temp; end; {col} {Band} #98: begin for n:= 0 to 2 do begin temp:=r2[((b)*3)+n]; r2[((b)*3)+n]:=r2[((f)*3)+n]; r2[((f)*3)+n]:=temp; end; end; {Band} {stack} #115: begin for n:= 0 to 2 do begin temp:=c2[((b)*3)+n]; c2[((b)*3)+n]:=c2[((f)*3)+n]; c2[((f)*3)+n]:=temp; end; end; {stack} {Transpose} #116: begin if b = 0 then for xn:= 0 to 8 do begin temp:=r2[xn]; R2[xn]:=C2[xn]; c2[xn]:=temp; end; if b = 1 then for xn:= 8 downto 0 do begin n:= (8-xn); temp:=r2[xn]; r2[xn]:=c2[n]; c2[n]:=temp; end; end; {Transpose} {Mirror} #109: begin temp:=[]; if b = 0 then begin for xn:= 0 to 3 do begin n:=(8 - xn); temp:=R2[xn]; R2[xn]:=R2[n]; R2[n]:=temp; end; end; if b = 1 then begin for xn:= 0 to 3 do begin n:=(8 - xn); temp:=C2[xn]; C2[xn]:=C2[n]; C2[n]:=temp; end; end; end; {Mirror} {Pivot/quater turn} #112: begin if b = 0 {Left} then begin for xn:= 0 to 8 do begin n:=8-xn; R2[xn]:=rcbnum[n+9]; c2[xn]:=rcbnum[xn]; end; end; if b = 1 {right} then begin for xn:= 0 to 8 do begin n:=8-xn; R2[xn]:=rcbnum[xn+9]; c2[xn]:=rcbnum[n]; end; end; end; {D} #100: begin temp:= d2[b+1]; d2[b+1]:=d2[f+1]; d2[f+1]:=temp; end; end;{cases} //sets the grid up after changes for xn:= 0 to 8 do for yn:= 0 to 8 do for n in (r2[xn] * c2[yn]) do for n2 in [1..9] do if n in d2[n2] then s[rset[xn,yn]]:= [n2]; for xL:=0 to 80 do if s[xl] <> [] then begin nsector[Rx[xl]]:=nsector[rx[xl]] + s[xl]; nsector[Cy[xl]+9]:=nsector[cy[xl]+9] + s[xl]; nsector[bxy[xl]+18]:=nsector[Bxy[xl]+18] + s[xl]; exclude(ocell,xl); include(Acell,xl); end; {sbrc; errorcheck; wpm(1,0,0);} end;

Symetrical program: Show

Code: Select all: //this code finds everything {automoprhs, and symetrcial identities} procedure Symetricalplacements(m:char); {symetrical placement sequence of morphs(none,12,23,12,23,12)} const s1: array [0..5] of integer = (0,49,50,49,50,49); var a,b,c,d,e,f,g,h,i,xn,yn,n,n2:integer; check:boolean; S7: array [cell] of nums; {solved grid copy} s4: array [cell] of nums; {temp copy} begin yn:=0; for xn:= 0 to 80 do s7[xn]:=s[xn]; issomorph2(#100,chr(50),chr(54)); {tanspose} for a:= 0 to 1 do begin if a > 0 then issomorph2(#116,chr(s1[a]),chr(s1[a]+1)); {tanspose} for b:= 0 to 5 do begin if b > 0 then issomorph2(#115,chr(s1[b]),chr(s1[b]+1)); {stack} for c:= 0 to 5 do begin if c > 0 then issomorph2(#98,chr(s1[c]),chr(s1[c]+1)); {band} for d:= 0 to 5 do begin if d > 0 then issomorph2(#114,chr(s1[d]),chr(s1[d]+1)); {Row 123} for e:= 0 to 5 do begin if e > 0 then issomorph2(#114,chr(s1[e]+3),chr(s1[e]+4)); {Row 456} for f:= 0 to 5 do begin if f > 0 then issomorph2(#114,chr(s1[f]+6),chr(s1[f]+7)); {Row 789 } for g:= 0 to 5 do begin if g > 0 then issomorph2(#99,chr(s1[g]),chr(s1[g]+1)); {col 123 } for h:= 0 to 5 do begin if h > 0 then issomorph2(#99,chr(s1[h]+3),chr(s1[h]+4)); {col 456 } for i:= 0 to 5 do begin if i > 0 then issomorph2(#99,chr(s1[i]+6),chr(s1[i]+7)); {col 789 } case m of // individuals #10: if ((g+h+i) = 0) then FixedBoxes; #6: if (b = 0) then BoxesMnBands; #16: if((b+c) = 0)then boxesMTri; #21: if (a = 0) then rotsym; #18: if (a = 0) then diasym; #5: if (b+(g+h+i)= 0) then sticks; end; if m = #42 {looks for all of them} then begin if ((g+h+i) = 0) then FixedBoxes; if (b = 0) then BoxesMnBands; if ((b+c) = 0) then boxesMTri; if (a = 0) then rotsym; if (a = 0) then diasym; if (b+(g+h+i)= 0) then sticks; end; { this next section checks for auto-morphs need to issolate to its own code} if m = #17 // finds the automorphs. then begin for xn:=0 to 80 do s4[xn]:=s[xn]; for xn:= 0 to 80 do for n in s[xn] do for n2 in s7[xn] do issomorph2(#100,chr(48+n),chr(48+n2)); check:= True; for xn:= 0 to 80 do begin if ((s7[xn] = []) and (S[xn] <> []) ) or ((s7[xn] <> []) and(S[xn] = [])) or (s[xn] <> s7[xn]) then Check:=false; if check = false then break; if xn = 80 then begin inc(yn); gotoxy(2,66+yn); write('automorph (',yn,'): ',a,',',b,',',c,',',d,',',e,',',f,',',g,',',h,',',i); sbrc; wpm(1,0,0); // delay(150); end; end; for xn:= 0 to 80 do for n in s[xn] do for n2 in s4[xn] do issomorph2(#100,chr(48+n),chr(48+n2)); end; gotoxy(2,63); write(a,',',b,',',c,',',d,',',e,',',f,',',g,',',h,',',i); if i = 5 then issomorph2(#99,chr(50+6),chr(50+7)); {col 789 } end; if h = 5 then issomorph2(#99,chr(50+3),chr(50+4)); {col 456 } end; if g = 5 then issomorph2(#99,chr(50),chr(50+1)); {col 123 } end; if f = 5 then issomorph2(#114,chr(50+6),chr(50+7)); {Row 789 } end; if e = 5 then issomorph2(#114,chr(50+3),chr(50+4)); {Row 456 } end; if d = 5 then issomorph2(#114,chr(50),chr(50+1)); {Row 123 } end; if c = 5 then issomorph2(#98,chr(50),chr(50+1)); {band} end; if b = 5 then issomorph2(#115,chr(50),chr(50+1)); {stack} end; {a} if a = 1 then issomorph2(#116,chr(49),chr(49+1)); {issomorph} end; wpm(1,0,0); end;

RotationSym: Show

Code: Select all: procedure Rotsym;{symetrical placement} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {Half-Turn} {tanspose diagonal} for n:= 49 to 49 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; {transpose anti-diagonal} for n:= 50 to 50 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Rotational symmetries: Half-Turn'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 to 50 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; {quater Turn} { for n:= 49 to 49 do begin n2:=n+2; issomorph2(#98,chr(n),chr(n2)); end; for n:= 49 to 49 do for n3:= 0 to 2 do begin n2:=n+2 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end;} {the above 2 translates into a horrizontal mirror move} for n:= 49 to 49 do begin n2:=n+2; issomorph2(#109,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Rotational symmetries: Quater-Turn'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} {for n:= 49 to 49 do for n3:= 2 downto 0 do begin n2:=n+2 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 49 to 49 do begin n2:=n+2; issomorph2(#98,chr(n),chr(n2)); end;} for n:= 49 to 49 do begin n2:=n+2; issomorph2(#109,chr(n),chr(n2)); end; for n:= 49 to 49 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; end;

diagonalsym: Show

Code: Select all: procedure diasym;{symetrical placement} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {Diagonal-Mirror} for n:= 49 to 49 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Diagonal symmetries: Diagonal-Mirror'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Dm +JD} for n:= 49 to 50 do begin n2:=n+1; issomorph2(#115,chr(n),chr(n2)); end; for n:= 49 to 50 do begin n2:=n+1; issomorph2(#98,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Diagonal symmetries: DM + JD'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 downto 49 do begin n2:=n+1; issomorph2(#98,chr(n),chr(n2)); end; for n:= 50 downto 49 do begin n2:=n+1; issomorph2(#115,chr(n),chr(n2)); end; {DM + mD} for n:= 49 to 50 do for n3:= 0 to 2 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 49 to 50 do for n3:= 0 to 2 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Diagonal symmetries: DM + MD'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; for n:= 50 downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 49 to 49 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; {anti-Diagonal-Mirror} for n:= 50 to 50 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Diagonal symmetries: anti-Diagonal-Mirror'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 to 50 do begin n2:=n+1; issomorph2(#116,chr(n),chr(n2)); end; end;

sticks: Show

Code: Select all: procedure sticks;{symetrical placement} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {Col - sticks} for n:= 49 to 49 do begin n2:=n+2; issomorph2(#98,chr(n),chr(n2)); end; for n:= 49 to 49 do for n3:= 0 to 2 do begin n2:=n+2 + (n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: Column Sticks'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {cs + mc} for n:= 49 to 50 do for n3:= 0 to 2 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: CS + MC'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; {cs + Jr} for n:= 49 to 50 do for n3:= 0 to 0 do begin n2:=n+1 + (n3*3); issomorph2(#115,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: CS + JR'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {cs + Gr/band2, Jr/B13} for n:= 49 to 50 do for n3:= 1 to 1 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: CS + GR/B2, JR/B13'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 downto 49 do for n3:= 1 to 1 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; {Cs + GR} for n:= 49 to 50 do for n3:= 0 to 2 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: CS + GR'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {cs + JR/B2, GR/B13} {notes - turned off "mid R swap from above step} for n:= 50 downto 49 do for n3:= 1 to 1 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: CS + JR/B2, GR/B13'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; { Reversion} for n:= 49 to 50 do {do not reverse this one! it corrects the last step to run a 3 cycle below} for n3:= 1 to 1 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 50 downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 50 downto 49 do for n3:= 0 to 0 do begin n2:=n+1 + (n3*3); issomorph2(#115,chr(n+(n3*3)),chr(n2)); end; for n:= 49 downto 49 do for n3:= 2 downto 0 do begin n2:=n+2 + (n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; for n:= 49 downto 49 do begin n2:=n+2; issomorph2(#98,chr(n),chr(n2)); end; {row - sticks} for n:= 49 to 49 do begin n2:=n+2; issomorph2(#115,chr(n),chr(n2)); end; for n:= 49 to 49 do for n3:= 0 to 2 do begin n2:=n+2 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Sticks symmetries: Row Sticks'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; { Reversion} for n:= 49 downto 49 do for n3:= 2 downto 0 do begin n2:=n+2 + (n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; for n:= 49 downto 49 do begin n2:=n+2; issomorph2(#115,chr(n),chr(n2)); end; end;

boxMnbands: Show

Code: Select all: procedure BoxesMnBands; {symetrical placement} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {jumping - Rows} for n:= 49 to 50 do begin n2:=n+1 ; issomorph2(#115,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: Jumping Rows '); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {2 Jr 1 GR} for n:= 49 to 50 do for n3:= 0 to 0 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: 2JR - 1 GR '); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {1 Jr 2 GR} for n:= 49 to 50 do for n3:= 1 to 1 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: 1JR - 2 GR '); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; { Gliding Row} for n:= 49 to 50 do for n3:= 2 to 2 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: Gliding Row'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Waveing Rows} for n:= 49 to 50 do begin n2:=n+1; issomorph2(#99,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: Waveing Row '); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {1 Fr, 2 wr} for n:= 50 downto 49 do for n3:= 2 downto 2 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: 1 FR, 2 WR'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {2 FR, 1 WR } for n:= 50 downto 49 do for n3:= 1 downto 1 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: 2 FR, 1 WR'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Full - Row } for n:= 50 downto 49 do for n3:= 0 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move in bands: Full Row'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Reversion} for n:= 50 downto 49 do for n3:= 0 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; for n:= 50 downto 49 do begin n2:=n+1; issomorph2(#115,chr(n),chr(n2)); end; end;

boxMtri: Show

Code: Select all: procedure boxesMTri;{symetrical placement} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {jumping - Diagonals} for n:= 49 to 50 do begin n2:=n+1; issomorph2(#98,chr(n),chr(n2)); end; for n:= 49 to 50 do begin n2:=n+1; issomorph2(#115,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move Triangular: Jumping Diagonal'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Broken - Cols} for n:= 49 to 50 do begin n2:=n+1 ; issomorph2(#114,chr(n),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move Triangular: Broken Cols'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Full Diagonals} for n:= 49 to 50 do for n3:= 0 to 0 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Boxes move Triangular: Full Diagonal'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {reversion} for n:= 50 downto 49 do begin n2:=n+1 ; issomorph2(#99,chr(n),chr(n2)); end; for n:= 50 downto 49 do begin n2:=n+1 ; issomorph2(#114,chr(n),chr(n2)); end; for n:= 50 downto 49 do begin n2:=n+1 ; issomorph2(#115,chr(n),chr(n2)); end; for n:= 50 downto 49 do begin n2:=n+1; issomorph2(#98,chr(n),chr(n2)); end; end;

Fixedboxes: Show

Code: Select all: Procedure FixedBoxes; {symetrical placement technique} var xn,n,n2,n3:integer; S3: array [cell] of nums; {solved grid copy} Dj: array [digits] of nums; { digit exchange listing} use:nums; check: boolean; begin for xn:= 0 to 80 do s3[xn]:=s[xn]; {Fixed boxes: Mini Row/Col} for n:= 49 to 50 do for n3:= 0 to 2 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Fixed boxes: Mini-Row/Col '); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {Fixed boxes: 2 MR 1 MD} for n:= 49 to 50 do for n3:= 0 to 0 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Fixed boxes: 2 Mini-Row/Col + MD'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {fixed boxes 1 mr 2md} for n:= 49 to 50 do for n3:= 1 to 1 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Fixed boxes: 1 Mini-Row/Col + 2 MD'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {fixed boxes md} for n:= 49 to 50 do for n3:= 2 to 2 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; For n:= 1 to 9 do dj[n]:=[]; check:= True; for xn:= 0 to 80 do begin if ((s3[xn] = []) and (S[xn] <> []) ) or ((s3[xn] <> []) and (S[xn] = [])) then Check:=false; if check = false then break; if (S3[xn] <> [] ) and (S[xn] <> [] ) and (S3[xn] * s[xn] <> s3[xn]) then for n in s3[xn] do for n2 in s[xn] do begin dj[n]:= dj[n] + [n2] +[n] ; dj[n2]:= dj[n2] + [n] + [n2]; end; end; if check = true then begin writexy(2,64,'Fixed boxes: Mini Diagonals'); use:=[]; gotoxy(2,65); For n:= 1 to 9 do if [n] * use = [] then begin write('( ',n,' '); for n2 in Dj[n]-[n] do begin write(n2,' '); use:=use +[n,n2]; end; write('),'); end; end; {revert grid} for n:= 50 Downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#99,chr(n+(n3*3)),chr(n2)); end; for n:= 50 downto 49 do for n3:= 2 downto 0 do begin n2:=n+1 +(n3*3); issomorph2(#114,chr(n+(n3*3)),chr(n2)); end; end;

inclusion file: Show

by **StrmCkr** » Sun Dec 11, 2016 9:50 pm

large sets: Show

Code: Select all: // this is a test code for attempting to get POM to work correctly as free pascal is limited to set sizes of 256 and pom needs more {$mode objfpc}{$inline on} { A simple way to implement large or huge sets. (c) 2019 Thaddy de Koning. No license and not re-licensable: free for all to use. Copyright holds: You can not claim license nor copyrigths } {* added by strmck 2022} unit largesets; { Operator Action --------------------------------------------- + Union - Difference * Intersection >< Symmetric difference <= Contains >= Left hand side set is a superset of the one on the right * = equality: use function equality( which does (><) and evaultes if its empty)* <> inequality: use function inequality( which does (><) and evaulates if its not empty)* include2 Include an element in the set exclude2 Exclude an element from the set in Check if an single element is in a set notes: Twordset can be modifed for Tdwordset/Tqwordset include & exclude renamed to allow for inherinted function include/exclude to function normally } interface uses generics.collections; type TWordSet = specialize TSortedHashSet<word >; { union } operator + (const a,b:TWordset):TWordSet; { difference } operator - (const a,b:Twordset ):TWordSet; { intersection } operator * (const a,b:TwordSet ):TWordSet; { symmetric difference } operator >< (const a,b:TWordSet ):TWordSet; { contains } operator <= (const a,b:TWordSet ):Boolean; { Left hand side set is a superset of the one on the right } operator >= (const a,b:TWordSet ):Boolean; { in } operator in (const a:word; const b:TWordset ):Boolean; { include } procedure include2(const a:TWordSet; const b:Word); { exclude } procedure exclude2(const a:TWordSet;const b:Word); function Equality(const A,B:TWordSet):Boolean; function inEquality(const A,B:TWordSet):Boolean; implementation Var D: TwordSet; { union } operator + (const a,b:Twordset):TWordSet; begin d.Free; D := TWordSet.Create; D.unionWith(A); D.unionWith(B); Result := D; end; { difference } operator -(const a,b:Twordset):TWordSet; begin d.Free; D := TWordSet.Create; D.unionWith(A); D.ExceptWith(B); result:=D; end; { intersection } operator *(const a,b:TwordSet):TWordSet; begin d.Free; D := TWordSet.Create; D.unionWith(a); D.IntersectWith(b); Result := D; end; { symmetric difference } operator ><(const a,b:TWordSet):TWordSet; begin d.Free; D := TWordSet.Create; D.unionWith(a); D.SymmetricExceptWith(b); Result := D; end; { contains } operator <=(const a,b:TWordSet):Boolean; var c:word; begin Result := true; for c in a do if not b.contains(c) then begin Result := False; break; end; end; { Left hand side set is a superset of the one on the right } operator >=(const a,b:TWordSet):Boolean; var c:word; begin Result := true; for c in b do if not a.contains(c) then begin Result := False; break; end; end; {equality} { first checks if either set has diffrent values} Function Equality(const A, B: TWordSet): Boolean; var c:word; begin d.Free; Result := true; D := TWordSet.Create; D.unionWith(a); D.SymmetricExceptWith(b); for c in D do begin result:= False; break; end; end; Function inEquality(const A, B: TWordSet): Boolean; var c:word; begin d.Free; Result := false; D := TWordSet.Create; D.unionWith(a); D.SymmetricExceptWith(b); for c in D do begin result:= True; break; end; end; { in } operator in (const a:word;const b:TWordset):Boolean; begin Result := b.Contains(a); end; { include } procedure include2(const a:TWordSet;const b:Word); begin a.Add(b); end; { exclude } procedure exclude2(const a:TWordSet;const b:Word); begin a.Remove(b); end; {counting function} function GetCount(const aSet: TWordSet): SizeInt; begin Exit(aSet.Count); end; end.

POM: Show

Code: Select all: // 46,656 potential single digit grids. procedure potential; type hold = array of integer; base = array of numberset; digit = array of numberset; var w1,w2,w3:TWordSet; setstuff: array [digits] of Twordset; Cellsetstuff: array [ digits,cell] of twordset; locked: array [digits] of numberset; deleted: array [digits] of numberset; stuff: array [digits] of numberset; alist:array[digits] of word; xn,w,p,n,n2,xn2,q,g,L,j,m,o,xn3,xn4,xn5:integer; output: text; step: base; h: hold; z:digit; begin for n:=1 to 9 do begin setstuff[n]:= twordset.create; for q in digitcell[n] do cellsetstuff[n,q]:=twordset.create; end; for n:= 1 to 9 do alist[n]:=0; for N:= 1 to 9 do begin locked[n]:=[]; deleted[n]:=[]; stuff[n]:= []; for xn:= 0 to 80 do begin if s[xn] = [n] then locked[n]:= locked[n]+ [xn]; if (s[xn] <> [n] ) and not( n in pm[xn]) then deleted[n]:= deleted[n] + [xn]; end; end; {startin cell} {delete the exsiting output if you want to rebuild it unhash this section} {assign(output,'C:\sudoku\pom\output.txt'); erase(output); rewrite(output); close(output); } assign(output,'c:\sudoku\pom\exclusions.txt'); erase(output); rewrite(output); close(output); {smashes all prebuilt txt files of potential solutions for digits 1-9 } for n:= 1 to 9 do begin case n of 1: assign(output,'C:\sudoku\pom\1.txt'); 2: assign(output,'C:\sudoku\pom\2.txt'); 3: assign(output,'C:\sudoku\pom\3.txt'); 4: assign(output,'C:\sudoku\pom\4.txt'); 5: assign(output,'C:\sudoku\pom\5.txt'); 6: assign(output,'C:\sudoku\pom\6.txt'); 7: assign(output,'C:\sudoku\pom\7.txt'); 8: assign(output,'C:\sudoku\pom\8.txt'); 9: assign(output,'C:\sudoku\pom\9.txt'); end; erase(output); rewrite(output); close(output); end; setlength(step,0); setlength(z,0); setlength(h,0); for xn:= 80 downto 72 do begin w:=0; {step count} setlength(h,(w+1)); {set the array size to w} h[w]:=xn; {starting point for first substep} setlength(step,(w+1)); {set the array size to w} step[w]:= [xn]; { keeps track of what cells are used at each step W } setlength(z,w+1); {prevent occupy "new starting point" } z[w]:= peer[xn] + [xn]; {used cells starting point} repeat for p:= h[w] downto (72-((w+1)*9)) do {iteration of peers} if p in ([0..80] - z[w] ) // added check used state then begin h[w]:=h[w]-1; { advance the peer count for step w} inc(w); {increase the step count} setlength(h,(w+1)); setlength(step,(w+1)); {increse the array size to w} step[w]:= step[w-1] + [p] ; {set the step cell active for the newly created step w} h[w]:= 71 - ((w)*9) ; {set the new step w as 71 potential choice cells} setlength(z,w+1); { increase size to w} z[w]:= z[w-1] + peer[p] + [p]; {used cells new point} break; end else h[w]:=h[w]-1; {if the above is false then advance the peer number} if w = 8 then begin { generate the whole list to a specific file} {assign(output,'C:\sudoku\pom\output.txt'); append(output); for n in step[w] do write(output,n,' '); writeln(output); close(output); } for n:= 1 to 9 do begin case n of 1: assign(output,'C:\sudoku\pom\1.txt'); 2: assign(output,'C:\sudoku\pom\2.txt'); 3: assign(output,'C:\sudoku\pom\3.txt'); 4: assign(output,'C:\sudoku\pom\4.txt'); 5: assign(output,'C:\sudoku\pom\5.txt'); 6: assign(output,'C:\sudoku\pom\6.txt'); 7: assign(output,'C:\sudoku\pom\7.txt'); 8: assign(output,'C:\sudoku\pom\8.txt'); 9: assign(output,'C:\sudoku\pom\9.txt'); end; if ( step[w] * locked[n] = locked[n] ) and ( step[w] * deleted[n] = [] ) then begin inc(alist[n]); append(output); for q in (step[w] - locked[n]) do begin write(output, q,' '); include2(cellsetstuff[n,q],alist[n]); include2(setstuff[n],alist[n]); end; writeln(output); close(output); stuff[n]:= stuff[n] + (step[w] - locked[n]); end; end; { N choice} end; {w=8} if ((h[w] < 0 ) and (w > 0 )) or (w=8) or ( ( [0..80] - z[w] = [] ) and (W < 8) and (w > 0) ) or ( (h[w] < (72 - ( (w+1)*9) ) ) and (w > 0) ) {the following resets the step to the previous state} then repeat begin w:=(w-1); setlength(h,(w+1)); h[w]:= h[w]; setlength(step,(w+1)); setlength(z,w+1); end; until ( w = 0 ) or (h[w] > ((71 - (w+1)*9)) ) until ((w = 0) and (h[w] < 0) ) or ( ( w = 0) and (h[w] < (72 -( (w+1)*9) ) ) ) end; {size printing of all sets} for n:= 1 to 9 do begin gotoxy(2,60+n); write(n,':= ',alist[n]); end; {size 1} for n:= 1 to 9 do if (stuff[n] <> []) and (stuff[n] * (digitcell[n] - (locked[n] + deleted[n]) ) = stuff[n]) and ( ((digitcell[n] - (locked[n] + deleted[n]) ) - stuff[n]) <> [] ) then begin assign(output,'C:\sudoku\pom\exclusions.txt'); append(output); write(output,n, ' @: '); // cell has no templates out of all of them. for xn in ((digitcell[n] - (locked[n] + deleted[n])) - stuff[n])do begin write(output,xn,' '); covered2[n]:=covered2[n]+[xn]; active:=true; end; //cell is exclusivly in all sets for xn in digitcell[n] do if equality(cellsetstuff[n,xn],setstuff[n]) then begin active:=true; covered[xn]:=covered[xn] + (pm[xn]-[n]); write(output,'*',xn,'<>( '); for o in pm[xn]-[n] do write(output,o,' '); write(output,') ') end; writeln(output); close(output); end; {size 1} {size 2} for n in [1..9] do for xn in digitcell[n] do for xn2 in digitcell[n]*[(xn+1)..80] do begin w1:=twordset.create; w1:= cellsetstuff[n,xn] + cellsetstuff[n,xn2]; if setstuff[n]<=w1 then begin for q in [1..9]-[n] do begin for g in setstuff[q] do if [xn,xn2] * digitcell[q] = [xn,xn2] then if (g in (cellsetstuff[q,xn])) and (g in (cellsetstuff[q,xn2])) then begin w2:=twordset.create; for L in digitcell[q] do if (g in cellsetstuff[q,l]) then begin exclude2(cellsetstuff[q,L],g); include2(w2,l); end; assign(output,'C:\sudoku\pom\exclusions.txt'); append(output); write(output,'(',n,')',xn,',',xn2,':('); for m in setstuff[n] do write(output,' ',m); write(output,' ) & '); write(output,'(',q,')',xn,',',xn2,':('); for o in (setstuff[q]) do write(output,' ',o); write(output,' ) '); write(output,'RT: ', G,' @ Digit: ',q, ' =>> <> '); exclude2(setstuff[q],g); for L in digitcell[q] do begin {no templates left for cells} w3:= setstuff[q] - cellsetstuff[q,l]; if equality(w3,cellsetstuff[q,l]) then begin write(output,L,' '); active:=true; covered2[q]:=covered2[q] + [L]; end; {digits are locked to all sets} if equality(cellsetstuff[q,l],setstuff[q]) then begin active:=true; covered[l]:=covered[l] + (pm[l]-[q]); write(output,'*',L,'<>( '); for o in pm[l]-[q] do write(output,o,' '); write(output,') ') end; end; writeln(output); close(output); include2(setstuff[q],g); for L in w2 do begin include2(cellsetstuff[q,L],g); end; w2.free; break; end; end; end; w1.free; end; {size 2} end;

by **StrmCkr** » Thu Jan 05, 2017 12:38 pm

Hidden single: Show

Code: Select all: {finds hidden singles} procedure Hs(K:integer); var xn,yn,n,g:integer; begin if k=0 then begin g:=0; setlength(techwrite,g+1,14); end; for xn:= 0 to 8 do for n:= 1 to 9 do begin if Sec[xn,n] = 1 then For yn:= 0 to 8 do if Rnsector[xn,n] = [yn] then begin active:=true; S[Rset[xn,yn]]:=[n]; include(nsector[xn],n); include(nsector[yn+9],n); include(nsector[bxy[rset[xn,yn]]+18],n); exclude(ocell,rset[xn,yn]); include(Acell,rset[xn,yn]); if k = 0 then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; techwrite[g,3]:=[n]; techwrite[g,2]:=[Rset[xn,yn]]; techwrite[g,n+3]:=peer[rset[xn,yn]] * digitcell[n]; G:=g+1; setlength(techwrite,g+1,14); end; end; if sec[xn+9,n] = 1 then For yn:= 0 to 8 do if Rnsector[xn+9,n] = [yn] then begin active:=true; S[Cset[xn,yn]]:=[n]; include(nsector[yn],n); include(nsector[xn+9],n); include(nsector[bxy[rset[yn,xn]]+18],n); exclude(ocell,Cset[xn,yn]); include(Acell,Cset[xn,yn]); if k = 0 then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; techwrite[g,3]:=[n]; techwrite[g,2]:=[Rset[xn,yn]]; techwrite[g,n+3]:=peer[rset[xn,yn]] * digitcell[n]; G:=g+1; setlength(techwrite,g+1,14); end; end; if sec[xn+18,n] = 1 then For yn:= 0 to 8 do if Rnsector[xn+18,n] = [yn] then begin active:=true; S[Bset[xn,yn]]:=[n]; include(nsector[Rx[bset[xn,yn]]],n); include(nsector[cy[bset[xn,yn]]+9],n); include(nsector[xn+18],n); exclude(ocell,bset[xn,yn]); include(Acell,bset[xn,yn]); if k = 0 then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; techwrite[g,2]:=[Rset[xn,yn]]; techwrite[g,3]:=[n]; techwrite[g,n+3]:=peer[rset[xn,yn]] * digitcell[n]; G:=g+1; setlength(techwrite,g+1,14); end; end; end; if k = 0 then chaindisplay(#59,G); end; {hidden singles}

Hidden Pair: Show

Code: Select all: {hidden pairs} procedure HP(k:integer); var xn,yn,n,n2,z,g,q:integer; begin if k =0 then begin g:=0; setlength(techwrite,g+1,14); end; For xn:= 0 to 8 do For n:= 1 to 8 do for n2:= (n+1) to 9 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 3 ) and (sec[xn,n2] > 0) and (sec[xn,n2] < 3 ) then for yn:= 9 to 44 do if Rnsector[xn,n] + Rnsector[xn,n2] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[rset[xn,z]]:= covered[rset[xn,z]] + (sectorRC[xn,z] - [n,n2]); if k = 0 then begin for q in (sectorRC[xn,z] - [n,n2])do techwrite[g,q+3]:=techwrite[g,q+3]+ [rset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [rset[xn,q]]; techwrite[g,3]:=[n,n2]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 3 ) and (sec[xn+9,n2] > 0) and (sec[xn+9,n2] < 3 ) then for yn:= 9 to 44 do if Rnsector[xn+9,n] + Rnsector[xn+9,n2] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[Cset[xn,z]]:= covered[Cset[xn,z]] + (sectorRC[xn+9,z] - [n,n2]) ; if k = 0 then begin for q in (sectorRC[xn+9,z] - [n,n2]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [Cset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [cset[xn,q]]; techwrite[g,3]:=[n,n2]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+18,n] > 0) and (sec[xn+18,n] < 3 ) and (sec[xn+18,n2] > 0) and (sec[xn+18,n2] < 3 ) then for yn:= 9 to 44 do if Rnsector[xn+18,n] + Rnsector[xn+18,n2] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[bset[xn,z]]:= covered[bset[xn,z]] +(sectorRC[xn+18,z] - [n,n2]); if k = 0 then begin for q in (sectorRC[xn+18,z] - [n,n2]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [bset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [bset[xn,q]]; techwrite[g,3]:=[n,n2]; g:=g+1; setlength(techwrite,g+1,14); end; end; end; if k = 0 then chaindisplay(#61,g); end;{hidden pair}

Hidden Tripple: Show

Code: Select all: {hidden triples} procedure HT(k:integer); var xn,yn,n,n2,n3,z,g,q:integer; begin if k =0 then begin g:=0; setlength(techwrite,g+1,14); end; For 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 (sec[xn,n] > 0) and (sec[xn,n] < 4 ) and (sec[xn,n2] > 0) and (sec[xn,n2] < 4 ) and (sec[xn,n3] > 0) and (sec[xn,n3] < 4 ) then for yn:= 45 to 128 do if Rnsector[xn,n] + Rnsector[xn,n2] + Rnsector[xn,n3] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[rset[xn,z]]:= covered[rset[xn,z]] + (sectorRC[xn,z]-[n,n2,n3] ); if k = 0 then begin for q in ( sectorRC[xn,z]-[n,n2,n3]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [rset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [rset[xn,q]]; techwrite[g,3]:=[n,n2,n3]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 4 ) and (sec[xn+9,n2] > 0) and (sec[xn+9,n2] < 4 ) and (sec[xn+9,n3] > 0) and (sec[xn+9,n3] < 4 ) then for yn:= 45 to 128 do if Rnsector[xn+9,n] + Rnsector[xn+9,n2] + Rnsector[xn+9,n3] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[Cset[xn,z]]:= covered[Cset[xn,z]] +( sectorRC[xn+9,z]-[n,n2,n3]); if k = 0 then begin for q in ( sectorRC[xn+9,z]-[n,n2,n3]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [Cset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [cset[xn,q]]; techwrite[g,3]:=[n,n2,n3]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+18,n] > 0) and (sec[xn+18,n] < 4 ) and (sec[xn+18,n2] > 0) and (sec[xn+18,n2] < 4 ) and (sec[xn+18,n3] > 0) and (sec[xn+18,n3] < 4 ) then for yn:= 45 to 128 do if Rnsector[xn+18,n] + Rnsector[xn+18,n2] + Rnsector[xn+18,n3] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[bset[xn,z]]:= covered[bset[xn,z]] + ( sectorRC[xn+18,z]-[n,n2,n3]); if k = 0 then begin for q in ( sectorRC[xn+18,z]-[n,n2,n3]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [bset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [bset[xn,q]]; techwrite[g,3]:=[n,n2,n3]; g:=g+1; setlength(techwrite,g+1,14); end; end; end; if k = 0 then chaindisplay(#62,g); end;{hidden tripple}

hidden Quad: Show

Code: Select all: {hidden Quad} procedure HQ(k:integer); var xn,yn,n,n2,n3,n4,z,g,q:integer; Begin if k= 0 then begin g:=0; setlength(techwrite,g+1,14); end; For 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 (sec[xn,n] > 0) and (sec[xn,n] < 5 ) and (sec[xn,n2] > 0) and (sec[xn,n2] < 5 ) and (sec[xn,n3] > 0) and (sec[xn,n3] < 5 ) and (sec[xn,n4] > 0) and (sec[xn,n4] < 5 ) then for yn:= 129 to 254 do if Rnsector[xn,n] + Rnsector[xn,n2] + Rnsector[xn,n3] + Rnsector[xn,n4] = comboset2[yn] then begin active:= true; for z:= 0 to 8 do if z in comboset2[yn] then begin covered[rset[xn,z]]:= covered[rset[xn,z]] +(sectorRC[xn,z]- [n,n2,n3,n4]) ; if k = 0 then begin for q in (sectorRC[xn,z] - [n,n2,n3,n4]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [rset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [rset[xn,q]]; techwrite[g,3]:=[n,n2,n3,n4]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 5 ) and (sec[xn+9,n2] > 0) and (sec[xn+9,n2] < 5 ) and (sec[xn+9,n3] > 0) and (sec[xn+9,n3] < 5 ) and (sec[xn+9,n4] > 0) and (sec[xn+9,n4] < 5 ) then for yn:= 129 to 254 do if Rnsector[xn+9,n] + Rnsector[xn+9,n2] + Rnsector[xn+9,n3] + Rnsector[xn+9,n4] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[Cset[xn,z]]:= covered[Cset[xn,z]] + (sectorRC[xn+9,z] - [n,n2,n3,n4]); if k = 0 then begin for q in (sectorRC[xn+9,z]- [n,n2,n3,n4]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [Cset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [cset[xn,q]]; techwrite[g,3]:=[n,n2,n3,n4]; g:=g+1; setlength(techwrite,g+1,14); end; end; If (sec[xn+18,n] > 0) and (sec[xn+18,n] < 5 ) and (sec[xn+18,n2] > 0) and (sec[xn+18,n2] < 5 ) and (sec[xn+18,n3] > 0) and (sec[xn+18,n3] < 5 ) and (sec[xn+18,n4] > 0) and (sec[xn+18,n4] < 5 ) then for yn:= 129 to 254 do if Rnsector[xn+18,n] + Rnsector[xn+18,n2] + Rnsector[xn+18,n3] + Rnsector[xn+18,n4] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin covered[bset[xn,z]]:= covered[bset[xn,z]] + (sectorRC[xn+18,z]- [n,n2,n3,n4]); if k = 0 then begin for q in (sectorRC[xn+18,z]- [n,n2,n3,n4]) do techwrite[g,q+3]:=techwrite[g,q+3]+ [bset[xn,z]]; end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[1]; techwrite[g,1]:=[0]; for q in comboset2[yn] do techwrite[g,2]:=techwrite[g,2] + [bset[xn,q]]; techwrite[g,3]:=[n,n2,n3,n4]; g:=g+1; setlength(techwrite,g+1,14); end; end; end; if k = 0 then chaindisplay(#63,g); end;{hidden Quad}

Naked Single: Show

Naked Pair: Show

Code: Select all: {Naked pairs} procedure NP(k:integer); var xn,yn,n,n2,z,g,q:integer; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,14); end; For xn:= 0 to 8 do For n:= 0 to 7 do for n2:= (n+1) to 8 do begin {rows} if(sectorRC[xn,n] <> []) and (sectorRC[xn,n2] <> []) and (nm[rset[xn,n]] <3) and (nm[rset[xn,n2]] <3) then for yn:= 9 to 44 do if ( sectorRC[xn,n] + sectorRC[xn,n2] = comboset[yn]) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+4] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:=[rset[xn,n]]+[rset[xn,n2]]; g:=g+1; setlength(techwrite,g+1,14); end; end; {rows} {cols} if(sectorRC[xn+9,n] <> []) and (sectorRC[xn+9,n2] <> []) and (nm[Cset[xn,n]] <3) and (nm[Cset[xn,n2]] <3) then for yn:= 9 to 44 do if ( sectorRC[xn+9,n] + sectorRC[xn+9,n2] = comboset[yn]) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:=[cset[xn,n]]+[cset[xn,n2]]; g:=g+1; setlength(techwrite,g+1,14); end; end; {cols} {boxes} if(sectorRC[xn+18,n] <> []) and (sectorRC[xn+18,n2] <> []) and (nm[Bset[xn,n]] <3) and (nm[Bset[xn,n2]] <3) then for yn:= 9 to 44 do if ( sectorRC[xn+18,n] + sectorRC[xn+18,n2] = comboset[yn]) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+18,z] - [Bset[xn,n] , Bset[xn,n2] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+18,z] - [ Bset[xn,n] , Bset[xn,n2] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:=[bset[xn,n]]+[bset[xn,n2]]; g:=g+1; setlength(techwrite,g+1,14); end; end; {boxes} end; if k = 0 then chaindisplay(#86,g); end;{naked pair}

Naked Tripple: Show

Code: Select all: {Naked Triple} procedure NT(k:integer); var xn,yn,n,n2,n3,z,g,q:integer; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,14); end; For 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 {Row} if (sectorRC[xn,n] <> []) and (sectorRC[xn,n2] <> []) and (sectorRC[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 (sectorRC[xn,n] + sectorRC[xn,n2] + sectorRC[xn,n3] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2], Rset[xn,n3] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2],Rset[xn,n3] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+4] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:=[rset[xn,n]]+[rset[xn,n2]]+[Rset[xn,n3]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{rows} {Col} if (sectorRC[xn+9,n] <> []) and (sectorRC[xn+9,n2] <> []) and (sectorRC[xn+9,n3] <> []) and (nm[Cset[xn,n]] <4) and (nm[Cset[xn,n2]] <4) and (nm[Cset[xn,n3]] < 4 ) then for yn:= 45 to 128 do if (sectorRC[xn+9,n] + sectorRC[xn+9,n2] + sectorRC[xn+9,n3] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2], Cset[xn,n3] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2],Cset[xn,n3] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:=[Cset[xn,n]]+[Cset[xn,n2]]+[Cset[xn,n3]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{Col} {Box} if (sectorRC[xn+18,n] <> []) and (sectorRC[xn+18,n2] <> []) and (sectorRC[xn+18,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 (sectorRC[xn+18,n] + sectorRC[xn+18,n2] + sectorRC[xn+18,n3] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+18,z] - [ Bset[xn,n] , Bset[xn,n2], Bset[xn,n3] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+18,z] - [ Bset[xn,n] , Bset[xn,n2],Bset[xn,n3] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:= comboset[yn]; techwrite[g,3]:= [Bset[xn,n]]+[Bset[xn,n2]]+[Bset[xn,n3]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{rows} end; if k = 0 then chaindisplay(#87,g); end;{naked triple}

Naked Quad: Show

Code: Select all: {Naked Quad} procedure Nq(k:integer); var xn,yn,n,n2,n3,n4,z,g,q:integer; Begin if k = 0 then begin g:=0; setlength(techwrite,g+1,14); end; For 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 {Row} if (sectorRC[xn,n] <> []) and (sectorRC[xn,n2] <> []) and (sectorRC[xn,n3] <> []) and (sectorRC[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 (sectorRC[xn,n] + sectorRC[xn,n2] + sectorRC[xn,n3] + sectorRC[xn,n4] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2], Rset[xn,n3] , Rset[xn,n4] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn,z] - [ Rset[xn,n] , Rset[xn,n2], Rset[xn,n3], Rset[xn,n4] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:= [rset[xn,n]]+[rset[xn,n2]]+[rset[xn,n3]] +[rset[xn,n4]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{row} {Col} if (sectorRC[xn+9,n] <> []) and (sectorRC[xn+9,n2] <> []) and (sectorRC[xn+9,n3] <> []) and (sectorRC[xn+9,n4] <> []) and (nm[Cset[xn,n]] <5) and (nm[Cset[xn,n2]] <5) and (nm[Cset[xn,n3]] < 5 ) and (nm[Cset[xn,n4]] <5) then for yn:= 129 to 254 do if (sectorRC[xn+9,n] + sectorRC[xn+9,n2] + sectorRC[xn+9,n3] + sectorRC[xn+9,n4] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2], Cset[xn,n3] , Cset[xn,n4] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+9,z] - [ Cset[xn,n] , Cset[xn,n2], Cset[xn,n3], Cset[xn,n4] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:= [cset[xn,n]]+[cset[xn,n2]]+[cset[xn,n3]] +[cset[xn,n4]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{col} {Box} if (sectorRC[xn+18,n] <> []) and (sectorRC[xn+18,n2] <> []) and (sectorRC[xn+18,n3] <> []) and (sectorRC[xn+18,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 (sectorRC[xn+18,n] + sectorRC[xn+18,n2] + sectorRC[xn+18,n3] + sectorRC[xn+18,n4] = comboset[yn] ) then begin active:= true; for z in comboset[yn] do begin covered2[z]:= covered2[z] + (DigitRCB[xn+18,z] - [ Bset[xn,n] , Bset[xn,n2], Bset[xn,n3] , Bset[xn,n4] ] ) ; if k= 0 then begin techwrite[g,z+3]:=techwrite[g,z+3] + (DigitRCB[xn+18,z] - [ Bset[xn,n] , Bset[xn,n2], Bset[xn,n3], Bset[xn,n4] ] ); end; end; if (k = 0) and (techwrite[g,1+3] + techwrite[g,2+3] + techwrite[g,3+3] + techwrite[g,4+3] + techwrite[g,5+3] + techwrite[g,6+3] + techwrite[g,7+3] + techwrite[g,8+3]+ techwrite[g,9+3] <> []) then begin techwrite[g,0]:=[0]; techwrite[g,1]:=[0]; techwrite[g,2]:=comboset[yn]; techwrite[g,3]:= [bset[xn,n]]+[bset[xn,n2]]+[bset[xn,n3]] +[bset[xn,n4]]; g:=g+1; setlength(techwrite,g+1,14); end; end;{Box} end; if k=0 then chaindisplay(#88,g); end;{naked quad}

by **StrmCkr** » Tue Jan 24, 2017 10:26 am

X -Wing: Show

Code: Select all: {x-wing} procedure xwing(k:integer); var xn,xn2,xn3,yn,n,z,g:integer; begin if k=0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For xn:= 0 to 7 do for xn2:= (xn+1) to 8 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 3 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 3 ) then for yn:= 9 to 44 do if (Rnsector[xn,n] + Rnsector[xn2,n]) = comboset2[yn] then begin active:= true; for z in comboset2[yn] do if (digitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n]) <> []) then begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn,xn2]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+9]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn,n] > 0) and (sec[xn,n] < 7 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 7 ) and (Bxy[xn] = bxy[xn2]) then for yn:= 9 to 44 do if (RnB[xn,n] + RnB[xn2,n]) = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin for xn3:= 0 to 8 do if ([Rx[bset[z,xn3]]] * [xn,xn2] = [] ) and (n in sectorRC[z+18,xn3]) then begin include(covered[Bset[z,xn3]],n); if k = 0 then techwrite[g,n+4]:=techwrite[g,n+4] +[ bset[z,xn3]]; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn,xn2]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+18]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 3 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 3 ) then for yn:= 9 to 44 do if rnsector[xn+9,n] + rnsector[xn2+9,n] = comboset2[yn] then begin active:= true; for z in comboset2[yn] do if (digitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n]) <> []) then begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9,xn2+9]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+9]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 7 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 7 ) and (Bxy[xn] = bxy[xn2]) then for yn:= 9 to 44 do if (CnB[xn,n] + CnB[xn2,n]) = comboset2[yn] then begin active:= true; for z in comboset2[yn] do begin for xn3:= 0 to 8 do if ([CY[bset[z,xn3]]] * [xn,xn2] = [] ) and (n in sectorRC[z+18,xn3]) then begin include(covered[Bset[z,xn3]],n); if k = 0 then techwrite[g,n+4]:=techwrite[g,n+4] +[ bset[z,xn3]]; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9,xn2+9]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+18]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+18,n] > 0) and (sec[xn+18,n] < 7 ) and (sec[xn2+18,n] > 0) and (sec[xn2+18,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 begin for z:= 0 to 8 do if (Cy[bset[xn3,z]] in comboset2[yn]) // and( n in SectorRC[xn3+18,z]) then begin if ( n in sectorRC[xn3+18,z]) then include(covered[bset[xn3,z]],n); if (k =0) and( n in sectorRC[xn3+18,z]) then techwrite[g,n+4]:=techwrite[g,n+4]+ [Bset[xn3,z]]; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+18,xn2+18]; 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 techwrite[g,4]:=techwrite[g,4] + [Cy[bset[xn3,z]]+9]; g:=g+1; setlength(techwrite,g+1,15); end; 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 begin for z:= 0 to 8 do if (Rx[bset[xn3,z]] in comboset2[yn]) // and (n in sectorRC[xn3,z]) then begin if (n in sectorRC[xn3+18,z]) then include(covered[bset[xn3,z]],n); if (k =0) and (n in sectorRC[xn3+18,z]) then techwrite[g,n+4]:=techwrite[g,n+4]+ [Bset[xn3,z]]; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+18,xn2+18]; 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 techwrite[g,4]:=techwrite[g,4] + [Rx[bset[xn3,z]]+9]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; end; if k = 0 then chaindisplay(#85,g); end;{x-wing}

Skyscrapers: Show

Code: Select all: { Skyscrapers } procedure sky(k:integer); var xn,xn2,xn3,yn,n,z,q,g:integer; Finn:RCBnums; finns:numberset; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For xn:= 0 to 7 do for xn2:= (xn+1) to 8 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 3 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 3 ) then if (Rnsector[xn,n] * Rnsector[xn2,n] <> []) then begin finn:= (Rnsector[xn2,n] * Rnsector[xn,n]); Finns:=[]; for z in finn do begin Finns:=[]; if k =0 then techwrite[g,10]:=[]; for q in ((Rnsector[xn,n] + Rnsector[xn2,n]) - [z] ) do begin if q in (rnsector[xn,n]) then include(Finns,Rset[xn,q]); if q in (rnsector[xn2,n]) then include(finns,Rset[xn2,q]); end; if (Finns <> [] ) then begin for xn3 := 0 to 80 do if ((Peer[xn3] * Finns )= Finns) and (xn3 in digitcell[n]) then begin include(covered[xn3],n); if k = 0 then techwrite[g,n+4]:=techwrite[g,n+4] + [xn3]; active:= true; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin Techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn,xn2]; for xn3 in (Rnsector[xn,n] + Rnsector[xn2,n]) do techwrite[g,4]:=techwrite[g,4] + [xn3+9]; for xn3 in ((Rnsector[xn,n] + Rnsector[xn2,n])-(Rnsector[xn,n] * Rnsector[xn2,n])) do techwrite[g,4]:=techwrite[g,4] + [bxy[secset[xn,xn3]]+18]+[bxy[secset[xn2,xn3]]+18]; g:=g+1; setlength(techwrite,g+1,15); end; end; {Finn z sector} end; {yn start} If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 3 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 3 ) then if (Rnsector[xn,n] * RnSector[xn2,n] <> []) then begin finn:= (rnsector[xn2+9,n] * Rnsector[xn+9,n]); Finns:=[]; for z in finn do begin Finns:=[]; if k =0 then techwrite[g,10]:=[]; for q in ((Rnsector[xn+9,n] + Rnsector[xn2+9,n]) - [z] ) do begin if q in (Rnsector[xn+9,n]) then include(Finns,Cset[xn,q]); if q in (Rnsector[xn2+9,n]) then include(finns,Cset[xn2,q]); end; if (Finns <> [] ) then begin for xn3 := 0 to 80 do if ((Peer[xn3] * Finns )= Finns) and (xn3 in digitcell[n]) then begin include(covered[xn3],n); if k = 0 then techwrite[g,n+4]:=techwrite[g,n+4] + [xn3]; active:= true; end; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin Techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9,xn2+9]; for xn3 in (Rnsector[xn+9,n] + Rnsector[xn2+9,n]) do techwrite[g,4]:=techwrite[g,4] + [xn3]; for xn3 in ((Rnsector[xn+9,n] + Rnsector[xn2+9,n])-(Rnsector[xn+9,n] * Rnsector[xn2+9,n])) do techwrite[g,4]:=techwrite[g,4] + [bxy[secset[xn+9,xn3]]+18]+ [bxy[secset[xn2+9,xn3]]+18]; g:=g+1; setlength(techwrite,g+1,15); end; end; {Finn z sector} end; {yn start} end; {xn2,xn} if k =0 then chaindisplay(#64,g); end;{Skyscraper}

2 string kite: Show

Code: Select all: {2-String Kyte} procedure kyte(k:integer); var n,yn,xn,xa,ya,I,j,xn2,yn2,g:integer; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; 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[j+18,n] * DigitRCB[xn,n] <> [] ) {mini row contains cells} and (DigitRCB[J+18,n] * DigitRCB[yn+9,n] <> []) {mini col contains cells} and ( DigitRCB[xn,n] * DigitRcb[yn+9,n] = [] ) {r&c intersection = []} and (DigitRCB[xn,n] - (DigitRCB[j+18,n]*DigitRCB[xn,n]) <> [] ) {row has digits out side the box} and (DigitRCB[yn+9,n] - (DigitRCB[j+18,n]*DigitRCB[yn+9,n]) <> [] ) {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[xn,n] = ( DigitRCB[xn,n] * DigitRCB[j+18,n]) + (DigitRCB[xn,n] * DigitRCB[yn2+9,n]) ) and ( DigitRCB[yn+9,n] = ( DigitRCB[yn+9,n] * DigitRCB[j+18,n]) + (DigitRCB[yn+9,n] * DigitRCB[xn2,n]) ) and ((DigitRCB[xn2,n] * DigitRCB[yn2+9,n]) <> []) then begin active:= true; covered2[n]:= covered2[n] + (DigitRCB[xn2,n] * DigitRCB[yn2+9,n]); if (k = 0) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[yn+9] + [xn]; techwrite[g,4]:=[j+18] + [xn2] + [yn2+9]; techwrite[g,n+4]:= (DigitRCB[xn2,n] * DigitRCB[yn2+9,n]); g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k = 0 then chaindisplay(#66,g); end; {2-string kite}

Empty Rectangle: Show

Sword Fish: Show

Code: Select all: {sword fish} procedure Swordfish(k:integer); var xn,xn2,xn3,xn4,yn,n,z,g:integer; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For xn:= 0 to 6 do for xn2:= (xn+1) to 7 do for xn3:= (xn2+1) to 8 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 4 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 4 ) and (sec[xn3,n] > 0) and (sec[xn3,n] < 4 ) then for yn:= 45 to 128 do if Rnsector[xn,n] + Rnsector[xn2,n] + Rnsector[xn3,n]= comboset2[yn] then begin for z in comboset2[yn] do begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n]+DigitRCB[xn3,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n]+DigitRCB[xn3,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn,xn2,xn3]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+9]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (Sec[xn+9,n] > 0) and (sec[xn+9,n] < 4 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 4 ) and (sec[xn3+9,n] > 0) and (sec[xn3+9,n] < 4 ) then for yn:= 45 to 128 do if Rnsector[xn+9,n] + Rnsector[xn2+9,n] + Rnsector[xn3+9,n] = comboset2[yn] then begin for z in comboset2[yn] do begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n]+DigitRCB[xn3+9,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n]+DigitRCB[xn3+9,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9,xn2+9,xn3+9]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k =0 then chaindisplay(#67,g); end;{swordfish}

Jelly fish: Show

Code: Select all: {jelly fish} procedure jellyfish(k:integer); var xn,xn2,xn3,xn4,xn5,yn,n,z,g:integer; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For 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 (sec[xn,n] > 0) and (sec[xn,n] < 5 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 5 ) and (sec[xn3,n] > 0) and (sec[xn3,n] < 5 ) and (sec[xn4,n] > 0) and (sec[xn4,n] < 5 ) then for yn:= 129 to 254 do if Rnsector[xn,n] + Rnsector[xn2,n] + Rnsector[xn3,n] + Rnsector[xn4,n]= comboset2[yn] then begin for z in comboset2[yn] do begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n]+DigitRCB[xn3,n]+DigitRCB[xn4,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z+9,n] - (DigitRCB[xn,n]+DigitRCB[xn2,n]+DigitRCB[xn3,n]+DigitRCB[xn4,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn,xn2,xn3,xn4]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z+9]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 5 ) and (sec[xn2+9,n] > 0) and (sec[xn2,n] < 5 ) and (sec[xn3+9,n] > 0) and (sec[xn3+9,n] < 5 ) and (sec[xn4+9,n] > 0) and (sec[xn4+9,n] < 5 ) then for yn:= 129 to 254 do if Rnsector[xn+9,n] + Rnsector[xn2+9,n] + Rnsector[xn3+9,n] + Rnsector[xn4+9,n]= comboset2[yn] then begin for z in comboset2[yn] do begin active:=true; covered2[n]:= covered2[n] + (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n]+DigitRCB[xn3+9,n]+DigitRCB[xn4+9,n])); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ (DigitRCB[z,n] - (DigitRCB[xn+9,n]+DigitRCB[xn2+9,n]+DigitRCB[xn3+9,n]+DigitRCB[xn4+9,n])); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9,xn2+9,xn3+9,xn4+9]; for z in comboset2[yn] do techwrite[g,4]:=techwrite[g,4] + [z]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k = 0 then chaindisplay(#68,g); end;{jelly fish}

Finned & Sashimi x-wing: Show

Code: Select all: { Finned and or Sashimi x-wings} procedure smashi (k:integer); var xn,xn2,xn4,xn3,yn,n,z,g,q:integer; Finn:RCBnums; finns:numberset; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For xn:= 0 to 7 do for xn2:= xn+1 to 8 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 5 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 5 ) then for yn:= 9 to 44 do if (( Rnsector[xn,n] + Rnsector[xn2,n] ) * comboset2[yn] = comboset2[yn] ) then if( (Rnsector[xn2,n] + Rnsector[xn,n] ) - comboset2[yn] <> [] ) then begin finn:= (Rnsector[xn2,n] + Rnsector[xn,n] ) - comboset2[yn]; Finns:=[]; if k = 0 then techwrite[g,4]:= []; for z:= 0 to 8 do if z in finn then begin if (Rnsector[xn2,n] - comboset2[yn] <> [] ) then include(finns,Rset[xn2,z]); if (Rnsector[xn,n] - comboset2[yn] <> [] ) then include(finns,Rset[xn,z]); if k = 0 then begin for q in (Rnsector[xn2,n] + Rnsector[xn,n] ) - finn do techwrite[g,4]:=techwrite[g,10] + [q+9]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,4] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn] + [xn2]; end; end; for z:= 0 to 8 do if z in comboset2[yn] then for xn4:= 0 to 8 do if n in sectorRC[xn4,z] then if not (xn4 in [xn,xn2]) and ( finns * peer[Rset[xn4,z]] = finns ) then begin active:= true; include(covered[Rset[xn4,z]],n); if k = 0 then techwrite[g,n+4]:=Techwrite[g,n+4] + [Rset[xn4,z]]; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin Techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 5 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 5 ) then for yn:= 9 to 44 do if ((Rnsector[xn+9,n] + RnSector[xn2+9,n] ) * comboset2[yn] = comboset2[yn]) then if ((Rnsector[xn2+9,n] + rnsector[xn+9,n] ) - comboset2[yn] <> []) then begin finn:= (Rnsector[xn2+9,n] + Rnsector[xn+9,n]) - comboset2[yn]; Finns:=[]; if k = 0 then techwrite[g,4]:= []; for z:= 0 to 8 do if z in finn then begin if (Rnsector[xn2+9,n] - comboset2[yn] <> [] ) then include(finns,Cset[xn2,z]); if (Rnsector[xn+9,n] - comboset2[yn] <> [] ) then include(finns,Cset[xn,z]); if k = 0 then begin for q in (Rnsector[xn2+9,n] + Rnsector[xn+9,n] ) - finn do techwrite[g,4]:=techwrite[g,4] + [q]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,4] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9] + [xn2+9]; end; end; for z:= 0 to 8 do if z in comboset2[yn] then for xn4:= 0 to 8 do if n in SectorRC[xn4+9,z] then if not (xn4 in [xn,xn2]) and ( finns * peer[Cset[xn4,z]] = finns ) then begin active:= true; include(covered[Cset[xn4,z]],n); if k = 0 then techwrite[g,n+4]:=Techwrite[g,n+4] + [cset[xn4,z]]; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin Techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k = 0 then chaindisplay(#20,g); end;{SMASHI x-wings}

Finned & sashimi Sword fish: Show

Code: Select all: {Finned Sashimi sword fish} procedure smashiSwords(k:integer); var xn,xn2,xn3,xn4,yn,n,z,g,q:integer; Finn:RCBnums; finns:numberset; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For xn:= 0 to 6 do for xn2:= xn+1 to 7 do for xn3:= (xn2+1) to 8 do begin If (sec[xn,n] > 0) and (sec[xn,n] < 6 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 6 ) and (sec[xn3,n] > 0) and (sec[xn3,n] < 6 ) then for yn:= 45 to 128 do if (( Rnsector[xn,n] + Rnsector[xn2,n] + Rnsector[xn3,n]) * comboset2[yn] = comboset2[yn] ) then if( (Rnsector[xn2,n] + Rnsector[xn,n] + Rnsector[xn3,n]) - comboset2[yn] <> [] ) then begin finn:= (Rnsector[xn2,n] + Rnsector[xn,n] + Rnsector[xn3,n]) - comboset2[yn]; Finns:=[]; if k = 0 then techwrite[g,10]:= []; for z:= 0 to 8 do if z in finn then begin if (Rnsector[xn3,n] - comboset2[yn] <> [] ) then include(finns,Rset[xn3,z]); if (Rnsector[xn2,n] - comboset2[yn] <> [] ) then include(finns,Rset[xn2,z]); if (Rnsector[xn,n] - comboset2[yn] <> [] ) then include(finns,Rset[xn,z]); if k = 0 then begin for q in (Rnsector[xn2,n] + Rnsector[xn,n] + Rnsector[xn3,n]) - finn do techwrite[g,4]:=techwrite[g,10] + [q+9]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,4] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn] + [xn2] + [xn3]; end; end; for z:= 0 to 8 do if z in comboset2[yn] then for xn4:= 0 to 8 do if n in sectorRC[xn4,z] then if not (xn4 in [xn,xn2,xn3]) and ( finns * peer[Rset[xn4,z]] = finns ) then begin active:= true; include(covered[Rset[xn4,z]],n); if k = 0 then techwrite[g,n+4]:=Techwrite[g,n+4] + [Rset[xn4,z]]; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; If (sec[xn+9,n] > 0) and (sec[xn+9,n] < 6 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 6 ) and (sec[xn3+9,n] > 0) and (sec[xn3+9,n] < 6 ) then for yn:= 45 to 128 do if ((Rnsector[xn+9,n] + Rnsector[xn2+9,n] + Rnsector[xn3+9,n]) * comboset2[yn] = comboset2[yn]) then if ((Rnsector[xn2+9,n] + Rnsector[xn+9,n]+ Rnsector[xn3+9,n]) - comboset2[yn] <> []) then begin finn:= (Rnsector[xn2+9,n] + rnsector[xn+9,n]+ Rnsector[xn3+9,n]) - comboset2[yn]; Finns:=[]; if k = 0 then techwrite[g,4]:= []; for z:= 0 to 8 do if z in finn then begin if (Rnsector[xn3+9,n] - comboset2[yn] <> [] ) then include(finns,Cset[xn3,z]); if (Rnsector[xn2+9,n] - comboset2[yn] <> [] ) then include(finns,Cset[xn2,z]); if (Rnsector[xn+9,n] - comboset2[yn] <> [] ) then include(finns,Cset[xn,z]); if k = 0 then begin for q in (Rnsector[xn2+9,n] + Rnsector[xn+9,n] + Rnsector[xn3+9,n]) - finn do techwrite[g,4]:=techwrite[g,4] + [q]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,4] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9] + [xn2+9]+[xn3+9]; end; end; for z:= 0 to 8 do if z in comboset2[yn] then for xn4:= 0 to 8 do if n in SectorRC[xn4+9,z] then if not (xn4 in [xn,xn2,xn3]) and ( finns * peer[Cset[xn4,z]] = finns ) then begin active:= true; include(covered[Cset[xn4,z]],n); if k = 0 then techwrite[g,n+4]:=Techwrite[g,n+4] + [cset[xn4,z]]; end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k = 0 then chaindisplay(#92,g); end;{SMASHIswords}

finned & sashimi Jelly fish: Show

Code: Select all: {Finned Sashimi jelly fish} procedure smashijelly(k:integer); var xn,xn2,xn3,xn4,xn5,yn,n,z,g,q:integer; Finn:RCBnums; finns:numberset; begin if k = 0 then begin g:=0; setlength(techwrite,g+1,15); end; For n:= 1 to 9 do For 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 (sec[xn,n] > 0) and (sec[xn,n] < 7 ) and (sec[xn2,n] > 0) and (sec[xn2,n] < 7 ) and (sec[xn3,n] > 0) and (sec[xn3,n] < 7 ) and (sec[xn4,n] > 0) and (sec[xn4,n] < 7 ) then for yn:= 129 to 254 do if (( Rnsector[xn,n] + Rnsector[xn2,n] + Rnsector[xn3,n] + Rnsector[xn4,n]) * comboset2[yn] = comboset2[yn] ) then if ((Rnsector[xn2,n] + Rnsector[xn,n] + Rnsector[xn3,n] + Rnsector[xn4,n]) - comboset2[yn] <> []) then begin finn:= (Rnsector[xn2,n] + Rnsector[xn,n] + Rnsector[xn3,n] + Rnsector[xn4,n]) - comboset2[yn]; Finns:=[]; if k = 0 then techwrite[g,4]:= []; for z in finn do begin if (Rnsector[xn,n] - comboset2[yn] <> []) then include(finns,Rset[xn,z]); if (Rnsector[xn2,n] - comboset2[yn] <> []) then include(finns,Rset[xn2,z]); if (Rnsector[xn4,n] - comboset2[yn] <> []) then include(finns,Rset[xn4,z]); if (Rnsector[xn3,n] - comboset2[yn] <> []) then include(finns,Rset[xn3,z]); if k = 0 then begin for q in (rnsector[xn2,n] + rnsector[xn,n] + rnsector[xn3,n] + rnsector[xn4,n]) - finn do techwrite[g,4]:=techwrite[g,4] + [q+9]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,10] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9] + [xn2+9]+[xn3+9] +[xn4+9]; end; end; for z in comboset2[yn] do for xn5:= 0 to 8 do if n in sectorRC[xn5,z] then if not (xn5 in [xn,xn2,xn3,xn4]) and ( finns * peer[Rset[xn5,z]] = finns ) then begin active:= true; include(covered[Rset[xn5,z]],n); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ ([rset[xn5,z]]); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; if (sec[xn+9,n] > 0) and (sec[xn+9,n] < 7 ) and (sec[xn2+9,n] > 0) and (sec[xn2+9,n] < 7 ) and (sec[xn3+9,n] > 0) and (sec[xn3+9,n] < 7 ) and (sec[xn4+9,n] > 0) and (sec[xn4+9,n] < 7 ) then for yn:= 129 to 254 do if (( Rnsector[xn+9,n] + Rnsector[xn2+9,n] + Rnsector[xn3+9,n] + Rnsector[xn4+9,n]) * comboset2[yn] = comboset2[yn] ) then if ((Rnsector[xn2+9,n] + Rnsector[xn+9,n] + Rnsector[xn3+9,n] + Rnsector[xn4+9,n]) - comboset2[yn] <> []) then begin finn:= (Rnsector[xn2+9,n] + Rnsector[xn+9,n]+ Rnsector[xn3+9,n] + Rnsector[xn4+9,n]) - comboset2[yn]; Finns:=[]; if k=0 then techwrite[g,4]:= []; for z in finn do begin if (Rnsector[xn2+9,n] - comboset2[yn] <> []) then include(finns,Cset[xn2,z]); if (Rnsector[xn+9,n] - comboset2[yn] <> []) then include(finns,Cset[xn,z]); if (Rnsector[xn4+9,n] - comboset2[yn] <> []) then include(finns,Cset[xn4,z]); if (Rnsector[xn3+9,n] - comboset2[yn] <> []) then include(finns,Cset[xn3,z]); if k = 0 then begin for q in (Rnsector[xn2+9,n] + Rnsector[xn+9,n] + Rnsector[xn3+9,n] + Rnsector[xn4+9,n]) - finn do techwrite[g,4]:=techwrite[g,4] + [q]; for q in [18..26] do if digitrcb[q,n] * finns = finns then techwrite[g,4]:=techwrite[g,10] + [q]; techwrite[g,2]:=[n]; techwrite[g,3]:=[xn+9] + [xn2+9]+[xn3+9] +[xn4+9]; end; end; for z in comboset2[yn] do for xn5:= 0 to 8 do if n in SectorRC[xn5+9,z] then if not (xn5 in [xn,xn2,xn3,xn4]) and ( finns * peer[Cset[xn5,z]] = finns ) then begin active:=true; include(covered[Cset[xn5,z]],n); if k=0 then techwrite[g,n+4]:= techwrite[g,n+4]+ ([Cset[xn5,z]]); end; if (k = 0) and (techwrite[g,n+4] <> []) then begin Techwrite[g,0]:=[2]; techwrite[g,1]:=[1]; g:=g+1; setlength(techwrite,g+1,15); end; end; end; if k = 0 then chaindisplay(#93,g); end;{SMASHIjellies}

N x (N + K) Fish finder

NxN+K fish finder: Show

Code: Select all: {fish finder} procedure fishfinder(R1,E1,t:integer); type hold = array of integer; hold2 = array of integer; hold3 = 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; Rcover2 = array of numberset; Bcover2 = array of numberset; Ccover2 = array of numberset; Cover2 = array of numberset; used2 = array of rcbpeer; used3 = array of rcbpeer; peered = array of rcbpeer; var a1,b1,a2,b2,z,n,w,w2,p,p2,q,q2,x,s,s2,f,f2,k,l,m,g,v,u,j,d:integer; output:text; E,R:integer; h:hold; h2:hold2; h3:hold3; use:used2; use2:used3; use3:rcbpeer; use4:rcbpeer; Base: base2; Bbase:base5; Rbase:base6; Cbase:base7; basei: base3; pbasei: base4; Cover:cover2; Rcover:rcover2; Ccover:Ccover2; Bcover:bcover2; scover:numberset; srcover:numberset; sccover:numberset; sbcover:numberset; peers:peered; sector:rcbpeer; sector2: array [0..26] of rcbpeer; begin setlength(h3,0); setlength(use,0); setlength(h,0); setlength(base,0); setlength(Bbase,0); setlength(Cbase,0); setlength(Rbase,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(h,(8)); { stores the active sectors } setlength(use,8); setlength(base,8); setlength(basei,8); setlength(pbasei,8); setlength(peers,8); setlength(Bbase,8); setlength(Cbase,8); setlength(Rbase,8); setlength(h3,27); setlength(h2,10); setlength(use2,10); setlength(cover,10); {cover area's} setlength(Rcover,10); {specific cover area's } setlength(Ccover,10); setlength(Bcover,10); if R1 = 0 then begin writexy(2,28,'minimal Fish size to search?'); R:=ord(readkey)-48; write(': ',R); end else R:=R1; if E1 = 0 then begin writexy(2,29,'Maximum Fish size to search?'); E:=ord(readkey)-48; write(': ',E); end else E:=E1; if t=0 then begin u:=0; setlength(techwrite,u+1,13); end; for n:= 1 to 9 do {digits 1 - 9} for z:= R to E 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[s,n] <> []) {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[s2,n] <> []) and ((digitRCB[s2,n] * digitRCB[s,n]) <> [] ) 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 ) ) 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[p,n] - base[w] <> []) {makes sure the newly selected base sector actually has active cells to add} and (q >= (z-1-w)) and ( p in ( (sector ) - 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[p,n]; {sets the base value} peers[w]:=peers[w-1] + sector2[p]; basei[w]:= basei[w-1] + (base[w-1] * digitrcb[p,n]); if p in [0..8] then Rbase[w]:= Rbase[w-1] +digitRCB[p,n] else Rbase[w]:= Rbase[w-1]; if p in [9..17] then Cbase[w]:= Cbase[w-1] + digitRCB[p,n] else Cbase[w]:= Cbase[w-1]; if p in [18..26] then Bbase[w]:= Bbase[w-1] + digitRCB[p,n] else Bbase[w]:= Bbase[w-1]; if (base[w-1] * digitRCB[p,n]) <> [] 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]; 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) and ((Rbase[w] * Cbase[w] * Bbase[w] ) * Base[w] = [] ) {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; m:=0; setlength(h3,0); setlength(h3,27); for x:= 26 downto 0 do if (x in (( peers[w]) - use[w]) ) and (digitrcb[x,n] * base[w] <> [] ) then begin inc(f); if ( ((Rbase[w] * Cbase[w]) + (Rbase[w] * Bbase[w]) +(Bbase[w] * Cbase[w])) * DigitRCB[x,n] <> [] ) then begin inc(m); h3[m]:=x; end; if (X > a2 ) then a2:=x; b2:=x; end; end; if (w = z) and (F >= (z+k)) and (m <= (n+k)) {find cover set} then for s2:= a2 downto (b2+(z+k-1)) do if (digitRCB[s2,n] * base[w] <> [] ) and (S2 in( ( peers[w] ) - use[w] )) and(f>=(z+k)-1) and (s2 >= h3[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[p2,n] * (base[w] - cover[w2]) <> []) and (p2 in ( ( peers[w]) - use[w] - use2[w2] ) ) and (q2 >= ((z+k)-1-w2)) and (p2 >= h3[w2+1]) 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[p2,n]; if p2 in [0..8] then Rcover[w2]:= Rcover[w2-1] +digitRCB[p2,n] else Rcover[w2]:= Rcover[w2-1]; if p2 in [9..17] then Ccover[w2]:= Ccover[w2-1] + digitRCB[p2,n] else Ccover[w2]:= Ccover[w2-1]; if p2 in [18..26] then Bcover[w2]:= Bcover[w2-1] + digitRCB[p2,n] 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 ( ( 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; l:=1; use3:=[]; scover:=[]; srcover:=[]; sccover:=[]; sbcover:=[]; {checks for overlaping cover sectors that can swap 1 for 1} for j in use2[w2] do for d in (peerRCB[j] - (use[w]+use2[w2])) do if (base[w] * digitRCB[d,n] = base[w] * digitrcb[j,n] ) and (base[w] * digitrcb[d,n] <> []) then begin // writexy(2,60,'found '); use3:= use3 + [D]; Scover:=Scover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [0..8] then Srcover:=srcover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [9..17] then Sccover:=sccover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [18..26] then sbcover:=sbcover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); end; if (w2 = z) then covered2[n]:= covered2[n] + ((cover[w2]+scover) - 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+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]+Srcover) * (Ccover[w2]+sccover)) + ((Rcover[w2]+srcover) * (Bcover[w2]+sbcover)) + ( (Ccover[w2]+sccover) * (Bcover[w2]+sbcover)) ) - 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]); if (w2 = z+2) { 2 fin sector - elimiantions in overlaps of cover sectors not in base } then covered2[n]:=COvered2[n] + (((Rcover[w2]+SRcover) * (Bcover[w2]+Sbcover) * (Ccover[w2]+Sccover))- base[w]); if t = 0 then begin techwrite[u,11]:=[n]; techwrite[u,0]:=use[w] ; techwrite[u,10]:= use2[w2]; techwrite[u,12]:= use3; {if (w2 = z) and (use3 <> []) then techwrite[u,n]:=techwrite[u,n] + (scover - base[w]);} if (w2 = z) then techwrite[u,n]:=techwrite[u,n] + ((cover[w2]+scover) - base[w]); if ((w2 = z+1) or ( w2 = z)) { 1 or 0 fin sectors - elimiantions in overlaps of cover sectors not in base } then techwrite[u,n]:=techwrite[u,n] + (( (Rcover[w2] * Ccover[w2]) + (Rcover[w2] * Bcover[w2]) + ( Ccover[w2] * Bcover[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 techwrite[u,n]:=techwrite[u,n] + (( ((Rcover[w2]+Srcover) * (Ccover[w2]+sccover)) + ((Rcover[w2]+srcover) * (Bcover[w2]+sbcover)) + ( (Ccover[w2]+sccover) * (Bcover[w2]+sbcover)) ) - base[w]) ; if (w2 = z+2) { 2 fin sector - elimiantions in overlaps of cover sectors not in base } then techwrite[u,n]:= techwrite[u,n] + ((Rcover[w2] * Bcover[w2] * Ccover[w2])- base[w]); if (w2 = z+2) { 2 fin sector - elimiantions in overlaps of cover sectors not in base } then techwrite[u,n]:= techwrite[u,n] + (((Rcover[w2]+SRcover) * (Bcover[w2]+Sbcover) * (Ccover[w2]+Sccover))- base[w]); if techwrite[u,n] <> [] then begin u:= u+1; setlength(techwrite,u+1,13); end; if u = 32767 {max array size error code safty exit} then begin if t = 0 then techdisplay(#102,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,13) //exit; end; end; end; if (w2 =z+k) and (basei[w] <> []) 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; l:=1; use3:=[]; scover:=[]; srcover:=[]; sccover:=[]; sbcover:=[]; {checks for overlaping cover sectors that can swap 1 for 1} for j in use2[w2] do for d in (peerRCB[j] - (use[w]+use2[w2])) do if (base[w] * digitRCB[d,n] = base[w] * digitrcb[j,n] ) and (base[w] * digitrcb[d,n] <> []) then begin // writexy(2,60,'found '); use3:= use3 + [D]; Scover:=Scover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [0..8] then Srcover:=srcover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [9..17] then Sccover:=sccover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); if d in [18..26] then sbcover:=sbcover + (digitrcb[d,n] - (digitrcb[d,n]*digitrcb[j,n])); end; if (w2=z) then covered2[n]:=covered2[n] +( (pbasei[w] * cover[w2]* scover) - 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]+srcover) * (Ccover[w2]+sccover)) + ((Rcover[w2]+srcover) * (Bcover[w2]+sbcover)) + ( (Ccover[w2]+sccover) * (Bcover[w2]+sbcover)))) - 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]+srcover)*(Bcover[w2]+sbcover)*(Ccover[w2]+sccover))) - base[w]); if t = 0 then begin techwrite[u,11]:=[n]; techwrite[u,0]:=use[w] ; techwrite[u,10]:= use2[w2]; techwrite[u,12]:=use3; if (w2 = z) then techwrite[u,n]:=techwrite[u,n] + ( (pbasei[w] * cover[w2]* scover) - base[w]); if ((w2 = z+1) or ( w2 = z)) { 1 or 0 fin sectors - elimiantions in overlaps of cover sectors not in base } then techwrite[u,n]:=techwrite[u,n] + ( (pbasei[w] * (((Rcover[w2]+srcover) * (Ccover[w2]+sccover)) + ((Rcover[w2]+srcover) * (Bcover[w2]+sbcover)) + ( (Ccover[w2]+sccover) * (Bcover[w2]+sbcover)))) - base[w]); if (w2 = z+2) { 2 fin sector - elimiantions in overlaps of cover sectors not in base } then techwrite[u,n]:= techwrite[u,n] + ((pbasei[w] * ((Rcover[w2]+srcover)*(Bcover[w2]+sbcover)*(Ccover[w2]+sccover))) - base[w]); if techwrite[u,n] <> [] then begin u:= u+1; setlength(techwrite,u+1,13); end; if u = 32767 {max array size error code safty exit} then begin if t = 0 then techdisplay(#102,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,13) //exit; end; end; 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>2) or (l=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] = [])) or ((Rbase[w] * Cbase[w] * Bbase[w] ) * Base[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; if t = 0 then techdisplay(#102,u); if R1 = 0 then writexy(2,28,' '); if E1 = 0 then writexy(2,29,' '); end; {fish finder}

by **StrmCkr** » Wed Jan 25, 2017 7:57 am

W-wing

W - Wing: Show

Code: Select all: procedure Wwing(K:integer); {rebuilt to issolate N} var xn,xn2,xn3,xn4,n,u,a,b,g,h,i:integer; used:numberset; begin //u:=0; links; if k=1 then begin u:=0; setlength(techwrite,u+1,27); end; for g in [1..9] do for xn:= low(linkset[g][0]) to high(linkset[g][0]) do {basic code} for h in linkset[g,0,xn,7] do for a in [1..5] do for xn2:= low(linkset[h][a]) to high(linkset[h][a]) do if (linkset[g][0,xn,3] = linkset[h][a,xn2,0] ) and ( (linkset[g][0,xn,5] * linkset[h][a,xn2,4] )<> []) and ( (linkset[g][0,xn,2] * linkset[h][a,xn2,1]) = []) and ( (linkset[g][0,xn,2] * linkset[h][a,xn2,2]) = []) {cant have cells from the first spot} then for xn3:= low(linkset[h][0]) to high(linkset[h][0]) do if (linkset[h][a,xn2,3] = linkset[h][0,xn3,0]) and (linkset[g][0,xn,0] = linkset[h][0,xn3,3]) and (linkset[h][a,xn2,3] = linkset[h][0,xn3,0]) and ( linkset[h][a,xn2,5] * linkset[h][0,xn3,4] <> [] ) and ( (linkset[h][a,xn2,2] * linkset[h][0,xn3,1]) = []) and ( (linkset[h][a,xn2,1] * linkset[h][0,xn3,1]) = []){cant have cells from the previous link} then begin if (linkset[g][0,xn,8] * linkset[h][0,xn3,8] <> [] ) then begin {eliminations} active:= true; For n in (linkset[g][0,xn,0] * linkset[h][0,xn3,3]) do begin covered2[n]:=covered2[n] + (linkset[g][0,xn,8] * linkset[h][0,xn3,9]); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][0,xn,8] * linkset[h][0,xn3,9]); end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,0][xn][0]; techwrite[u,3]:=linkset[g,0][xn][1]; techwrite[u,4]:=linkset[g,0][xn][2]; techwrite[u,5]:=linkset[g,0][xn][3]; techwrite[u,6]:=linkset[h,a][xn2][0]; techwrite[u,7]:=linkset[h,a][xn2][1]; techwrite[u,8]:=linkset[h,a][xn2][2]; techwrite[u,9]:=linkset[h,a][xn2][3]; techwrite[u,10]:=linkset[h,0][xn3][0]; techwrite[u,11]:=linkset[h,0][xn3][1]; techwrite[u,12]:=linkset[h,0][xn3][2]; techwrite[u,13]:=linkset[h,0][xn3][3]; u:=u+1; setlength(techwrite,u+1,27); end; end; for b in [1..5] do for xn4:= low(linkset[g][b]) to high(linkset[g][b]) do if {first link of xn4 to xn3 cell} (linkset[g][b,xn4,0] = linkset[h][0,xn3,3] ) {have the same digit} and (linkset[g][b,xn4,4] * linkset[h][0,xn3,5] <> []) {be visible peers} and ((linkset[g][b,xn4,1] + linkset[g][b,xn4,2] ) * (linkset[h][0,xn3,1]+linkset[h][0,xn3,2]) = [] ) {no overlaping cells} {2nd link of xn4 to xn cell} and (linkset[g][b,xn4,3] = linkset[g][0,xn,0] ) and (linkset[g][b,xn4,5] * linkset[g][0,xn,4] <> []) and ((linkset[g][b,xn4,1] + linkset[g][b,xn4,2] ) * (linkset[g][0,xn,1]+linkset[g][0,xn,2]) = [] ) then begin active:= true; used:= ( linkset[g][0,xn,1]+linkset[g][0,xn,2] + linkset[h][a,xn2,1]+linkset[h][a,xn2,2] + linkset[h][0,xn3,1]+linkset[h][0,xn3,2] + linkset[g][b,xn4,1]+linkset[g][b,xn4,2] ); //basic For n in (linkset[g][0,xn,3] * linkset[h][0,xn3,0]) do begin covered2[n]:=covered2[n] +( (linkset[g][0,xn,8] * linkset[h][0,xn3,9]) ); if k= 1 then techwrite[u,n+17]:=techwrite[u,n+17] +( (linkset[g][0,xn,8] * linkset[h][0,xn3,9]) ); end; // ring for n in linkset[g][0,xn,3] * linkset[h][a,xn2,0] do begin covered2[n]:= covered2[n] + ( (linkset[g][0,xn,9] * linkset[h][a,xn2,8])-used ); if k= 1 then techwrite[u,n+17]:=techwrite[u,n+17] +( (linkset[g][0,xn,9] * linkset[h][a,xn2,8])-used ); end; for n in linkset[h][a,xn2,3] * linkset[h][0,xn3,0] do begin covered2[n]:= covered2[n] + ( (linkset[h][a,xn2,9] * linkset[h][0,xn3,8])-used); if k= 1 then techwrite[u,n+17]:=techwrite[u,n+17] +( (linkset[h][a,xn2,9] * linkset[h][0,xn3,8])-used); end; for n in linkset[h][0,xn3,3] * linkset[g][b,xn4,0] do begin covered2[n]:= covered2[n] + ( (linkset[h][0,xn3,9] * linkset[g][b,xn4,8])-used); if k= 1 then techwrite[u,n+17]:=techwrite[u,n+17] +( (linkset[h][0,xn3,9] * linkset[g][b,xn4,8])-used); end; for n in linkset[g][b,xn4,3] * linkset[g][0,xn,0] do begin covered2[n]:= covered2[n] + ( (linkset[g][b,xn4,9] * linkset[g][0,xn,8])-used); if k= 1 then techwrite[u,n+17]:=techwrite[u,n+17] + ( (linkset[g][b,xn4,9] * linkset[g][0,xn,8])-used); end; if (k = 1) and (techwrite[u,1+17]+ (techwrite[u,2+17])+ (techwrite[u,3+17] ) + (techwrite[u,4+17] ) + (techwrite[u,5+17])+ (techwrite[u,6+17] ) + (techwrite[u,7+17] ) + (techwrite[u,8+17])+ (techwrite[u,9+17] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[14]; techwrite[u,2]:=linkset[g,0][xn][0]; techwrite[u,3]:=linkset[g,0][xn][1]; techwrite[u,4]:=linkset[g,0][xn][2]; techwrite[u,5]:=linkset[g,0][xn][3]; techwrite[u,6]:=linkset[h,a][xn2][0]; techwrite[u,7]:=linkset[h,a][xn2][1]; techwrite[u,8]:=linkset[h,a][xn2][2]; techwrite[u,9]:=linkset[h,a][xn2][3]; techwrite[u,10]:=linkset[h,0][xn3][0]; techwrite[u,11]:=linkset[h,0][xn3][1]; techwrite[u,12]:=linkset[h,0][xn3][2]; techwrite[u,13]:=linkset[h,0][xn3][3]; techwrite[u,14]:=linkset[g,b][xn4][0]; techwrite[u,15]:=linkset[g,b][xn4][1]; techwrite[u,16]:=linkset[g,b][xn4][2]; techwrite[u,17]:=linkset[g,b][xn4][3]; u:=u+1; setlength(techwrite,u+1,27); end; end; {ring finder} end; if k = 1 then chaindisplay(#133,u); end; {w-wing/rings}

M-wing

M - Wing: Show

Code: Select all: procedure Mwing(k:integer); var xn,xn2,xn3,a,b,u,n,g,h,r:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,23) end; for g in [1..9] do for xn:= low(linkset[g][0]) to high(linkset[g][0] ) do for h in linkset[g][0,xn,7] do for a in [1,2,3] do for xn2:= low(linkset[h][a]) to high(linkset[h][a]) do if (linkset[h][a,xn2,1] * linkset[g][0,xn,2] = []) and (linkset[g][0,xn,3] * linkset[h][a,xn2,0] <> []) and (linkset[h][a,xn2,4] * linkset[g][0,xn,5] <> []) and (linkset[h][a,xn2,2] * linkset[g][0,xn,2] = []) { linking 2nd cells cant land on the first cell} then for b in [1,2,3] do for xn3:= low(linkset[g][b]) to high(linkset[g][b]) do if (linkset[g][b,xn3,1] = linkset[h][a,xn2,2] ) and (linkset[g][b,xn3,2] * linkset[g][0,xn,1] = []) and (linkset[g][b,xn3,6] <> [0] ) // links must be linkable then begin if (linkset[g][0,xn,8] * linkset[g][b,xn3,8] <> [] ) then begin active:=true; For n in (linkset[g][0,xn,0] * linkset[g][b,xn3,3]) do begin covered2[n]:=covered2[n] + (linkset[g][0,xn,8] * linkset[g][b,xn3,9]); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][0,xn,8] * linkset[g][b,xn3,9]); end; if (linkset[g][0,xn,4] * linkset[g][b,xn3,5] <> []) then begin active:=true; for n in (linkset[g][0,xn,3] * linkset[h][a,xn2,0]) do begin covered2[n]:=covered2[n] + (linkset[g][0,xn,9] * linkset[h][a,xn2,8]); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][0,xn,9] * linkset[h][a,xn2,8]); end; for n in (linkset[h][a,xn2,2] * linkset[g][b,xn3,1]) do begin covered[n]:= covered[n] + (pm[n] - (linkset[h][a,xn2,3] + linkset[g][b,xn3,0]) ); if k = 1 then begin for r in (pm[n] - (linkset[h][a,xn2,3] + linkset[g][b,xn3,0]) ) do techwrite[u,r+13]:=techwrite[u,r+13] + [N]; end; end; end; end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,0][xn][0]; techwrite[u,3]:=linkset[g,0][xn][1]; techwrite[u,4]:=linkset[g,0][xn][2]; techwrite[u,5]:=linkset[g,0][xn][3]; techwrite[u,6]:=linkset[h,a][xn2][0]; techwrite[u,7]:=linkset[h,a][xn2][1]; techwrite[u,8]:=linkset[h,a][xn2][2]; techwrite[u,9]:=linkset[h,a][xn2][3]; techwrite[u,10]:=linkset[g,b][xn3][0]; techwrite[u,11]:=linkset[g,b][xn3][1]; techwrite[u,12]:=linkset[g,b][xn3][2]; techwrite[u,13]:=linkset[g,b][xn3][3]; u:=u+1; setlength(techwrite,u+1,23); end; end; if k = 1 then chaindisplay(#135,u); end;

Split Wing

S-Wing: Show

Code: Select all: {split wing} Procedure Swing(K:integer); var xn,a,xn2,b,xn3,n,u,g,h:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,23) end; for g in [1..9] do for a in [1..2] do for xn:= low(linkset[g][a]) to high(linkset[g][a]) do for xn2:= low(linkset[g][0] )to high(linkset[g][0]) do if (linkset[g][0,xn2,4] * linkset[g][a,xn,5] <> []) and (linkset[g][0,xn2,1] * linkset[g][a,xn,2] = []) and (linkset[g][0,xn2,1] * linkset[g][a,xn,1] = []) then for h in linkset[g,0,xn2,7] do for b in[1..5] do for xn3:= low(linkset[h][b] ) to high(linkset[h][b]) do if ( linkset[h][b,xn3,4] * linkset[g][0,xn2,5] <> []) and (linkset[h][b,xn3,5] * linkset[g][a,xn,4] <> []) and (linkset[g][a,xn,1] * linkset[h][b,xn3,2] = []) and (linkset[h][b,xn3,2] * linkset[g][0,xn2,2] = []) and (linkset[h][b,xn3,1] * linkset[g][0,xn2,2] = []) then begin active:=true; if h in linkset[g][a,xn,6] then for n in linkset[h][b,xn3,3] do begin covered2[n]:=covered2[n] + (linkset[g][a,xn,1] ); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][a,xn,1] ); end; if g in linkset[h][b,xn3,7] then for n in linkset[g][a,xn,0] do begin covered2[n]:=covered2[n] + (linkset[h][b,xn3,2] ) ; if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[h][b,xn3,2] ) ; end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,a][xn][0]; techwrite[u,3]:=linkset[g,a][xn][1]; techwrite[u,4]:=linkset[g,a][xn][2]; techwrite[u,5]:=linkset[g,a][xn][3]; techwrite[u,6]:=linkset[g,0][xn2][0]; techwrite[u,7]:=linkset[g,0][xn2][1]; techwrite[u,8]:=linkset[g,0][xn2][2]; techwrite[u,9]:=linkset[g,0][xn2][3]; techwrite[u,10]:=linkset[h,b][xn3][0]; techwrite[u,11]:=linkset[h,b][xn3][1]; techwrite[u,12]:=linkset[h,b][xn3][2]; techwrite[u,13]:=linkset[h,b][xn3][3]; u:=u+1; setlength(techwrite,u+1,23); end; end; if k= 1 then chaindisplay(#134,u); end;

Local 2 wing

L2-wing: Show

Code: Select all: {local 2 wing } Procedure L2wing(K:integer); var xn,a,xn2,b,xn3,c,n,u,g,h:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,23); end; for g in [1..9] do for a in[1,3] do for xn:= low(linkset[g][a]) to high(linkset[g][a]) do for h in (linkset[g,a,xn,7]) do for b in[1,2] do for xn2:= low(linkset[h][b]) to high(linkset[h][b]) do if (linkset[h,b,xn2,6] * linkset[g,a,xn,7] <> [] ) { cell can overlap} and (linkset[h,b,xn2,4] * linkset[g,a,xn,5] <> [] ) { a & b share sector } and (linkset[h,b,xn2,1] = linkset[g,a,xn,2] ) {a end, b start share exact cell} and (linkset[h,b,xn2,2] * linkset[g,a,xn,1] = [] ) // a & b cant be duplicates then for c in [1,2,3,5] do for xn3:=low(linkset[h][c]) to high(linkset[h][c]) do if (linkset[h,c,xn3,4] * linkset[h,b,xn2,5] <> []) { end and start share sectors} and ((linkset[h,c,xn3,1] + linkset[h,c,xn3,2])*(linkset[h,b,xn2,1] + linkset[h,b,xn2,2]) =[]){cant contain a duplicate} and ((linkset[h,c,xn3,1] + linkset[h,c,xn3,2])*(linkset[g,a,xn,1] + linkset[g,a,xn,2]) =[]){cant contain a duplicate} and ((linkset[h,c,xn3,5] * linkset[g,a,xn,4] <> []) {share a sector} {or (linkset[h,c,xn3,9] * linkset[g,a,xn,8] <> [])}) {eliminations are common} // probably removable {end point of c and start of a must share sector} then begin active:=true; if h in linkset[g][a,xn,6] then for n in linkset[h][c,xn3,3] do begin covered2[n]:=covered2[n] + (linkset[g][a,xn,1] ); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][a,xn,1] ); end; if g in linkset[h][c,xn3,7] then for n in linkset[g][a,xn,0] do begin covered2[n]:=covered2[n] + (linkset[h][c,xn3,2] ) ; if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[h][c,xn3,2] ); end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,a][xn][0]; techwrite[u,3]:=linkset[g,a][xn][1]; techwrite[u,4]:=linkset[g,a][xn][2]; techwrite[u,5]:=linkset[g,a][xn][3]; techwrite[u,6]:=linkset[h,b][xn2][0]; techwrite[u,7]:=linkset[h,b][xn2][1]; techwrite[u,8]:=linkset[h,b][xn2][2]; techwrite[u,9]:=linkset[h,b][xn2][3]; techwrite[u,10]:=linkset[h,c][xn3][0]; techwrite[u,11]:=linkset[h,c][xn3][1]; techwrite[u,12]:=linkset[h,c][xn3][2]; techwrite[u,13]:=linkset[h,c][xn3][3]; u:=u+1; setlength(techwrite,u+1,23); end; end; if k = 1 then chaindisplay(#136,u); end;{local 2 wing}

Local 3 wing

L3-wing: Show

hybrid wings

H1-wing: Show

Code: Select all: {hybrid type 1 wing} procedure H1wing(K:integer); var n,n2,n3,xn,xn2,xn3,j,j3,j2,g:integer; begin if k = 1 then begin g:=0; setlength(techwrite,g+1,26); end; for n:= 1 to 9 do for j:= 0 to 26 do if sec[j,n]= 2 then for xn in DigitRCB[j,n] do for xn2 in DigitRCB[j,n] -[xn] do for j2 in (([rx[xn]] + [Cy[xn]+9] + [bxy[xn]+18])-([j]) ) do for n2 in (pm[xn] - [n]) do if sec[j2,n2] = 2 then for xn3 in (DigitRCB[j2,n2] - ([xn]+[xn2])) do for j3 in (([rx[xn2]] + [Cy[xn2]+9] + [bxy[xn2]+18]) -([j]+[j2]) ) do for n3 in (pm[xn2] - ([n]+[n2]) ) do if (sec[j3,n3] <5) and (sec[j3,n3] > 1) and (((DigitRCB[j3,n3] * peer[xn3]) + [xn2]) = DigitRCB[j3,n3] ) then begin active:= true; if (pm[xn3] * [n3] <> []) then begin covered2[n3]:= covered2[n3] + [xn3]; if k=1 then techwrite[g,n3+15]:= [xn3]; end; if sec[j3,n3] = 2 then begin covered2[n2]:=covered2[n2] + ((peer[xn3] * DigitRCB[j3,n3] ) * Digitrcb[j3,n2]); if k = 1 then techwrite[g,n2+15]:= ((peer[xn3] * DigitRCB[j3,n3] )* Digitrcb[j3,n2]); end; if (k = 1) and (techwrite[g,1+15] + techwrite[g,15] + techwrite[g,3+15] + techwrite[g,4+15] + techwrite[g,5+15] + techwrite[g,6+15] + techwrite[g,7+15] + techwrite[g,8+15]+ techwrite[g,9+15] <> []) then begin techwrite[g,0]:=[4]; techwrite[g,1]:=[12]; techwrite[g,2]:=[n3]; techwrite[g,3]:=digitrcb[j3,n3] - [xn2]; techwrite[g,4]:=[xn2]; techwrite[g,5]:=[n3]; techwrite[g,6]:=[n]; techwrite[g,7]:=[xn2]; techwrite[g,8]:=[xn]; techwrite[g,9]:=[n]; techwrite[g,10]:=[n2]; techwrite[g,11]:=[xn]; techwrite[g,12]:=[xn3]; techwrite[g,13]:=[n2]; g:=g+1; setlength(techwrite,g+1,26); end; end; if k= 1 then chaindisplay(#95,g); end; {h1 wing}

H2-wing: Show

Code: Select all: {hybrid type 2 wing} procedure H2wing(k:integer); var xn,xn2,xn3,a,b,u,n,g,h,i:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,23); end; for g in [1..9] do for xn:= low(linkset[g][0]) to high(linkset[g][0] ) do for h in linkset[g][0,xn,7] do for a in [1,3] do for xn2:= low(linkset[h][a]) to high(linkset[h][a]) do if (linkset[h][a,xn2,1] * linkset[g][0,xn,2] = []) and (linkset[g][0,xn,3] * linkset[h][a,xn2,0] <> []) and (linkset[h][a,xn2,4] * linkset[g][0,xn,5] <> []) then for I in linkset[h][a,xn2,7] -[g] do for b in [1] do for xn3:= low(linkset[i][b]) to high(linkset[i][b]) do if (linkset[i][b,xn3,1] = linkset[h][a,xn2,2] ) and (linkset[i][b,xn3,2] * linkset[g][0,xn,1] = []) then begin if (linkset[g][0,xn,8] * linkset[i][b,xn3,2] <> [] ) then begin active:=true; For n in (linkset[g][0,xn,0]) do begin covered2[n]:=covered2[n] + (linkset[g][0,xn,8] * linkset[i][b,xn3,2]); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][0,xn,8] * linkset[i][b,xn3,2]); end; end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,0][xn][0]; techwrite[u,3]:=linkset[g,0][xn][1]; techwrite[u,4]:=linkset[g,0][xn][2]; techwrite[u,5]:=linkset[g,0][xn][3]; techwrite[u,6]:=linkset[h,a][xn2][0]; techwrite[u,7]:=linkset[h,a][xn2][1]; techwrite[u,8]:=linkset[h,a][xn2][2]; techwrite[u,9]:=linkset[h,a][xn2][3]; techwrite[u,10]:=linkset[i,b][xn3][0]; techwrite[u,11]:=linkset[i,b][xn3][1]; techwrite[u,12]:=linkset[i,b][xn3][2]; techwrite[u,13]:=linkset[i,b][xn3][3]; u:=u+1; setlength(techwrite,u+1,23); end; end; if k = 1 then chaindisplay(#110,u); end;{h2wing}

H3-wing: Show

Code: Select all: {hybrid type 2 wing} procedure H3wing(k:integer); var xn,xn2,xn3,a,b,u,n,g,h,i:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,23); end; for g in [1..9] do for xn:= low(linkset[g][0]) to high(linkset[g][0] ) do for h in linkset[g][0,xn,7] do for a in [0] do for xn2:= low(linkset[h][a]) to high(linkset[h][a]) do if (linkset[g,0,xn,0] * linkset[h,a,xn2,3] = [] ) then if (linkset[h][a,xn2,1] * linkset[g][0,xn,2] = []) and (linkset[h][a,xn2,4] * linkset[g][0,xn,5] <> []) then for I in linkset[h][a,xn2,7] do for b in [1,3] do for xn3:= low(linkset[i][b]) to high(linkset[i][b]) do if (linkset[i,b,xn3,4] * linkset[h,a,xn2,5] <> [] ) and (linkset[i,b,xn3,5] * linkset[g,0,xn,4] <> []) and (linkset[i,b,xn3,1] * linkset[g,0,xn,1] = []) and (linkset[i,b,xn3,2] * linkset[g,0,xn,1] = []) and (linkset[i,b,xn3,1] * linkset[h,a,xn2,1] = []) and (linkset[i,b,xn3,2] * linkset[h,a,xn2,1] = []) then begin if (linkset[g][0,xn,8] * linkset[i][b,xn3,2] <> [] ) then begin active:=true; For n in (linkset[g][0,xn,0]) do begin covered2[n]:=covered2[n] + (linkset[g][0,xn,8] * linkset[i][b,xn3,2]); if k = 1 then techwrite[u,n+13]:=techwrite[u,n+13] + (linkset[g][0,xn,8] * linkset[i][b,xn3,2]); end; end; if (k = 1) and (techwrite[u,1+13]+ (techwrite[u,2+13])+ (techwrite[u,3+13] ) + (techwrite[u,4+13] ) + (techwrite[u,5+13])+ (techwrite[u,6+13] ) + (techwrite[u,7+13] ) + (techwrite[u,8+13])+ (techwrite[u,9+13] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[10]; techwrite[u,2]:=linkset[g,0][xn][0]; techwrite[u,3]:=linkset[g,0][xn][1]; techwrite[u,4]:=linkset[g,0][xn][2]; techwrite[u,5]:=linkset[g,0][xn][3]; techwrite[u,6]:=linkset[h,a][xn2][0]; techwrite[u,7]:=linkset[h,a][xn2][1]; techwrite[u,8]:=linkset[h,a][xn2][2]; techwrite[u,9]:=linkset[h,a][xn2][3]; techwrite[u,10]:=linkset[i,b][xn3][0]; techwrite[u,11]:=linkset[i,b][xn3][1]; techwrite[u,12]:=linkset[i,b][xn3][2]; techwrite[u,13]:=linkset[i,b][xn3][3]; u:=u+1; setlength(techwrite,u+1,23); end; end; if k = 1 then chaindisplay(#78,u); end;{h3-wing}

H45-wing: Show

Code: Select all: {hybrid wing types: 4 & 5} procedure h45wing(w:integer); var xn,xn2,n,n2,yn,yn2,yn3,g,count,count2,F,s,k:integer; l:nums; begin if w = 0 then begin k:=0; setlength(techwrite,k+1,17); end; for xn in ocell do if (nm[xn] = 2) then for xn2 in (ocell -[xn] )do if (nm[xn2] = 2 ) and (pm[xn2] * pm[xn] <> [] ) and (pm[xn2] - pm[xn] <> [] ) then for n in pm[xn]*pm[xn2] do for n2 in (pm[xn2] - [n]) do for yn in ((peerrcb[rsec[rx[xn]]] + peerrcb[Csec[Cy[xn]]]+ peerrcb[Bsec[Bxy[xn]]]) - ([rsec[rx[xn2]]] + [Csec[Cy[xn2]]]+ [Bsec[Bxy[xn2]]]) ) do if (Digitrcb[yn,n] * [xn] = [xn] ) and (Digitrcb[yn,n] * [xn2] = []) then for yn2 in ((peerrcb[rsec[rx[xn2]]] + peerrcb[Csec[Cy[xn2]]]+ peerrcb[Bsec[Bxy[xn2]]]) - ([rsec[rx[xn]]] + [Csec[Cy[xn]]]+ [Bsec[Bxy[xn]]])) do if (Digitrcb[yn2,n2] * [xn2] = [xn2] ) and (digitrcb[yn2,n2] *[xn] = []) then for yn3 in (peerrcb[yn] * peerrcb[yn2]) do begin {h 4 wing} if ((digitrcb[yn,n] * Digitrcb[yn3,n]) + [xn] = Digitrcb[yn,n]) and ((digitrcb[yn2,n2] * Digitrcb[yn3,n2]) + [xn2] = Digitrcb[yn2,n2]) and (digitrcb[yn3,n2] * digitrcb[yn2,n2] <> []) and (digitrcb[yn3,n] * digitrcb[yn,n] <> []) and ((digitrcb[yn3,n] * Digitrcb[yn2,n] ) *(digitrcb[yn3,n2] * digitrcb[yn2,n2] )<> []) then begin count:=0; count2:=0; l:=[]; For g in ((digitrcb[yn,n] * digitrcb[yn3,n]) + (Digitrcb[yn2,n2] * Digitrcb[yn3,n2]) - [xn,xn2]) do begin inc(count); L:= l + pm[g]; end; for g in l do inc(count2); if (count = (count2 - 1) ) and (xn in peer[xn2]) {h4 wing} then for g:= slist[count] to flist[count] do if (L - [n2] = comboset[g]) and (comboset[g] * pm[xn] -[n] = []) then begin active:=true; covered2[n]:=covered2[n] + (Digitrcb[yn3,n] - (Digitrcb[yn,n] + digitrcb[yn2,n2])); if w = 0 then begin techwrite[k,0]:=[xn]; techwrite[k,10]:=[xn2]; techwrite[k,11]:=[n]; techwrite[k,12]:=[n2]; techwrite[k,13]:=pm[xn] -[n]; techwrite[k,14]:=(digitrcb[yn,n] * Digitrcb[yn3,n]); techwrite[k,15]:= (digitrcb[yn2,n2] * Digitrcb[yn3,n2]); techwrite[k,16]:= comboset[g]; techwrite[k,n]:= techwrite[k,n]+ (Digitrcb[yn3,n] - (Digitrcb[yn,n] + digitrcb[yn2,n2])); end; end; if (w=0 ) and (techwrite[k,1] + techwrite[k,2] + techwrite[k,3] + techwrite[k,4] + techwrite[k,5] + techwrite[k,6] + techwrite[k,7] + techwrite[k,8] + techwrite[k,9] <> [] ) then begin k:=k+1; setlength(techwrite,k+1,17); end; end; {h4 wing} {h5 wing} if ((peer[xn] * digitrcb[yn2,n2]) + [xn2] = digitrcb[yn2,n2]) and (( peer[xn2] * digitrcb[yn,n]) + [xn] = digitrcb[yn,n]) and ((digitrcb[yn3,n] * digitrcb[yn,n]) + (digitrcb[yn3,n2] * digitrcb[yn2,n2]) = [xn] + (peer[xn] * digitrcb[yn2,n2] ) ) then begin count:=0; count2:=0; L:=[]; for g in ((digitrcb[yn3,n] * digitrcb[yn,n] ) + (digitrcb[yn3,n2] * digitrcb[yn2,n2])) do begin L:= L + pm[g]; inc(count); end; for G in l do inc(count2); if (count = (count2 - 1) ) then for g:= slist[count] to Flist[count] do if L - [n2] = comboset[g] then begin active:=true; covered2[n]:=covered2[n] + (Digitrcb[yn3,n] - (Digitrcb[yn,n] + digitrcb[yn2,n2])); if w = 0 then begin techwrite[k,0]:=[xn]; techwrite[k,10]:=[xn2]; techwrite[k,11]:=[n]; techwrite[k,12]:=[n2]; techwrite[k,13]:=pm[xn] -[n]; techwrite[k,14]:=(digitrcb[yn,n] * Digitrcb[yn3,n]); techwrite[k,15]:= (digitrcb[yn2,n2] * Digitrcb[yn3,n2]); techwrite[k,16]:= comboset[g]; techwrite[k,n]:= techwrite[k,n]+ (Digitrcb[yn3,n] - (Digitrcb[yn,n] + digitrcb[yn2,n2])); end; end; if (w=0 ) and (techwrite[k,1] + techwrite[k,2] + techwrite[k,3] + techwrite[k,4] + techwrite[k,5] + techwrite[k,6] + techwrite[k,7] + techwrite[k,8] + techwrite[k,9] <> [] ) then begin k:=k+1; setlength(techwrite,k+1,17); end; end; {h5 wing} end; {yn3} if w = 0 then techdisplay(#14,k); end;{h45 wing}

inverted W wing

iW-wing: Show

Code: Select all: {invertered W-wing} procedure iWWing(K:integer); var G,a,xn,h,b,xn2,c,xn3,d,xn4,u,n,r:integer; begin if k = 1 then begin u:=0; setlength(techwrite,u+1,30); end; For g in [1..9] do for a in [1,3] do for xn:= low(linkset[g][a]) to high(linkset[g][a]) do for h in (linkset[g][a][xn,7]) do for b in [1,2] do for xn2:= low(linkset[h][b]) to high(linkset[h][b]) do if (linkset[h][b][xn2,1] = linkset[g,a,xn,2]) and (linkset[h][b][xn2,4] * linkset[g,a,xn,5] <> []) and (linkset[h][b][xn2,2] * linkset[g,a,xn,1] = []) then for C in [1,3] do for xn3:=low(linkset[h][c]) to high(linkset[h][c]) do if ((C = b) and (xn3>xn2)) or (c>b)then if (linkset[h,c,xn3,4] * linkset[h,b,xn2,5] <> []) and ((linkset[h,c,xn3,1]+linkset[h,c,xn3,2]) * (linkset[h,b,xn2,1]+linkset[h,b,xn2,2]) = []) then for D in [1,2] do for xn4:= low(linkset[g][d]) to high(linkset[g][d]) do if ((d = a) and (xn4 > xn))then if (linkset[h,c,xn3,2] = linkset[g,d,xn4,1]) and (linkset[h,c,xn3,5] * linkset[g,d,xn4,4] <> []) and ((linkset[g,d,xn4,1]+linkset[g,d,xn4,2]) * (linkset[g,a,xn,1]+linkset[g,a,xn,2]) = []) and ((linkset[g,d,xn4,2]) * (linkset[h,c,xn3,1]+linkset[h,c,xn3,2]) = []) and ( (linkset[g,d,xn4,1] + linkset[g,d,xn4,2]) * (linkset[h,b,xn2,1]+linkset[h,b,xn2,2]) = []) then begin if (linkset[g,a,xn,8] * linkset[g,d,xn4,9]) <> [] then begin active:=true; for n in (linkset[g,a,xn,0] * linkset[g,d,xn4,3]) do begin covered2[n]:=covered2[n] + (linkset[g,a,xn,8] * linkset[g,d,xn4,9]) ; if k = 1 then techwrite[u,n+19]:=techwrite[u,n+19] + (linkset[g,a,xn,8] * linkset[g,d,xn4,9]) ; end; end; if (linkset[g,d,xn4,5] * linkset[g,a,xn,4] <> []) then begin active:=true; for n in (linkset[h,b,xn2,3] * linkset[h,c,xn3,0]) do begin covered2[n]:=covered2[n] + (linkset[h,b,xn2,9] * linkset[h,c,xn3,8]); if k = 1 then techwrite[u,n+19]:=techwrite[u,n+19] + (linkset[h,b,xn2,9] * linkset[h,c,xn3,8]); end; for n in (linkset[h,b,xn2,1] * linkset[g,a,xn,2]) do begin covered[n]:=covered[n] + (pm[n] - [g,h]); if k = 1 then for r in (pm[n] - [g,h]) do techwrite[u,r+19]:=techwrite[u,r+19] + [n]; end; for n in (linkset[h,c,xn3,2] + linkset[g,d,xn4,1]) do begin covered[n]:= covered[n] + (pm[n] - [g,h]); if k = 1 then for r in (pm[n] - [g,h]) do techwrite[u,r+19]:=techwrite[u,r+19] + [n]; end; end; if (k = 1) and (techwrite[u,1+19]+ (techwrite[u,2+19])+ (techwrite[u,3+19] ) + (techwrite[u,4+19] ) + (techwrite[u,5+19])+ (techwrite[u,6+19] ) + (techwrite[u,7+19] ) + (techwrite[u,8+19])+ (techwrite[u,9+19] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[16]; techwrite[u,2]:=linkset[g,a][xn][0]; techwrite[u,3]:=linkset[g,a][xn][1]; techwrite[u,4]:=linkset[g,a][xn][2]; techwrite[u,5]:=linkset[g,a][xn][3]; techwrite[u,6]:=linkset[h,b][xn2][0]; techwrite[u,7]:=linkset[h,b][xn2][1]; techwrite[u,8]:=linkset[h,b][xn2][2]; techwrite[u,9]:=linkset[h,b][xn2][3]; techwrite[u,10]:=linkset[h,c][xn3][0]; techwrite[u,11]:=linkset[h,c][xn3][1]; techwrite[u,12]:=linkset[h,c][xn3][2]; techwrite[u,13]:=linkset[h,c][xn3][3]; techwrite[u,14]:=linkset[g,d][xn4][0]; techwrite[u,15]:=linkset[g,d][xn4][1]; techwrite[u,16]:=linkset[g,d][xn4][2]; techwrite[u,17]:=linkset[g,d][xn4][3]; u:=u+1; setlength(techwrite,u+1,30); end; end; if k = 1 then chaindisplay(#137,u); end; {inverted w-wing}

XY-wing, XYZ-wing, Wxyz -wings and larger are covered under B.A.R.N.s

Barns: Show

Code: Select all: procedure Barns(K,M,Q,v:integer); { k is writting function M is starting size v is ending size,q selectins inital cell size v is end size} type hold = array of integer; base = array of numberset; hold2 = array of RCBpeer; var p,S,F,C,w,j,a,b,z,lx,x,g,l,r,act:integer; xs:nums; z1:nums; p2:numberset; lx1:numberset; h: hold; step: base; List: hold2; begin cellcombo; If M = 0 then L:= 2 else L:=M; repeat begin for C:= slist[l] to flist[l] do if (combocell[c] <> []) then begin act:=0; for p in combocell[c]do begin inc(act); if act >=L then break; end; if act >=L then for p in combocell[c] do if (peer[p] * combocell[c] <> [] ) and ( ( (q = 1) and (nm[p] = 2)) or ((q = 2) and (nm[p] = 3)) or ((q = 0) and (nm[p] <=L)) ) 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} 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 not (peer2[p,j] in step[w]) and ( peer2[p,j] in combocell[c]) and ( (peer[p] * (combocell[c] - step[w]) <> [] ) or (w+2 = l) ) then begin inc(w); {increase step count} setlength(h,w+1); {increase lenght of step starting point array} 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 in list[w] do if (RCBnum[a]*step[w] <> [] ) then begin for B in list[w] do 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[a,z] * step[w] ) <> []) or ( (digitrcb[b,z] * step[w] ) <> []) ) then for lx in ( LIST[W] ) do if ( ( (digitRCB[a,z] * digitRCB[lx,z] * step[w]) <> []) or ( (digitRCB[b,z] * digitRCB[lx,z] * step[w]) <> []) ) and ( (( DigitRCB[b,z] + DigitRCB[a,z]) * digitrcb[lx,z] * step[w]) = ( (digitrcb[a,z] + digitrcb[b,z]) * 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[a,x] * step[w] ) <> []) and ( (digitrcb[b,x] * step[w] ) <> []) then begin xs:=xs+[x]; p2:= p2 + (( DigitRCB[a,x] + digitrcb[b,x] )*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 (ocell - 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[a,x] + digitrcb[b,x]) * (step[w] ) ) = ((digitRcb[a,x] + digitrcb[b,x]) * (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 { write(G,' @: '); } p2:=(digitrcb[a,g]+digitrcb[b,g])*step[w]; for x in (ocell - 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(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; end; if m = 0 then inc(L); until (L = m) or (L > v); end;

Strong Wing

Strong Wing: Show

Code: Select all: Procedure StrongWing(K:integer);{strong wing/rings} var xn,xn2,xn3,xn4,c,n,u,g,h,i,j,r:integer; begin links; if k = 1 then begin u:=0; setlength(techwrite,u+1,27); end; for g in [1..9] do for xn:= low(linkset[g][1]) to high(linkset[g][1]) do for h in linkset[g,1,xn,7]-[g] do for xn2:= low(linkset[h][1]) to high(linkset[h][1]) do if (linkset[g][1,xn,2] = linkset[h][1,xn2,1] ) and (linkset[g][1,xn,5] * linkset[h][1,xn2,4] <> []) and(linkset[g][1,xn,1] * linkset[h][1,xn2,1] = []) and (linkset[g][1,xn,1] * linkset[h][1,xn2,2] = []) then for I in (linkset[h,1,xn2,7] -[g,h]) do for xn3:=low(linkset[i][1]) to high(linkset[i][1]) do if (linkset[i][1,xn3,1] = linkset[h][1,xn2,2]) and (linkset[i][1,xn3,4] * linkset[h][1,xn2,5] <> []) and (linkset[i][1,xn3,5] * linkset[g][1,xn,4] <> []) and (linkset[i][1,xn3,2] * linkset[h][1,xn2,2] = []) and (linkset[i][1,xn3,2] * linkset[g][1,xn,1] = []) and (linkset[i][1,xn3,2] * linkset[g][1,xn,2] = []) and (linkset[i][1,xn3,1] * linkset[g][1,xn,1] = []) and (linkset[i][1,xn3,1] * linkset[g][1,xn,2] = []) then for j in (linkset[i][1,xn3,7]) do for xn4:=low(linkset[j][1]) to high(linkset[j][1]) do if (linkset[j,1,xn4,1] = linkset[i,1,xn3,2] ) and (linkset[j,1,xn4,2] = linkset[g,1,xn,1] ) then begin if J = g then begin active:= true; covered2[j]:= covered2[j] + linkset[g,1,xn,8]; if k = 1 then techwrite[u,j+17]:=techwrite[u,j+17] + linkset[g,1,xn,8]; for n in linkset[g,1,xn,1] do begin covered[n]:=covered[n] + (pm[n] - [j]); if k = 1 then for r in pm[n] - [j] do techwrite[u,j+17]:=techwrite[u,j+17] + [r]; end; end; if j <> g then begin active:= true; for n in linkset[g,1,xn,1] do begin covered[n]:=covered[n] + (pm[n] - [j,g]); if k = 1 then for r in pm[n] - [j,g] do techwrite[u,j+17]:=techwrite[u,j+17] + [r]; end; for n in linkset[h,1,xn2,1] do begin covered[n]:=covered[n] + (pm[n] - [g,h]); if k = 1 then for r in pm[n] - [g,h] do techwrite[u,j+17]:=techwrite[u,j+17] + [r]; end; for n in linkset[i,1,xn3,1] do begin covered[n]:=covered[n] + (pm[n] - [i,h]); if k = 1 then for r in pm[n] - [i,h] do techwrite[u,j+17]:=techwrite[u,j+17] + [r]; end; for n in linkset[j,1,xn4,1] do begin covered[n]:=covered[n] + (pm[n] - [i,j]); if k = 1 then for r in pm[n] - [i,j] do techwrite[u,j+17]:=techwrite[u,j+17] + [r]; end; end; if (k = 1) and (techwrite[u,1+17]+ (techwrite[u,2+17])+ (techwrite[u,3+17] ) + (techwrite[u,4+17] ) + (techwrite[u,5+17])+ (techwrite[u,6+17] ) + (techwrite[u,7+17] ) + (techwrite[u,8+17])+ (techwrite[u,9+17] ) <> []) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[14]; techwrite[u,2]:=linkset[g,1][xn][0]; techwrite[u,3]:=linkset[g,1][xn][1]; techwrite[u,4]:=linkset[g,1][xn][2]; techwrite[u,5]:=linkset[g,1][xn][3]; techwrite[u,6]:=linkset[h,1][xn2][0]; techwrite[u,7]:=linkset[h,1][xn2][1]; techwrite[u,8]:=linkset[h,1][xn2][2]; techwrite[u,9]:=linkset[h,1][xn2][3]; techwrite[u,10]:=linkset[i,1][xn3][0]; techwrite[u,11]:=linkset[i,1][xn3][1]; techwrite[u,12]:=linkset[i,1][xn3][2]; techwrite[u,13]:=linkset[i,1][xn3][3]; techwrite[u,14]:=linkset[j,1][xn4][0]; techwrite[u,15]:=linkset[j,1][xn4][1]; techwrite[u,16]:=linkset[j,1][xn4][2]; techwrite[u,17]:=linkset[j,1][xn4][3]; u:=u+1; setlength(techwrite,u+1,27); end; end; if k = 1 then chaindisplay(#94,u); end;{strong wing}

by **StrmCkr** » Sat Jan 28, 2017 7:27 am

Almost locked set rules

ALS-XZ: Show

Code: Select all: procedure alsxz(k:integer); {so far this is 100,000% faster} type almostlockedset2= array of array of integer; var q,xn,xn2,yn,yn2,yn3,yn4,n,z,x,r,u,alsa,alsB,a,b:integer; A3:numberset; A4:numberset; z1:nums; lx1: rcbpeer; lx2: rcbpeer; als2:almostlockedset2; begin alsfinder; //ahsfinder; b:=0; setlength(als2,b,5); for a:= high(als) downto 0 do {startin array} if (als[a,1]+1 = als[a,2]) then begin b:=b+1; setlength(als2,b+1,5); als2[b,0]:=als[a,0]; als2[b,1]:=als[a,1]; als2[b,2]:=als[a,2]; als2[b,3]:=als[a,3]; als2[b,4]:=als[a,4]; end; if k=0 then begin u:=0; setlength(techwrite,u+1,18); end; for alsA:= low(als2) to (high(als2)-1) do {als A} if (als2[alsA,1]+1 = als2[alsA,2]) {cell = digit +1} then for ALSB:= alsa+1 to high(als2) do {Als B} if (als2[alsb,1]+1 = als2[alsb,2] ) {cell = digit +1} and (popcnt(dword((comboset2[als2[alsa,4]]*Comboset2[als2[alsb,4]]) ) ) >1 ) {set a & B must share 2 digits} and (combosets[als2[alsa,0],als2[alsa,3]] - combosets[als2[alsb,0],als2[alsb,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als2[alsb,0],als2[alsb,3]] - combosets[als2[alsa,0],als2[alsa,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als2[alsa,0]; xn2:=als2[alsb,0]; yn:=als2[alsA,3]; yn3:=als2[alsB,3]; yn2:=als2[alsa,4]; yn4:= als2[alsb,4]; z1:=[]; {restricted common chcek} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if popcnt(dword(z1)) =1 {single restricted common eliminations} then begin for R in ((comboset[yn4] * comboset[yn2] ) -z1) do {search for common digit to both, and active in both} if ((Digitcell[R]* combosets[xn,yn] )<> [] ) and(( Digitcell[R] * combosets[xn2,yn3])<> []) then begin active:=true; a3:=(([0..80] * digitcell[R])); {valid eliminations must contain R and cannot be in the sets a&b} for q in ((combosets[xn,yn] + combosets[xn2,yn3]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&B} a3:=peer[q] * a3 - (combosets[xn,yn] + combosets[xn2,yn3]); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+7]:= techwrite[u,r+7] + a3; techwrite[u,7]:=techwrite[u,7]+[R]; end; end; if (k= 0) and (techwrite[u,7] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[4]; techwrite[u,2]:=techwrite[u,2]+comboset[yn2]; techwrite[u,3]:=techwrite[u,3]+Combosets[xn,yn]; techwrite[u,4]:=techwrite[u,4]+comboset[yn4]; techwrite[u,5]:=techwrite[u,5]+combosets[xn2,yn3]; techwrite[u,6]:=techwrite[u,6]+ z1; end; if u = 32767 {max array size error code safty exit} then begin if k = 0 then techdisplay(#97,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,17) //exit; end; if (k=0) and (techwrite[u,0] <> []) then begin u:=U+1; setlength(techwrite,u+1,18); end; end; {normal eliminations} if popcnt(dword(z1)) >1 {doubly linked rules } then begin active:=true; active:=true; {set A&b is now a locked set removal peers cells visable to all copies of each digit in both sets} for R in comboset[yn2] + comboset[yn4] do for q in ([0..80] * digitcell[R]) do begin {R/Q elimiantion search} if (R in (comboset[yn2] * Comboset[yn4]) ){search for common digit to both, and active in both} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn2,yn3]) <> []) and (Peer[q] * ((Combosets[xn,yn]+Combosets[xn2,yn3])*digitcell[R]) = ((Combosets[xn,yn] + Combosets[xn2,yn3])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn,yn] + combosets[xn2,yn3]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+7]:= techwrite[u,r+7] + [q]; techwrite[u,7]:=techwrite[u,7]+[R]; end; end; {cells in set b for digits exclusivly to b their peers cannot contain r} if (R in (Comboset[yn2] - z1)) and (peer[q] * Digitcell[R] * Combosets[xn,yn] = combosets[xn,yn] * Digitcell[R]) and ([q] * combosets[xn,yn] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+7]:= techwrite[u,r+7] + [q]; techwrite[u,7]:=techwrite[u,7]+[R]; end; end; {cells in set A for digits exclusivly to A their peers cannot contain r} if (R in (Comboset[yn4] - z1)) and (peer[q] * Digitcell[R] * Combosets[xn2,yn3] = combosets[xn2,yn3]* Digitcell[R]) and ([q] * combosets[xn2,yn3] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+7]:= techwrite[u,r+7] + [q]; techwrite[u,7]:=techwrite[u,7]+[R]; end; end; end; {R/Q elimiantion search} if (k= 0) and (techwrite[u,7] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[4]; techwrite[u,2]:=techwrite[u,2]+comboset[yn2]; techwrite[u,3]:=techwrite[u,3]+Combosets[xn,yn]; techwrite[u,4]:=techwrite[u,4]+comboset[yn4]; techwrite[u,5]:=techwrite[u,5]+combosets[xn2,yn3]; techwrite[u,6]:=techwrite[u,6]+ z1; end; if u = 32767 {max array size error code safty exit} then begin if k = 0 then techdisplay(#97,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,18) //exit; end; if (k=0) and (techwrite[u,0] <> []) then begin u:=U+1; setlength(techwrite,u+1,18); end; end; {doubly linked} end; {yn4} if k = 0 then chaindisplay(#97,u); end;{als -xz rule}

AHS-xz: Show

Code: Select all: {almost hidden set xz } // needs a massive overhall for the eliminations process should be cell based not cell+digit procedure ahsxz(k:integer); {so far this is 100,000% faster} var q,xn,xn2,n,z,x,r,u,alsa,alsB,act3,u2:integer; a2,a3,b2,b3,z1,x1,lxl,yn,yn2,yn3,yn4:numberset; begin //alsfinder; ahsfinder; if k=0 then begin u:=0; setlength(techwrite,u+1,16); end; for alsA:= low(ahs) to (high(ahs)-1) do {als A} if (ahs[alsA,1]+1 = ahs[alsA,2]) {digit = cell +1} and (ahs[alsa,1] <4) // and (sectorrcb[ahs[alsa,0],ahs[alsa,4]] = [24,69,78]) then for ALSB:= alsa+1 to high(ahs) do {Als B} if (ahs[alsb,1]+1 = ahs[alsb,2] ) {cell = digit +1} and (ahs[alsb,1] <4) // and (sectorrcb[ahs[alsb,0],ahs[alsb,4]] = [62,69,71]) then begin xn:=ahs[alsa,0]; {sector a} xn2:=ahs[alsb,0]; yn:=comboset[ahs[alsA,3]]; {digits a } yn3:=comboset[ahs[alsB,3]]; {digits b} yn2:=sectorrcb[xn,ahs[alsa,4]]; {cells a } yn4:=sectorrcb[xn2,ahs[alsb,4]]; {cells b} a2:=yn*yn3;// identifies shared Digits z1:=yn2*yn4; // overlapping cells b2:=[]; //checks for RCC b3:=[]; // stores RCC if the lxl:=[]; // shared cells with shared digits a3:=[]; // digits of a shared cell with no shared digits if (z1 <> []) and (a2 <> [] ) then for n in a2 do lxl:=lxl + (Digitcell[n]* z1); if (lxl=[]) and (z1 <> []) then for n in z1 do a3:=a3 + (pm[n] *(yn+yn3)); //identifies shared digits in 1 sector that have 1 option for q in a2 do begin x1:=[0..26]; for N in (DigitCell[q] * (yn2+yn4)) do if (pm[n] -(yn+yn3) * [q]) = [q] then begin b2:= b2 + [n]; x1:=cellsec[n] * x1; end; {z1:= z1 - b2;} for n in x1 do if (sectorRCB[n,q] * (yn2 * b2) <> []) and (sectorrcb[n,q] * (yn4 * b2) <> []) then b3:=(yn2 * b2)+(yn4 * b2); end; gotoxy(2,60); for n in b3 do write(n,' '); gotoxy(2,61); for n in z1 do write(n,' '); gotoxy(2,62); for n in lxl do write(n,' '); gotoxy(2,63); for n in a3 do write(n,' '); {basic elimination} if (B3 + (z1-lxl) <> []) then begin active:=true; for n in yn - (a2+a3) do begin covered2[n]:=covered2[n] + digitcell[n]* (yn4-(b3+(z1-lxl))); if k = 0 then techwrite[u,n]:=techwrite[u,n]+ digitcell[n]*(yn4-(b3+(z1-lxl))); end; for n in yn3 - (a2+a3) do begin covered2[n]:=covered2[n] + digitcell[n]*(yn2-(b3+(z1-lxl))); if k = 0 then techwrite[u,n]:=techwrite[u,n]+ digitcell[n]*(yn2-(b3+(z1-lxl))); end; end; if (k= 0) and ((techwrite[u,1]+ techwrite[u,2] + techwrite[u,3] + techwrite[u,3]+techwrite[u,4]+techwrite[u,5]+techwrite[u,6]+techwrite[u,7]+techwrite[u,8]+techwrite[u,9]) <> []) then begin techwrite[u,0]:=yn; techwrite[u,10]:=yn3; techwrite[u,11]:=yn2; techwrite[u,12]:=yn4; //techwrite[u,13]:=[q]; //techwrite[u,14]:=[R]; //For u2 in pm[r] - (comboset[yn3] + Comboset[yn] ) do //techwrite[u,u2]:= techwrite[u,u2] + [R]; inc(u); setlength(techwrite,u+1,16); end; end; if k=0 then techdisplay(#104,u); end;{ahs-xz rule }

ALS-XY: Show

Code: Select all: {all most locked sets XY Rule : including double and trippled linked rules} procedure alsxy(k:integer); {so far this is 100,000% faster} type almostlockedset2= array of array of integer; var q,xn,xn2,xn3,yn,yn2,yn3,yn4,YN5,YN6,n,z,x,act3,r,u,alsA,alsB,alsC,a,b:integer; A3:numberset; z1:nums; Z2:nums; z3:nums; lx1: rcbpeer; lx2: rcbpeer; lx3: rcbpeer; als2: almostlockedset2; begin alsfinder; //ahsfinder; b:=-1; setlength(als2,b+1,5); {reduces the als array to the +1 size} for a:= high(als) downto 0 do {startin array} if (als[a,1]+1 = als[a,2]) then begin b:=b+1; setlength(als2,b+1,5); als2[b,0]:=als[a,0]; als2[b,1]:=als[a,1]; als2[b,2]:=als[a,2]; als2[b,3]:=als[a,3]; als2[b,4]:=als[a,4]; end; if k=0 then begin u:=0; setlength(techwrite,u+1,20); end; for alsA:= low(als2) to (high(als2)-2) do {als C} if (als2[alsA,1]+1 = als2[alsA,2]) {cell = digit +1} then for ALSB:= alsa+1 to high(als2)-1 do {Als A} if (als2[alsb,1]+1 = als2[alsb,2] ) {cell = digit +1} and (popcnt(dword((comboset2[als2[alsa,4]]*Comboset2[als2[alsb,4]]) ) ) >=1 ) {set a & B must share 2 digits} and (combosets[als2[alsa,0],als2[alsa,3]] - combosets[als2[alsb,0],als2[alsb,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als2[alsb,0],als2[alsb,3]] - combosets[als2[alsa,0],als2[alsa,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als2[alsa,0]; xn2:=als2[alsb,0]; yn:=als2[alsA,3]; yn3:=als2[alsB,3]; yn2:=als2[alsa,4]; yn4:= als2[alsb,4]; z1:=[]; {restricted common chcek A & C} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if popcnt(dword(z1)) >=1 {* single restricted common advance to adding 3rd sector} then for alsC:= low(als2) to (high(als2)) do {als b} if (als2[alsC,1]+1 = als2[alsC,2]) {cell = digit +1} and (popcnt(dword(( comboset2[yn2]*Comboset2[als2[alsC,4]] ) ) ) >=1 ) {checks that set B and set C share at least 1 digits} and (combosets[xn,yn] - combosets[als2[alsC,0],ALS2[ALSC,3]] <> [] ) { sectors B & C can over lap, however cells cannot overlap in full} and ( combosets[als2[alsC,0],ALS2[ALSC,3]] - combosets[xn,yn] <> [] ) then begin z2:=[]; z3:=[]; xn3:=als2[alsc,0]; yn5:=als2[alsc,3]; yn6:= als2[alsc,4]; {restricted common chcek B & C} for z in (comboset[yn6] * comboset[yn2] ) do if ((Digitcell[z] * combosets[xn3,yn5]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn,yn] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn,yn]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn,yn] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn3,yn5] * combosets[xn,yn]) = []) {resticted commons cannot be found in an overlap cell} //and (digitcell[z] * Combosets[xn2,yn3] - (combosets[xn3,yn5]+combosets[xn,yn]) = []){resticted commons cannot be found in an overlap cell shared by the 2nd set} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn3,yn5]+combosets[xn,yn]) *digitcell[z] do {combine common cells in both C&B for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z2:=z2 + [z]; {saves the resticted commons} end; {restricted common chcek B & A} for z in (comboset[yn6] * comboset[yn4] ) do if ((Digitcell[z] * combosets[xn3,yn5]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn2,yn3] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn2,yn3] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn3,yn5] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} //and (digitcell[z] * Combosets[xn2,yn3] - (combosets[xn3,yn5]+combosets[xn,yn]) = []){resticted commons cannot be found in an overlap cell shared by the 2nd set} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn3,yn5]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both C&B for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z3:=z3 + [z]; {saves the resticted commons} end; if (( popcnt(dword(z2)) >1 ) and ( popcnt(dword(z1)) >1 )){if the resticted common on a set is more then 1 its an double linked als-xz rule} or (( popcnt(dword(z2)) =1 ) and ( popcnt(dword(z1)) =1 ) and (z1 - z2 <> [] ) and (Z2 - z1 <> [])) {checks that both sectors have at least 1 RC and those numbers are diffrent } or (( popcnt(dword(z2)) =1 ) and ( popcnt(dword(z1)) >1 )) or (( popcnt(dword(z2)) >1 ) and ( popcnt(dword(z1)) =1 )) // and ((comboset[yn4] * Comboset[yn6] - (z2+z1) ) <> []) then begin {Eliminations A & B peer of z} if (popcnt(dword( (comboset2[yn4]*Comboset2[yn6]) ) ) >=1 ) then for R in ((comboset[yn6] * comboset[yn4] )-(z2+z1{+z3}) ) do {search for common digit to both A & B, thats not the RC of z1,z2,z3} if ((Digitcell[R]* combosets[xn2,yn3] )<> [] ) and(( Digitcell[R] * combosets[xn3,yn5])<> []) // and (Digitcell[R] * combosets[xn2,yn3] = []) then begin active:=true; a3:=(([0..80] * digitcell[R])); {valid eliminations must contain R and cannot be in the sets a&b} for q in ((combosets[xn3,yn5] + combosets[xn2,yn3] {+ combosets[xn,yn]}) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b} a3:=peer[q] * a3 - ({combosets[xn,yn] +} combosets[xn2,yn3] + combosets[xn3,yn5]); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {if AC share more then 1 digit perform basic als-xz eliminations} if (popcnt(dword( (comboset2[yn4]*Comboset2[yn2]) ) ) >1 ) then for R in ((comboset[yn2] * comboset[yn4] )-(z1) ) do {search for common digit to both A & C, thats not the RC of z1,} if ((Digitcell[R]* combosets[xn2,yn3] )<> [] ) and(( Digitcell[R] * combosets[xn,yn])<> []) // and (Digitcell[R] * combosets[xn2,yn3] = []) then begin active:=true; a3:=(([0..80] * digitcell[R])); {valid eliminations must contain R and cannot be in the sets a&C} for q in (({combosets[xn3,yn5] +} combosets[xn2,yn3] + combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b} a3:=peer[q] * a3 - (combosets[xn,yn] + combosets[xn2,yn3] {+ combosets[xn3,yn5]}); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {if BC share more then 1 digit perform basic als-xz eliminations} if (popcnt(dword( (comboset2[yn6]*Comboset2[yn2]) ) ) >1 ) then for R in ((comboset[yn2] * comboset[yn6] )-(z2) ) do {search for common digit to both B & C, thats not the RC of z2,} if ((Digitcell[R]* combosets[xn3,yn5] )<> [] ) and(( Digitcell[R] * combosets[xn,yn])<> []) // and (Digitcell[R] * combosets[xn2,yn3] = []) then begin active:=true; a3:=(([0..80] * digitcell[R])); {valid eliminations must contain R and cannot be in the sets a&C} for q in ((combosets[xn3,yn5] {+ combosets[xn2,yn3] }+ combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b} a3:=peer[q] * a3 - (combosets[xn,yn] {+ combosets[xn2,yn3]} + combosets[xn3,yn5]); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; if ( popcnt(dword(z1)) >1 ) {doubly linked rules } {A & C} then begin active:=true; {set A&C is now a locked set removal peers cells visable to all copies of each digit in both sets} for R in comboset[yn2] + comboset[yn4] do for q in ([0..80] * digitcell[R]) do begin {R/Q elimiantion search} if (R in (comboset[yn2] * Comboset[yn4]) ){search for common digit to both, and active in both} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn2,yn3]) <> []) and (Peer[q] * ((Combosets[xn,yn]+Combosets[xn2,yn3])*digitcell[R]) = ((Combosets[xn,yn] + Combosets[xn2,yn3])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn,yn] + combosets[xn2,yn3]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set C for digits exclusivly to C their peers cannot contain r} if (R in (Comboset[yn2] - z1))//Comboset[yn4]) ) and (peer[q] * Digitcell[R] * Combosets[xn,yn] = combosets[xn,yn] * Digitcell[R]) and ([q] * combosets[xn,yn] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set A for digits exclusivly to A their peers cannot contain r} if (R in (Comboset[yn4] - z1))//Comboset[yn2]) ) and (peer[q] * Digitcell[R] * Combosets[xn2,yn3] = combosets[xn2,yn3]* Digitcell[R]) and ([q] * combosets[xn2,yn3] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; end; {R/Q elimiantion search} end; {doubly linked} if ( popcnt(dword(z2)) >1 ) {doubly linked rules } {B & C} then begin active:=true; {set B&C is now a locked set removal peers cells visable to all copies of each digit in both sets} for R in comboset[yn2] + comboset[yn6] do for q in ([0..80] * digitcell[R]) do begin {R/Q elimiantion search} if (R in (comboset[yn2] * Comboset[yn6]) ){search for common digit to both, and active in both} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn3,yn5]) <> []) and (Peer[q] * ((Combosets[xn,yn]+Combosets[xn3,yn5])*digitcell[R]) = ((Combosets[xn,yn] + Combosets[xn3,yn5])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn,yn] + combosets[xn3,yn5]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set C for digits exclusivly to C their peers cannot contain r} if (R in (Comboset[yn2] - z2))//Comboset[yn6]) ) and (peer[q] * Digitcell[R] * Combosets[xn,yn] = combosets[xn,yn] * Digitcell[R]) and ([q] * combosets[xn,yn] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set B for digits exclusivly to B their peers cannot contain r} if (R in (Comboset[yn6] - z2))// Comboset[yn2]) ) and (peer[q] * Digitcell[R] * Combosets[xn3,yn5] = combosets[xn3,yn5]* Digitcell[R]) and ([q] * combosets[xn3,yn5] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; end; {R/Q elimiantion search} end; {doubly linked} {tripply linked rules } {B & A & C are all locked sets} if (( popcnt(dword(z3)) >=1) and(( popcnt(dword(z3+z2+z1)) >=3))) // and(z3 - (z2+z1) <> [] )) {check that the resticted commons between the three sets are all diffrent} then begin active:=true; {set B&C is now a locked set removal peers cells visable to all copies of each digit in all sets} for R in comboset[yn4] + comboset[yn6] +comboset[yn2] do for q in ([0..80] * digitcell[R]) do begin {R/Q elimiantion search} if (R in (comboset[yn4] * Comboset[yn6] * Comboset[yn2]) ){search for common digit to all, and active in all} and ((digitcell[R] * combosets[xn2,yn3]) <> [] ) and ( (Digitcell[R] * combosets[xn3,yn5]) <> []) and ( (Digitcell[R] * combosets[xn,yn]) <> []) and (Peer[q] * ((Combosets[xn2,yn3]+Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R]) = ((Combosets[xn2,yn3] + Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn2,yn3] + combosets[xn3,yn5]+combosets[xn,yn]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; if (R in (comboset[yn4] * Comboset[yn6] ) ){search for common digit to ab, and active in ab} and ((digitcell[R] * combosets[xn2,yn3]) <> [] ) and ( (Digitcell[R] * combosets[xn3,yn5]) <> []) and ( (Digitcell[R] * combosets[xn,yn]) = []) {and not in c} and (Peer[q] * ((Combosets[xn2,yn3]+Combosets[xn3,yn5]{+combosets[xn,yn]})*digitcell[R]) = ((Combosets[xn2,yn3] + Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn2,yn3] + combosets[xn3,yn5]{+combosets[xn,yn]}) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; if (R in (comboset[yn2] * Comboset[yn6] ) ){search for common digit to cb, and active in c} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn3,yn5]) <> []) and ( (Digitcell[R] * combosets[xn2,yn3]) = []) {and not in b} and (Peer[q] * (({Combosets[xn2,yn3]+}Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R]) = ((Combosets[xn2,yn3] + Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * ({Combosets[xn2,yn3] +} combosets[xn3,yn5]+combosets[xn,yn]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; if (R in (comboset[yn2] * Comboset[yn4] ) ){search for common digit to ca, and active in ca} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn2,yn3]) <> []) and ( (Digitcell[R] * combosets[xn3,yn5]) = []) {and not in b} and (Peer[q] * ((Combosets[xn2,yn3]+{Combosets[xn3,yn5]+}combosets[xn,yn])*digitcell[R]) = ((Combosets[xn2,yn3] + Combosets[xn3,yn5]+combosets[xn,yn])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn2,yn3] {+ combosets[xn3,yn5]}+combosets[xn,yn]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {belive comboset yn6,yn2 can be replaced with z1,z2,z3} //same as i did for the xz-function. {cells in set A for digits exclusivly to A their peers cannot contain r} if (R in (Comboset[yn4] - (Comboset[yn6]+comboset[yn2])) ) and (peer[q] * Digitcell[R] * Combosets[xn2,yn3] = combosets[xn2,yn3] * Digitcell[R]) and ([q] * combosets[xn2,yn3] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set B for digits exclusivly to B their peers cannot contain r} if (R in (Comboset[yn6] - ( Comboset[yn4]+comboset[yn2]) )) and (peer[q] * Digitcell[R] * Combosets[xn3,yn5] = combosets[xn3,yn5]* Digitcell[R]) and ([q] * combosets[xn3,yn5] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; {cells in set C for digits exclusivly to C their peers cannot contain r} if (R in (Comboset[yn2] - ( Comboset[yn4]+comboset[yn6]) )) and (peer[q] * Digitcell[R] * Combosets[xn,yn] = combosets[xn,yn]* Digitcell[R]) and ([q] * combosets[xn,yn] = []) then begin covered2[R]:=Covered2[R] + [q]; if k =0 then begin techwrite[u,r+9]:= techwrite[u,r+9] + [q]; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; end; {R/Q elimiantion search} end; {tripply linked} if (k= 0) and (techwrite[u,9] <> []) then begin techwrite[u,0]:=techwrite[u,0]+[3]; techwrite[u,1]:=techwrite[u,1]+[6]; techwrite[u,2]:=techwrite[u,2]+comboset[yn2]; techwrite[u,3]:=techwrite[u,3]+Combosets[xn,yn]; techwrite[u,4]:=techwrite[u,4]+comboset[yn4]; techwrite[u,5]:=techwrite[u,5]+combosets[xn2,yn3]; techwrite[u,6]:=techwrite[u,6]+comboset[yn6]; techwrite[u,7]:=techwrite[u,7]+combosets[xn3,yn5]; techwrite[u,8]:=techwrite[u,8]+ z1 + z2; end; if u = 32767 {max array size error code safty exit} then begin if k = 0 then techdisplay(#121,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,20) end; if (k=0) and (techwrite[u,9] <> []) then begin u:=U+1; setlength(techwrite,u+1,20); end; end; {normal eliminations} end; end; if k = 0 then chaindisplay(#121,u); end;{als -xy rule}

ALS-w-wing

Als-W-wing: Show

Code: Select all: {w -wing technique expanded from bivavle cells into als sets} procedure alswwing(k:integer); var q,xn,xn2,yn,yn2,yn3,yn4,yn5,yn6,n,n2,z,x,r,r2,u,alsa,alsb:integer; A3:numberset; z1:nums; lx1: numberset; lx2: numberset; lx3: numberset; lx4: numberset; lx5: numberset; begin alsfinder; //ahsfinder; if k=0 then begin u:=0; setlength(techwrite,u+1,21); end; for alsA:= low(als) to (high(als)-1) do {als A} if (als[alsA,1]+1 = als[alsA,2]) {cell = digit +1} then for ALSB:= alsa+1 to high(als) do {Als B} if (als[alsb,1]+1 = als[alsb,2] ) {cell = digit +1} and (popcnt(dword((comboset2[als[alsa,4]]*Comboset2[als[alsb,4]]) ) ) >1 ) {set a & B must share 2 digits} and (combosets[als[alsa,0],als[alsa,3]] - combosets[als[alsb,0],als[alsb,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[alsb,0],als[alsb,3]] - combosets[als[alsa,0],als[alsa,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als[alsa,0]; xn2:=als[alsb,0]; yn:=als[alsA,3]; yn3:=als[alsB,3]; yn2:=als[alsa,4]; yn4:= als[alsb,4]; for N in (comboset[yn4] * comboset[yn2]) do if (digitcell[n] *( combosets[xn,yn] * combosets[xn2,yn3]) = []){sectors cannot have overlapping shared linked digit} then begin lx1:=[0..80]; lx2:=[0..80]; for x in (digitcell[n] * combosets[xn,yn]) do lx1:=lx1 * peer[x]; for x in (digitcell[n] * combosets[xn2,yn3]) do lx2:=lx2 * peer[x]; for yn5 in [0..26] do if (Digitrcb[yn5,n] <> [] ) and (Sec[yn5,n] < 7) and ( (digitrcb[yn5,n] * lx1) + (digitrcb[yn5,n] * lx2 ) = digitrcb[yn5,n] ) // and (lx1 * lx2 <> []) { not as simple as a 1 direction elimination} and (digitrcb[yn5,n] * (digitcell[n] * (combosets[xn,yn] + combosets[xn2,yn3])) = [] ) { active N sets cannot overlap the strong link} and (lx2 * digitrcb[yn5,n] <> []) {peers cant be blank} and ( lx1 * digitrcb[yn5,n] <> []) {peers cant be blank} then begin if k=0 then begin techwrite[u,0]:= comboset[yn2]; techwrite[u,10]:= comboset[yn4]; techwrite[u,11]:= (combosets[xn,yn] ) ; techwrite[u,12]:=(combosets[xn2,yn3] ); techwrite[u,13]:=digitrcb[yn5,n] * lx1; techwrite[u,14]:= digitrcb[yn5,n] * lx2; techwrite[u,15]:= [n]; techwrite[u,16]:=[]; techwrite[u,17]:=[0]; end; for R in ((comboset[yn4] * comboset[yn2]) - [n]) do begin lx3:=[0..80]; for x in digitcell[r] * (combosets[xn2,yn3] + combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R] *lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {self contained Ring - mimics als-doubly linked} // - restricted common to A & B that is not N and not in the overlap of sets a & B for R2 in ((comboset[yn4] * comboset[yn2]) - [n]) do if (digitcell[r2] * combosets[xn,yn] * combosets[xn2,yn3] = [] ) {overlaping cells must not contain r} then begin lx3:=[0..80]; for x in digitcell[r2] * (combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (lx3 * digitcell[r2]*combosets[xn2,yn3] = digitcell[r2]*combosets[xn2,yn3] ) and (lx3 <> []) then begin if k=0 then begin techwrite[u,16]:=techwrite[u,16] +[x]; end; for R in comboset[yn2] + comboset[yn4] do for q in ([0..80] * digitcell[R]) do begin {R/Q elimiantion search} if (R in (comboset[yn2] * Comboset[yn4]) ){search for common digit to both, and active in both} and ((digitcell[R] * combosets[xn,yn]) <> [] ) and ( (Digitcell[R] * combosets[xn2,yn3]) <> []) and (Peer[q] * ((Combosets[xn,yn]+Combosets[xn2,yn3])*digitcell[R]) = ((Combosets[xn,yn] + Combosets[xn2,yn3])*digitcell[R])) {makes sure the peer of q can see all the digits} and ([q] * (Combosets[xn,yn] + combosets[xn2,yn3]) = []) {q cannot elimiante from a set cell} then begin covered2[R]:=Covered2[R] + [q]; if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *[q]); end; end; {cells in set A for digits exclusivly to A their peers cannot contain r} if (R in (Comboset[yn2] - Comboset[yn4]) ) and (peer[q] * Digitcell[R] * Combosets[xn,yn] = combosets[xn,yn] * Digitcell[R]) and ([q] * combosets[xn,yn] = []) then begin covered2[R]:=Covered2[R] + [q]; if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *[q]); end; end; {cells in set B for digits exclusivly to B their peers cannot contain r} if (R in (Comboset[yn4] - Comboset[yn2]) ) and (peer[q] * Digitcell[R] * Combosets[xn2,yn3] = combosets[xn2,yn3]* Digitcell[R]) and ([q] * combosets[xn2,yn3] = []) then begin covered2[R]:=Covered2[R] + [q]; if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *[q]); end; end; end; {R/Q elimiantion search} end; end; {self contained doubly linked als-xz thanks to y5 link} For n2 in (comboset[yn4]*comboset[yn2])- [n] do begin lx4:=[0..80]; lx5:=[0..80]; for x in (digitcell[n2] * combosets[xn,yn]) do lx4:=lx4 * peer[x]; for x in (digitcell[n2] * combosets[xn2,yn3]) do lx5:=lx5 * peer[x]; {rings} for yn6 in [0..26] do if (Digitrcb[yn6,n2] <> [] ) and (Sec[yn6,n2] < 7) and ( (digitrcb[yn6,n2] * lx4) + (digitrcb[yn6,n2] * lx5 ) = digitrcb[yn6,n2] ) // and (lx1 * lx2 <> []) { not as simple as a 1 direction elimination} and (digitrcb[yn6,n2] * (digitcell[n2] * (combosets[xn,yn] + combosets[xn2,yn3])) = [] ) { active N sets cannot overlap the strong link} and (lx4 * digitrcb[yn6,n2] <> []) {peers cant be blank} and ( lx5 * digitrcb[yn6,n2] <> []) {peers cant be blank} then begin {regular eliminations} for R in ((comboset[yn4] * comboset[yn2]) - [n2]) do begin lx3:=[0..80]; for x in digitcell[r] * (combosets[xn2,yn3] + combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end;{regular eliminations} end; {regular eliminations} for R in ((comboset[yn4] * comboset[yn2]) - [n]) do begin lx3:=[0..80]; for x in digitcell[r] * (combosets[xn2,yn3] + combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end;{regular eliminations} end; {all digits common to a & b are locked to a & b remove peers } for R in ((comboset[yn4] * comboset[yn2]) ) do begin lx3:=[0..80] - ((digitrcb[yn6,n2]+ digitrcb[yn5,n]) + (combosets[xn2,yn3] + combosets[xn,yn]) ); for x in digitcell[r] * (combosets[xn2,yn3] + combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end;{peers of set a & B common digits eliminations} end; {B non n,n2 digits are locked to set b } for R in (comboset[yn4] -[n,n2] ) do begin lx3:=[0..80] - (combosets[xn,yn] + combosets[xn2,yn3]); for x in digitcell[r] * (combosets[xn2,yn3]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {A non n,n2 digits are locked to set A } for R in (comboset[yn2] -[n,n2] ) do begin lx3:=[0..80] - (combosets[xn,yn] + combosets[xn2,yn3]); for x in digitcell[r] * (combosets[xn,yn]) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {eliminates n2 from b + part y6 sector in cells that are peers } For R in [n2] do begin lx3:= [0..80] - (combosets[xn,yn] + combosets[xn2,yn3] + (digitrcb[yn6,n2])); for x in digitcell[r] * (combosets[xn2,yn3] + (lx5 * digitrcb[yn6,n2])) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] +(digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {eliminates n2 from A + part of y6 sector cells that are peers } For R in [n2] do begin lx3:= [0..80] - (combosets[xn,yn] + combosets[xn2,yn3] + (digitrcb[yn6,n2])); for x in digitcell[r] * (combosets[xn,yn] + (lx4 * digitrcb[yn6,n2])) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {eliminates n from b + part y5 sector in cells that are peers } For R in [n] do begin lx3:= [0..80] - (combosets[xn,yn] + combosets[xn2,yn3] + (digitrcb[yn5,n])); for x in digitcell[r] * (combosets[xn2,yn3] + (lx2 * digitrcb[yn5,n])) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] + (digitcell[R]*lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; {eliminates n from A + part of y5 sector cells that are peers } For R in [n] do begin lx3:= [0..80] - (combosets[xn,yn] + combosets[xn2,yn3] + (digitrcb[yn5,n])); for x in digitcell[r] * (combosets[xn,yn] + (lx1 * digitrcb[yn5,n])) do lx3:=lx3 * peer[x]; if (digitcell[R] * lx3 <> []) and (lx3 <> [0..80]) then begin active:=true; covered2[r]:=covered2[r] +(digitcell[R]* lx3); if k=0 then begin techwrite[u,r]:=techwrite[u,r] +(digitcell[R] *lx3); end; end; end; if k=0 then begin techwrite[u,0]:= comboset[yn2]; techwrite[u,10]:= comboset[yn4]; techwrite[u,11]:= (combosets[xn,yn] ) ; techwrite[u,12]:=(combosets[xn2,yn3] ); techwrite[u,13]:=digitrcb[yn5,n] * lx1; techwrite[u,14]:= digitrcb[yn5,n] * lx2; techwrite[u,15]:= [n]; techwrite[u,19]:= [n2]; techwrite[u,17]:=[0,1]; techwrite[u,18]:=digitrcb[yn6,n2] * lx4; techwrite[u,20]:=digitrcb[yn6,n2] * lx5; end; if (k = 0) and ((techwrite[u,1] <> []) or (techwrite[u,2] <> []) or (techwrite[u,3] <> [])or (techwrite[u,4] <> [])or (techwrite[u,5] <> [])or (techwrite[u,6] <> [])or (techwrite[u,7] <> [])or (techwrite[u,8] <> [])or (techwrite[u,9] <> [])) then begin u:=u+1; setlength(techwrite,u+1,21); end; end; {yn6} end; {n2 restictions check} if (k = 0) and ((techwrite[u,1] <> []) or (techwrite[u,2] <> []) or (techwrite[u,3] <> [])or (techwrite[u,4] <> [])or (techwrite[u,5] <> [])or (techwrite[u,6] <> [])or (techwrite[u,7] <> [])or (techwrite[u,8] <> [])or (techwrite[u,9] <> [])) then begin u:=u+1; setlength(techwrite,u+1,21); end; end; end; {y5 N directional search}; end; { completed a & b set search} if k = 0 then techdisplay(#23,u); end; {als-w-wing}

AlS-Swing

ALS- S-Wing: Show

Code: Select all: {Swing expaned so the bivavle is an almost locked set} Procedure alsSwing(K:integer); var q,xn,xn5,j,j2,xn2,yn,yn2,yn3,yn4,yn5,yn6,n,n2,z,z2,x,r,r2,g,count,count2,alsa:integer; A3:numberset; z1:nums; lx1: numberset; lx2: numberset; lx3: numberset; lx4: numberset; lx5: numberset; begin alsfinder; //ahsfinder; if k=0 then begin g:=0; setlength(techwrite,g+1,16); end; for alsA:= low(als) to (high(als)) do {als A} if (als[alsA,1]+1 = als[alsA,2]) {cell = digit +1} then begin xn5:=als[alsa,0]; yn5:=als[alsA,3]; yn4:= als[alsa,4]; for n in (comboset[yn4] ) do for n2 in (comboset[yn4] - [n]) do begin lx1:=[0..80]; for x in (digitcell[n] * combosets[xn5,yn5]) do lx1:=lx1 * peer[x]; lx2:=[0..80]; for x in (digitcell[n2] * combosets[xn5,yn5]) do lx2:=lx2 * peer[x]; for J in [0..26] do if (digitrcb[j,n] <> []) and ((digitcell[n]*combosets[xn5,yn5]) * digitrcb[j,n]=(digitcell[n]*combosets[xn5,yn5])) then for yn in peerrcb[j] do if (digitrcb[yn,n] <> []) and not ((digitcell[n]*combosets[xn5,yn5])* digitrcb[yn,n]= (digitcell[n]*combosets[xn5,yn5])) and (digitrcb[yn,n] * digitrcb[j,n] <> []) and ( (Digitrcb[yn,n] * digitrcb[j,n]) = ( lx1 * digitrcb[yn,n] ) ) then for z in peerrcb[yn] do if (digitrcb[z,n] <> [] ) and not ((digitcell[n]* combosets[xn5,yn5]) * digitrcb[z,n]= (digitcell[n]*combosets[xn5,yn5])) and (digitrcb[z,n] * digitrcb[yn,n] <> []) and ((digitrcb[z,n] * digitrcb[yn,n]) + (digitrcb[yn,n] * digitrcb[j,n] ) = digitrcb[yn,n]) then for J2 in ([0..26]) do if (digitrcb[j2,n2] <> []) and ((digitcell[n2]*combosets[xn5,yn5]) * digitrcb[j2,n2]=(digitcell[n2]*combosets[xn5,yn5])) then for yn2 in peerrcb[j2] - [yn] do if (digitrcb[yn2,n2] <> []) and not ( (digitcell[n2] * combosets[xn5,yn5]) * digitrcb[yn2,n2]=(digitcell[n2] * combosets[xn5,yn5])) and (digitrcb[yn2,n2] * digitrcb[j2,n2] <> []) and ( (Digitrcb[yn2,n2] * digitrcb[j2,n2]) = ( lx2 * digitrcb[yn2,n2] ) ) then for z2 in (peerrcb[z] * peerrcb[yn2]) do if (digitrcb[z2,n2] <> [] ) and not ((digitcell[n2]*combosets[xn5,yn5]) * digitrcb[z2,n2]=(digitcell[n2]*combosets[xn5,yn5])) and (digitrcb[z2,n2] * digitrcb[yn2,n2] <> []) and ((digitrcb[z2,n2] * digitrcb[yn2,n2]) + (digitrcb[yn2,n2] * digitrcb[j2,n2] ) = digitrcb[yn2,n2]) then if ( (digitrcb[yn,n2] * digitrcb[z2,n2] ) = (digitrcb[yn,n2] * digitrcb[z2,n2]) ) and ( (digitrcb[yn2,n] * digitrcb[z,n] ) = (digitrcb[yn2,n] * digitrcb[z,n]) ) and (( digitrcb[yn,n] * digitrcb[z,n] ) * (digitrcb[yn2,n2] * digitrcb[z2,n2] ) = []) then begin Count:=0; count2:=0; for q in (digitrcb[yn,n] * digitrcb[z,n]) do inc(count); for q in (digitrcb[yn2,n2] * digitrcb[z2,n2]) do inc(count2); if ((count in [1]) and ((digitrcb[yn,n2] * Digitrcb[z,n2]) * (digitrcb[yn,n] * Digitrcb[z,n]) <> []) ) or ((count2 in [1]) and ((digitrcb[yn2,n] * Digitrcb[z2,n]) * (digitrcb[yn2,n2] * Digitrcb[z2,n2]) <> [])) then begin active:=true; if k = 0 then begin techwrite[g,0]:=combosets[xn5,yn5]; techwrite[g,10]:= [n]; techwrite[g,11]:=[n2]; techwrite[g,12]:= digitrcb[yn,n] * digitrcb[z,n]; techwrite[g,13]:= digitrcb[yn,n] - (digitrcb[yn,n] * digitrcb[z,n]); techwrite[g,14]:= (digitrcb[yn2,n2] * digitrcb[z2,n2]); techwrite[g,15]:= digitrcb[yn2,n2] - (digitrcb[yn2,n2] * digitrcb[z2,n2]); end; if (count in [1]) and ((digitrcb[yn,n2] * Digitrcb[z,n2]) * (digitrcb[yn,n] * Digitrcb[z,n]) <> [] ) then for q in ( digitrcb[yn,n] * digitrcb[z,n]) do if (peer[q] * (digitrcb[yn2,n2] * digitrcb[z2,n2]) = (digitrcb[yn2,n2] * digitrcb[z2,n2])) then begin covered2[n2]:= covered2[n2] +(digitrcb[yn,n] * Digitrcb[z,n]); if k = 0 then techwrite[g,n2]:=(digitrcb[yn,n] * Digitrcb[z,n]); end; if (count2 in [1]) and ((digitrcb[yn2,n] * Digitrcb[z2,n]) * (digitrcb[yn2,n2] * Digitrcb[z2,n2]) <> []) then for q in ( digitrcb[yn2,n2] * digitrcb[z2,n2]) do if (peer[q] * (digitrcb[yn,n] * digitrcb[z,n]) = (digitrcb[yn,n] * digitrcb[z,n])) then begin covered2[n]:= covered2[n] +(digitrcb[yn2,n2] * Digitrcb[z2,n2]); if k = 0 then techwrite[g,n]:=(digitrcb[yn2,n2] * Digitrcb[z2,n2]); end; if (k = 0) and (techwrite[g,n] + techwrite[g,n2] <> []) then begin g:=g+1; setlength(techwrite,g+1,16); end; end; end; end; end; if k= 0 then techdisplay(#4,g); end;{alsswing}

als-m-wing

ALS-M-Wing: Show

Code: Select all: {All most locket set version of for the M - wing changing the bivavles to als sets} procedure alsMwing(k:integer); var q,xn,xn5,xn2,yn,yn2,yn3,yn4,yn5,yn6,n,n2,z,x,r,r2,g,alsa:integer; A3:numberset; z1:nums; lx1: numberset; lx2: numberset; lx3: numberset; lx4: numberset; lx5: numberset; begin alsfinder; //ahsfinder; if k=0 then begin g:=0; setlength(techwrite,g+1,16); end; for alsA:= low(als) to (high(als)) do {als A} if (als[alsA,1]+1 = als[alsA,2]) {cell = digit +1} then begin xn5:=als[alsa,0]; yn5:=als[alsA,3]; yn4:= als[alsa,4]; for xn2 in ComboSubset[yn4] do if (popcnt(dword(((comboset[yn4]*pm[xn2])))) >1) and (peer[xn2] * combosets[xn5,yn5] = []) then for n in (comboset[yn4]*pm[xn2]) do begin lx1:=[0..80]; for x in (digitcell[n] * combosets[xn5,yn5]) do lx1:=lx1 * peer[x]; for yn in [0..26] do if (lx1 * digitrcb[yn,n] <> [] ) and (lx1 * digitrcb[yn,n] <> Digitrcb[yn,n] ) then {row,box,col} if (digitrcb[yn,n] <> [] ) and (sec[yn,n] <5) and(digitrcb[yn,n] * ( (lx1*digitrcb[yn,n]) + [xn2] ) = digitrcb[yn,n] ) then begin for n2 in ((comboset[yn4]*pm[xn2]) - [n]) do begin lx2:=[0..80]; for x in (digitcell[n2] * combosets[xn5,yn5]) do lx2:=lx2 * peer[x]; {row} for yn2 in ((peerRCB[Rsec[rx[xn2]]] + peerrcb[Csec[Cy[xn2]]] + peerrcb[bsec[bxy[xn2]]]) ) do begin if (digitrcb[yn2,n2] <> [] ) and (sec[yn2,n2] <6) and ((digitrcb[yn2,n2] * peer[xn2]) + [xn2] = digitrcb[yn2,n2] ) then begin active:=true; for z:= 0 to 80 do if (peer[z] * ((digitcell[n2]*combosets[xn5,yn5]) + ( digitrcb[yn2,n2] - [xn2]) ) = ((digitcell[n2]*combosets[xn5,yn5]) +( digitrcb[yn2,n2] - [xn2]) ) ) and (z in digitcell[n2]) then begin covered2[n2]:=covered2[n2] + [z]; if k = 0 then techwrite[g,n2]:=techwrite[g,n2] + [z]; end; if ((digitrcb[yn2,n2] * lx2) = (digitrcb[yn2,n2] -[xn2]) ) {ring code} then begin for z:= 0 to 80 do begin if (peer[z] * ([xn2] + (digitrcb[yn,n] -(digitcell[n]*combosets[xn5,yn5])) )= ([xn2] + (digitrcb[yn,n] - (digitcell[n]*combosets[xn5,yn5])) )) and (z in digitcell[n]) then begin covered2[n]:=covered2[n] + [z]; if k = 0 then techwrite[g,n]:=techwrite[g,n] + [z]; end; For R in (comboset[yn4] -[n,n2]) do if (peer[z] * (Digitcell[R]*Combosets[xn5,yn5]) = digitcell[r]*Combosets[xn5,yn5]) and (R in pm[z]) then begin covered2[r]:=covered2[r] + [z]; if k = 0 then techwrite[g,r]:=techwrite[g,r] + [z]; end; end; covered[xn2]:= covered[xn2] + (pm[xn2] - [n,n2] ); {xn2 becomes a locked pair} if k= 0 then for z in (pm[xn2] - [n,n2]) do techwrite[g,z]:=techwrite[g,z]+[xn2]; end; {rings} end; if k =0 then begin techwrite[g,0]:= [n]; techwrite[g,10]:= [n2]; techwrite[g,11]:=combosets[xn5,yn5]; techwrite[g,12]:=[xn2]; techwrite[g,13]:= (digitrcb[yn,n] * lx1); techwrite[g,14]:= (digitrcb[yn2,n2] * peer[xn2]); end; if (k =0) and ( (techwrite[g,n2] <> []) or (techwrite[g,n] <> []) ) then begin g:=g+1; setlength(techwrite,g+1,15); end; end;{end row,box,col} end; {end #'s for rows,cols,boxs} end; {end row,col,box} end; end; {set A} if k = 0 then techdisplay(#1,g); end;{alsMwing}

AALS-2RC-rule: Show

Code: Select all: {Almost Almost locked set 2 RC rule} procedure Aals2RC(k:integer); {so far this is 100,000% faster} var q,xn,xn2,xn3,yn,yn2,yn3,yn4,YN5,YN6,n,z,x,act3,r,u,alsa,alsb,alsc:integer; A3:numberset; z1:nums; Z2:nums; z3:nums; lx1: rcbpeer; lx2: rcbpeer; lx3: rcbpeer; begin alsfinder; //ahsfinder; if k=0 then begin u:=0; setlength(techwrite,u+1,20); end; for alsA:= low(als) to (high(als)) do {als C} if (als[alsA,1]+2 = als[alsA,2]) {cell = digit +2} then for ALSB:= low(als) to high(als)-1 do {Als A} if (als[alsb,1]+1 = als[alsb,2] ) {cell = digit +1} and (popcnt(dword((comboset2[als[alsa,4]]*Comboset2[als[alsb,4]]) ) ) >=1 ) {set a & C must share 1 digits} and (combosets[als[alsa,0],als[alsa,3]] - combosets[als[alsb,0],als[alsb,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[alsb,0],als[alsb,3]] - combosets[als[alsa,0],als[alsa,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin z1:=[]; xn:=als[alsa,0]; xn2:=als[alsb,0]; yn:=als[alsA,3]; yn3:=als[alsB,3]; yn2:=als[alsa,4]; yn4:= als[alsb,4]; {restricted common chcek A & C} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if popcnt(dword(z1)) >=1 {* single restricted common advance to adding 3rd sector} then for alsC:= alsb+1 to (high(als)) do {als b} if (als[alsC,1]+1 = als[alsC,2]) {cell = digit +1} and (popcnt(dword(( comboset2[yn2]*Comboset2[als[alsC,4]] ) ) ) >=1 ) {checks that set B and set C share at least 1 digits} and (combosets[xn,yn] - combosets[als[alsC,0],ALS[ALSC,3]] <> [] ) { sectors B & C can over lap, however cells cannot overlap in full} and ( combosets[als[alsC,0],ALS[ALSC,3]] - combosets[xn,yn] <> [] ) then begin z2:=[]; z3:=[]; xn3:=als[alsc,0]; yn5:=als[alsc,3]; yn6:= als[alsc,4]; {restricted common chcek B & C} for z in (comboset[yn6] * comboset[yn2] ) do if ((Digitcell[z] * combosets[xn3,yn5]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn,yn] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn,yn]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn,yn] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn3,yn5] * combosets[xn,yn]) = []) {resticted commons cannot be found in an overlap cell} //and (digitcell[z] * Combosets[xn2,yn3] - (combosets[xn3,yn5]+combosets[xn,yn]) = []){resticted commons cannot be found in an overlap cell shared by the 2nd set} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn3,yn5]+combosets[xn,yn]) *digitcell[z] do {combine common cells in both C&B for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z2:=z2 + [z]; {saves the resticted commons} end; {restricted common chcek B & A} for z in (comboset[yn6] * comboset[yn4] ) do if ((Digitcell[z] * combosets[xn3,yn5]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn2,yn3] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - ({(digitcell[z]*COmbosets[xn2,yn3]) + }(combosets[xn2,yn3] * combosets[xn3,yn5])) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn3,yn5] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} //and (digitcell[z] * Combosets[xn2,yn3] - (combosets[xn3,yn5]+combosets[xn,yn]) = []){resticted commons cannot be found in an overlap cell shared by the 2nd set} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn3,yn5]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both C&B for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z3:=z3 + [z]; {saves the resticted commons} end; if (( popcnt(dword(z2)) >1 ) and ( popcnt(dword(z1)) >1 )){if the resticted common on a set is more then 1 its an double linked als-xz rule} or (( popcnt(dword(z2)) =1 ) and ( popcnt(dword(z1)) =1 ) and (z1 - z2 <> [] ) and (Z2 - z1 <> [])) {checks that both sectors have at least 1 RC and those numbers are diffrent } or (( popcnt(dword(z2)) =1 ) and ( popcnt(dword(z1)) >1 )) or (( popcnt(dword(z2)) >1 ) and ( popcnt(dword(z1)) =1 )) // and ((comboset[yn4] * Comboset[yn6] - (z2+z1) ) <> []) then begin {Eliminations A & B peer of z} if (popcnt(dword( (comboset2[yn4]*Comboset2[yn6]*comboset2[yn2]) ) ) >=1 ) then for R in ((comboset[yn6] * comboset[yn4] * comboset[yn2] ) ) do {search for common digit to both A & B &C, thats not the RC of z1,z2,z3} if ((Digitcell[R]* combosets[xn2,yn3] )<> [] ) and(( Digitcell[R] * combosets[xn3,yn5])<> []) and ((Digitcell[R] * combosets[xn,yn] <> [])) and ((z1-z2) - [r] <> []) and ((z2-z1) - [r] <> []) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in ((combosets[xn3,yn5] + combosets[xn2,yn3] + combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3 - (combosets[xn,yn] + combosets[xn2,yn3] + combosets[xn3,yn5]); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; if (popcnt(dword( (z1+z2) ) ) >=4 ) {double linked restriction of links} then begin for R in ((comboset[yn6] * comboset[yn2] *z2 ) ) do {search for common digit to both C & B thats in Z2} if ((Digitcell[R]* combosets[xn,yn] )<> [] ) and(( Digitcell[R] * combosets[xn3,yn5])<> []) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in ((combosets[xn3,yn5] {+ combosets[xn2,yn3]} + combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3- (combosets[xn,yn] {+ combosets[xn2,yn3] }+ combosets[xn3,yn5]); if (a3 <> (([0..80] * digitcell[R]))) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; for R in ((comboset[yn2] * comboset[yn4] *z1 ) ) do {search for common digit to both C & A thats in Z1} if ((Digitcell[R]* combosets[xn,yn] )<> [] ) and(( Digitcell[R] * combosets[xn2,yn3])<> []) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in (({combosets[xn3,yn5] +} combosets[xn2,yn3] + combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3 - (combosets[xn,yn] + combosets[xn2,yn3] {+ combosets[xn3,yn5]}); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; for R in ((comboset[yn2] ) -(z1+z2) ) do {search for digit in A thats left from Z1+z2} if ((Digitcell[R]* combosets[xn,yn] )<> [] ) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in (({combosets[xn3,yn5] + combosets[xn2,yn3] +} combosets[xn,yn]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3- (combosets[xn,yn] {+ combosets[xn2,yn3] + combosets[xn3,yn5]}); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; for R in ((comboset[yn4] ) -(z1+z2) ) do {search for digit in A thats left from Z1+z2} if ((Digitcell[R]* combosets[xn2,yn3] )<> [] ) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in (({combosets[xn3,yn5] + combosets[xn,yn] +} combosets[xn2,yn3]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3- (combosets[xn2,yn3] {+ combosets[xn2,yn3] + combosets[xn3,yn5]}); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; for R in ((comboset[yn6] ) -(z1+z2) ) do {search for digit in A thats left from Z1+z2} if ((Digitcell[R]* combosets[xn3,yn5] )<> [] ) then begin active:=true; a3:=(([0..80] * digitcell[R]) ); {valid eliminations must contain R and cannot be in the sets a&b} for q in (({combosets[xn2,yn3] + combosets[xn,yn] +} combosets[xn3,yn5]) * digitcell[R] ) do { a combined peer search for R with in the sets, A&b&C} a3:=peer[q] * a3- (combosets[xn3,yn5] {+ combosets[xn2,yn3] + combosets[xn,yn]}); if (a3 <> (([0..80] * digitcell[R]) )) and (a3 <> []) {safty checks} then covered2[R]:=covered2[r] + a3; {elimination trigger} if (k= 0 ) and (a3<> [0..80]) and (a3 <> []) then begin techwrite[u,r+9]:= techwrite[u,r+9] + a3; techwrite[u,9]:=techwrite[u,9]+[R]; end; end; end; if (k= 0) and (techwrite[u,9] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[6]; techwrite[u,2]:=techwrite[u,2]+comboset[yn2]; techwrite[u,3]:=techwrite[u,3]+Combosets[xn,yn]; techwrite[u,4]:=techwrite[u,4]+comboset[yn4]; techwrite[u,5]:=techwrite[u,5]+combosets[xn2,yn3]; techwrite[u,6]:=techwrite[u,6]+comboset[yn6]; techwrite[u,7]:=techwrite[u,7]+combosets[xn3,yn5]; techwrite[u,8]:=techwrite[u,8]+ z1+z2; end; if u = 32767 {max array size error code safty exit} then begin if k = 0 then techdisplay(#25,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,20) //exit; end; if (k=0) and (techwrite[u,9] <> []) then begin u:=U+1; setlength(techwrite,u+1,20); end; end; end; end; if k = 0 then chaindisplay(#25,u); end;{Aals 2RC rule}

N^a ls N^rc rule: Show

Code: Select all: {N*almost locked set N* RC rule } // work in progress procedure NalsNRC(K:integer); {mutual exclusion} type hold = array of integer; Nuse = array of integer; base = array of integer; rcc = array of array of nums; RCDs = array of nums; TRCC = array of nums; usednum= array of nums; used = array of numberset; used2 = array of numberset; cellused=array of numberset; almostlockedset3= array of array of integer; RCSTORE= array of array of nums; var xn,w,p,p2,n,n2,a,m,z,xn2,yn,yn3,yn2,yn4,xn3,yn5,yn6,xn4,q,r,u,b,b2,B3,max,size,f:integer; h:hold; nouse: nuse; step: base; rc:rcc; RCD:RCDs; TRC:TRCC; als3: almostlockedset3; store: RCSTORE; A3:numberset; z1:nums; z2:nums; lx1: rcbpeer; lx2: rcbpeer; use:used; use2:used; usenum : usednum; celluse : cellused; begin alsfinder; //ahsfinder; setlength(als3,high(als)+1); setlength(store,high(als)+1); for a:= high(als) downto 0 do {startin array} begin w:=-1; for p:= high(als) downto 0 do {iteration of peers} if (als[p,1]+1 = als[p,2] ) then if (popcnt(dword((comboset2[als[a,4]]*Comboset2[als[p,4]]) ) ) >=1 ) {set a & B must share >1 digits} and (combosets[als[a,0],als[a,3]] - combosets[als[p,0],als[p,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[p,0],als[p,3]] - combosets[als[a,0],als[a,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als[a,0]; xn2:=als[p,0]; yn:=als[a,3]; yn3:=als[p,3]; yn2:=als[a,4]; yn4:= als[p,4]; z1:=[]; {restricted common chcek} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if ( ( popcnt(dword(z1)) >=1 ) ) then begin w:=w+1; setlength(als3[a],w+1); setlength(store[a],w+1); als3[a,w]:=p; store[a,w]:=z1; end; end; end; if k=1 then begin u:=0; setlength(techwrite,u+1,0); end; for a:= high(als) downto 0 do {startin array} if (high(als3[a]) +1 >= (als[a,2] - als[a,1])) and (als[a,2] - als[a,1] >=1) //and (comboset[als[a,4]] = [1,2,4]) then begin w:=0; setlength(h,w+1); h[w]:=high(als3[a]); setlength(TRC,(w+1)); {set the array size to w} TRC[w]:= []; setlength(usenum,w+1); usenum[w]:=comboset[als[a,4]]; setlength(celluse,w+1); celluse[w]:=combosets[als[a,0],als[a,3]]; setlength(rcd,W+1); rcd[W]:=Comboset[als[a,4]]; setlength(use,(w+1)); {set the array size to w} setlength(use2,(w+1)); {set the array size to w} use[w]:=[0..80] - combosets[als[a,0],als[a,3]]; use2[w]:=[0..80]; size:= (als[a,2] - als[a,1]); h[w]:= high(als3[a]); {keeps track of what array is the next stop used for step W } repeat for p:= h[w] downto 0 do if ((use[w] * combosets[als[als3[a,p],0],als[als3[a,p],3]]) <> []) and (( store[a,p] - TRC[w] <>[]) or (w=1) ) // or (( w< size ) and (popcnt(dword(trc[w]))> size) and (store[a,p]-trc[w] = [])) ) { and ((comboset[als[als3[a,p],4]] = [2,4]) or (comboset[als[als3[a,p],4]] = [1,4])) } then begin h[w]:=h[w]-1; inc(w); setlength(h,w+1); h[w]:=p-1; setlength(step,w+1); step[w]:=p; setlength(usenum,w+1); usenum[w]:=Comboset[als[als3[a,p],4]]; setlength(celluse,w+1); celluse[w]:=combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(rcd,W+1); rcd[W]:=RCD[w-1] * Comboset[als[als3[a,p],4]]; setlength(TRC,(w+1)); {set the array size to w} TRC[w]:= store[a,p]+TRC[w-1]; setlength(use,(w+1)); {set the array size to w} setlength(use2,(w+1)); {set the array size to w} use[w]:= use[w-1] - combosets[als[als3[a,p],0],als[als3[a,p],3]]; use2[w]:= use2[w-1] - combosets[als[als3[a,p],0],als[als3[a,p],3]]; {if (k=1) then begin f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); writexy(2,60,'size :'); write(w,' ',size); end; } //type 1: links = correct number if ((w) = size) and (popcnt(dword(TRC[w] )) >= size ) //and (RCD[w] <> []) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; a3:=[]; a3:= [0..80] - use[w]; z1:=[]; for q:= w downto 1 do for b:= w downto 1 do begin if (popcnt(dword(store[a,step[b]]-z1)) =1) then Z1:=z1 + (store[a,step[b]]); if (popcnt(dword(store[a,step[b]]-rcd[w])) = 1 ) then z1:= z1 + (store[a,step[b]] - (rcd[w])); end; if popcnt(dword(trc[w] -z1 )) = (size - popcnt(dword(z1))) then z1:=z1 + trc[w] ; // eliminates a common digit thats no listed as a RC when RC = number of links} if popcnt(dword(TRC[w])) = size then for b in RCD[w] -( trc[w]) do for q in digitcell[b] do if (peer[q] * (a3 * digitcell[b]) = (a3 * digitcell[b]) ) and (a3 * digitcell[b] <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; // eliminates a common "non" RC when there is more digits then links required if popcnt(dword(TRC[w])) >= size then for b in RCD[w] - z1 do for q in digitcell[b] do if( peer[q] * (a3 * digitcell[b]) = (a3 * digitcell[b]) ) and (a3 * digitcell[b] <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+f+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; // elimination code for locked sets if (popcnt(dword(TRC[w])) >= size*2 ) then begin for r:= w downto 1 do for b in usenum[r] - store[a,step[r]] do for q in (( digitcell[b]) - celluse[r] ) do if ((peer[q] * digitcell[b] * celluse[r]) = digitcell[b] * celluse[r]) and (digitcell[b] * celluse[r] <> [] ) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+f+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; for b in usenum[0] - trc[w] do for q in ((digitcell[b] ) - celluse[0] ) do if ((peer[q] * digitcell[b] * celluse[0]) = digitcell[b] * celluse[0]) and (digitcell[b] * celluse[0] <> [] ) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+f+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; for r:= w downto 1 do for b in usenum[r] * store[a,step[r]] do for q in (([0..80] * digitcell[b] ) - (celluse[r]+celluse[0]) ) do if ((peer[q] * digitcell[b] * (celluse[r]+celluse[0])) = (digitcell[b] * (celluse[r]+celluse[0]))) and (digitcell[b] * (celluse[r]+celluse[0]) <> [] ) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+f+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[w]; techwrite[u,(f+3-1)]:=trc[w]; techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end; // temp removed type 2 for the time being to focus on missing eliminations in type 1} //type 2 eliminates when there is not enough links then required as it locks the first set to empty if they are all false if (popcnt(dword(TRC[w] )) > 1+ size ) and (w = 1 +size) then begin if k = 1 then begin f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; a3:=[]; a3:= [0..80] - use2[w]; z1:=[]; for q:= w downto 1 do for b:= w downto 1 do if popcnt(dword(store[a,step[b]]-z1)) =1 then Z1:=z1 + (store[a,step[b]]); if popcnt(dword(TRC[w])) = 1+size then for b in RCD[w] - trc[w] do for q in [0..80] do if (peer[q] * (a3 * digitcell[b]) = (a3 * digitcell[b]) ) and (a3 * digitcell[b] <> []) and (q in digitcell[b]) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if popcnt(dword(TRC[w])) >= 1+ size then for b in RCD[w] - z1 do for q in [0..80] do if( peer[q] * (a3 * digitcell[b]) = (a3 * digitcell[b]) ) and (a3 * digitcell[b] <> []) and (q in digitcell[b]) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+f+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[w]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end; //type 2 break; end else h[w]:=h[w] -1; if ((h[w] < 0) and (w >0)) or (w = size+1) then begin dec(w); //set the array size to w setlength(h,w+1); setlength(use,(w+1)); setlength(use2,(w+1)); setlength(TRC,(w+1)); setlength(rcd,W+1); setlength(usenum,w+1); setlength(celluse,w+1); end; until (w = 0) and (h[w] < 0) end; chaindisplay(#22,u); end; {n*a-ls n-RC }

by **StrmCkr** » Sat Jan 28, 2017 9:05 pm

x-chains/cycles

X- Chain {x-cycles}: Show

Code: Select all: {x-chain } procedure xchain(K:integer); type xsets = array of array of numberset; steps = array of array of numberset; stepper = array of integer; used2 = array of numberset; hold = array of integer; acts = array of array of integer; acts2 = array of array of integer; acts3 = array of array of integer; var h:hold; xset: xsets; step:steps; phase:stepper; use2: used2; act: acts; act2: acts2; act3: acts3; n,a,b,c,d,e,f,g,j,u,m,r,max:integer; check: boolean; output: text; begin links; setlength(xset,0,0); if k = 1 then begin u:=0; setlength(techwrite,u+1,0); end; b:=-1; for n in [1..9] do for a in [1..5] do for c:= low(linkset[n][a]) to high(linkset[n][a]) do begin b:=b+1; setlength(xset,b+1,10); xset[b]:=linkset[n,a,c]; end; //finds the arrays that are the same data points //finds arrays that use a bivavle as on max:= high(xset); setlength(act2,0,0); setlength(act2,max+1); {writexy(2,60,'max: '); write(high(linkset[1][5]));} for b:= low(xset) to high(xset) do begin g:=0; for e:= low(xset) to high(xset) do if e <> b then begin {same set} {reverse twin } if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] =xset[e][3]) // first and last are the same and (xset[b][1] + xset[b][2] = xset[e][1] + xset[e][2]) // same cells but swapped position then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "on cell" position 2 set 1 and set2 postion 2 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][2] * xset[e][2] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // bi local sets same digit " on" cannot be "off" some where else if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][2] * xset[e][1] <> []) // on cell for same digit cant be off then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "off cell" position 1 set 1 and set 2 postion 1 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][1] * xset[e][1] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; {find bivavle cell twins} if (xset[b][0]+ xset[b][3] = xset[e][0] + xset[e][3]) // digit set the same and (xset[b][1] = xset[b][2])//uses 1 cell and (xset[e][1] = xset[e][2])//uses 1 cell and( xset[e][1] = xset[b][1]) // 1 cell in both sets and( xset[e][2] = xset[b][2])// 1 cell in both sets then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // bivavle digit is "on" postion linking same digit sets cant reuse the ending cell. if (xset[b][1] = xset[b][2]) // first set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[e][0] = xset[e][3]) // 2nd is a single digit and (xset[b][2] * xset[e][2] <> []) // cannot re use the "on" cell from a & b then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // first set is a bi-local 2nd set is a bivavle if (xset[e][1] = xset[e][2]) // 2nd set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[b][0] = xset[b][3]) // 1st is a single digit and (xset[b][1] * xset[e][1] <> []) // cannot re use the "off" cell from then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // first set is a 1 digit- 2nd set is a bivavle if (xset[e][1] = xset[e][2]) // 2nd set uses 1 cell and (xset[b][3] = xset[e][3]) // 2nd set starting digit uses exchange digit and (xset[b][0] = xset[b][3]) // 1st is a single digit and (xset[b][1] * xset[e][1] <> []) // cannot re use the "off" cell from then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; end; end; assign(output,'C:\sudoku\twins.txt'); erase(output); rewrite(output); close(output); // sister tester print info to screen checks to see if the above works { gotoxy(2,60); write(max,' ');} For b:= low(xset) to high(xset) do begin append(output); writeln(output); write(output,'set: ',B,' sister to:'); for g:= low(act2[b]) to high(act2[b]) do begin write(output,act2[b][g],' '); end; close(output); end; // weak-link builder setlength(act,0,0); setlength(act,max+1); //stores the weak-link visible to C for B:= low(xset) to high(xset) do begin g:=-1; For C:= low(xset) to high(xset) do if b <> c then begin check:=True; for e:= low(act2[b]) to high(act2[b]) do if act2[b][e] = C then check:= false; if check then begin //same digit to same digit if (xset[b][0]+xset[b][3] = xset[c][3]) // digit @ link is identical to first and last and (xset[c][3] = xset[c][0]) // 2nd set same digit. and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][2] * xset[c][1] = []) // no overlapping cell and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; end; // end check end;// end c cycle end; // end B cycle assign(output,'C:\sudoku\Aic.txt'); erase(output); rewrite(output); close(output); For b:= low(xset) to high(xset) do begin append(output); writeln(output); //gotoxy(2,61+b); write(output,'set: ',B,' weak-linked to: '); for g:= low(act[b]) to high(act[b]) do begin write(output,act[b][g],' '); end; close(output); end; assign(output,'C:\sudoku\Chain.txt'); erase(output); rewrite(output); close(output); //chain walk For A:= low(xset) to high(xset) do If high(act[A])>-1 then begin setlength(act3,0,0); b:=0; setlength(act3,b+1,max+1); //sets step storing //for e:= 0 to max do act3[b][0]:=-1; // sets the first "0" as -1 to allow code to see it as off act3[b][A]:=A; // saves used nodes for e:= low(act2[a]) to high(act2[A]) DO ACT3[B][act2[a,e]]:=act2[a,e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[a])>-1 then h[b]:=High(act[a]) //sets the link list node count else h[b]:= -1; setlength(phase,b+1); // sets the first node phase[b]:=A; // notes // act2 = twins // act = list of sets // act 3 = working list in the chain walk {append(output); writeln(output); write(output,'start: ',A); write(output,'(',h[b],')'); for e:= low(act3[b]) to high(act3[b]) DO write(output,act3[b][e]);} while (h[b] > -1) do begin if (act[phase[b],h[b]] <> act3[b,act[phase[b],h[b]]]) then begin inc(b); setlength(act3,b+1,max+1); //sets step storing act3[b]:=act3[b-1]; // copies the previous step setlength(phase,b+1); // sets the node phase[b]:=act[phase[b-1],h[b-1]]; act3[b][phase[b]]:=phase[b]; {append(output); write(output,' - ',phase[b]);} if k = 1 then begin F:=((b+1)*4); setlength(techwrite[u],0); setlength(techwrite[u],f+13); end; for e:= low(act2[phase[b]]) to high(act2[phase[b]]) DO ACT3[B][act2[phase[b],e]]:=act2[phase[b],e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[phase[b]])>-1 then h[b]:=High(act[phase[b]]) //sets the link list node count else h[b]:=-1; // eliminations //start and end same digit & peers of each other if (xset[a][8] * xset[phase[b]][9] <> []) and (xset[a][0] = xset[phase[b]][3]) then begin for n in (xset[a][0] * xset[phase[b]][3]) do if (xset[a,8] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,8] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,8] * xset[phase[b],9]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,8] * xset[phase[b],9]) do write(output,e,' '); write(output,']');} end; end; // A) start and end diffrent digit and visible to all copies of canddites used if (xset[phase[b]][3] * xset[a][6] = xset[phase[b]][3]) // is in the exchange cells and (xset[phase[b]][9] * xset[a][1] = xset[a][1])// sees all the digits and (xset[a][6] <> [0]) // is not a grouped digit ! and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[phase[b]][3]) do if (xset[a,1] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,1] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,1] * xset[phase[b],9]); {append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,1] * xset[phase[b],9]) do write(output,e,' '); write(output,']'); } end; end; // B) start and end diffrent digit and visible to all copies of canddites used if (xset[A][0] * xset[phase[b]][7] = xset[a][0]) // is in the exchange cells and (xset[A][8] * xset[phase[b]][2] = xset[phase[b]][2])// sees all the digits and (xset[phase[b]][7] <> [0]) // is not a grouped digit ! and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[A][0]) do if (xset[phase[B],2] * xset[A,8]) <> [] then begin covered2[n]:=covered2[n] + (xset[phase[B],2] * xset[A,8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[B],2] * xset[A,8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[phase[B],2] * xset[A,8]) do write(output,e,' '); write(output,']');} end; end; //loop end is a bivavle and start has its ending digit if ((xset[a][0] = xset[phase[b]][3]) and (xset[phase[b]][1] = xset[phase[b]][2]) //is a bivavle and (xset[phase[b]][9] * xset[a][1] = xset[a][1])) // all of b sees As cells //loop start is a bivavle and end has its starting digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][1] = xset[a][2]) //is a bivavle and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) // start and end are same digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) then begin For G:= 0 to b do for e:= 0 to b do begin // digits are the same for n in (xset[phase[G]][3]* xset[phase[e]][0]) do if ((xset[phase[g]][9]*xset[phase[e]][8]) <> []) then begin covered2[n]:= covered2[n] + (xset[phase[g]][9]*xset[phase[e]][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[g]][9]*xset[phase[e]][8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for j in (xset[phase[g]][9] * xset[phase[e]][8]) do write(output,j,' '); write(output,']');} end; // digits swap in cell cell becomes locked to the exchange digits //2nd and first if (xset[phase[g]][2] = xset[phase[e]][1]) and (xset[phase[g]][7] * xset[phase[e]][0] = xset[phase[e]][0]) and (xset[phase[e]][6] * xset[phase[g]][3] = xset[phase[g]][3]) then begin for J in (xset[phase[g]][2]* xset[phase[e]][1]) do if ((pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][3] + xset[phase[e]][0]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; // digits swap in cell cell becomes locked to the exchange digits // first and 2 if (xset[phase[g]][1] = xset[phase[e]][2]) and (xset[phase[g]][6] * xset[phase[e]][3] = xset[phase[e]][3]) and (xset[phase[e]][7] * xset[phase[g]][0] = xset[phase[g]][0]) then begin for J in (xset[phase[g]][1]* xset[phase[e]][2]) do if ((pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][0] + xset[phase[e]][3]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; end; end; // loop elimination code. // loop end and start land on same cell. <canabalistic> if (xset[a][1] = xset[phase[b]][2]) // first and last cell overlap and (xset[a][0] = xset[phase[b]][3]) // first and last digit is the same and (xset[phase[b]][7] <> [0]) // exchange is on and (xset[a][6] <> [0]) // exchange is on then begin for j in xset[a][1] do begin active:=true; covered[j]:=covered[j] + (pm[j] - xset[a][0]); if k = 1 then for n in (pm[j] - (xset[a][0])) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; for n in xset[a][0] do begin covered2[n]:=covered2[n] + (xset[a][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] + (xset[a][8]); end end; end; //chain display saving trigger if k = 1 then if ((techwrite[u][1+f+3] + techwrite[u][2+f+3] + techwrite[u][3+f+3] + techwrite[u][4+f+3] + techwrite[u][5+f+3] + techwrite[u][6+f+3] + techwrite[u][7+f+3] + techwrite[u][8+f+3] + techwrite[u][9+f+3] )<> [] ) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[b]; for e:= 0 to b do begin techwrite[u,(e*4)+2]:=xset[phase[e],0]; techwrite[u,(e*4)+3]:=xset[phase[e],1]; techwrite[u,(e*4)+4]:=xset[phase[e],2]; techwrite[u,(e*4)+5]:=xset[phase[e],3]; end; if u = 32767 then begin // chaindisplay(#26,u); setlength(techwrite,0,0); u:=0; end; u:=u+1; setlength(techwrite,u+1); setlength(techwrite[u],f+15); end; //saving chain display end else begin dec(h[b]); repeat if (h[b] < 0) and (b > 0) then begin { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: ');} dec(b); {for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; // back tracking if the while h[b] > -1 condition triggers repeat if (h[b] < 0) and (b > 0) then begin // eliminations { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: '); } dec(b); { for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; { close(output);} end; // chain walk if k = 1 then chaindisplay(#24,u); end; {x-chain}

XY-Chain: Show

Code: Select all: {XY chain} procedure XYchain(K:integer); type xsets = array of array of numberset; steps = array of array of numberset; stepper = array of integer; used2 = array of numberset; hold = array of integer; acts = array of array of integer; acts2 = array of array of integer; acts3 = array of array of integer; var h:hold; xset: xsets; step:steps; phase:stepper; use2: used2; act: acts; act2: acts2; act3: acts3; n,a,b,c,d,e,f,g,j,u,m,r,max:integer; check: boolean; output: text; begin links; setlength(xset,0,0); if k = 1 then begin u:=0; setlength(techwrite,u+1,0); end; b:=-1; for n in [1..9] do for a in [0..0] do for c:= low(linkset[n][a]) to high(linkset[n][a]) do begin b:=b+1; setlength(xset,b+1,10); xset[b]:=linkset[n,a,c]; end; //finds the arrays that are the same data points //finds arrays that use a bivavle as on max:= high(xset); setlength(act2,0,0); setlength(act2,max+1); {writexy(2,60,'max: '); write(high(linkset[1][5]));} for b:= low(xset) to high(xset) do begin g:=0; for e:= low(xset) to high(xset) do if e <> b then begin {same set} {reverse twin } if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] =xset[e][3]) // first and last are the same and (xset[b][1] + xset[b][2] = xset[e][1] + xset[e][2]) // same cells but swapped position then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "on cell" position 2 set 1 and set2 postion 2 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][2] * xset[e][2] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "off cell" position 1 set 1 and set 2 postion 1 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][1] * xset[e][1] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; {find bivavle cell twins} if (xset[b][0]+ xset[b][3] = xset[e][0] + xset[e][3]) // digit set the same and (xset[b][1] = xset[b][2])//uses 1 cell and (xset[e][1] = xset[e][2])//uses 1 cell and( xset[e][1] = xset[b][1]) // 1 cell in both sets and( xset[e][2] = xset[b][2])// 1 cell in both sets then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // bivavle digit is "on" postion linking same digit sets cant reuse the ending cell. if (xset[b][1] = xset[b][2]) // first set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[e][0] = xset[e][3]) // 2nd is a single digit and (xset[b][2] * xset[e][2] <> []) // cannot re use the "on" cell from a & b then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // first set is a bi-local 2nd set is a bivavle if (xset[e][1] = xset[e][2]) // 2nd set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[b][0] = xset[b][3]) // 1st is a single digit and (xset[b][1] * xset[e][1] <> []) // cannot re use the "off" cell from then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; end; end; assign(output,'C:\sudoku\twins.txt'); erase(output); rewrite(output); close(output); // sister tester print info to screen checks to see if the above works { gotoxy(2,60); write(max,' ');} For b:= low(xset) to high(xset) do begin append(output); writeln(output); write(output,'set: ',B,' sister to:'); for g:= low(act2[b]) to high(act2[b]) do begin write(output,act2[b][g],' '); end; close(output); end; // weak-link builder setlength(act,0,0); setlength(act,max+1); //stores the weak-link visible to C for B:= low(xset) to high(xset) do begin g:=-1; For C:= low(xset) to high(xset) do if b <> c then begin check:=True; for e:= low(act2[b]) to high(act2[b]) do if act2[b][e] = C then check:= false; if check then begin //same digit to same digit if (xset[b][0]+xset[b][3] = xset[c][3]) // digit @ link is identical to first and last and (xset[c][3] = xset[c][0]) // 2nd set same digit. and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][2] * xset[c][1] = []) // no overlapping cell and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //digit exchange @ strong link if (xset[b][3] <> xset[c][0]) // last and next digit are the diffrent and (xset[b][2] = xset[c][1]) // last cell and next cell are the same and (xset[b][7] * xset[c][0] = xset[c][0]) // overlap exchange is true and (xset[c][6] * xset[b][3] = xset[b][3]) // overlap exchange is true and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[c][1] * xset[c][2] = []) // cant be a bivavle then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //digit exchange @ bivavle if (xset[b][3] = xset[c][0]) // last and next digit are the same and (xset[c][0] <> xset[c][3]) // last and next digit in new link are diffrent and (xset[b][2] * xset[c][1] = []) // last cell and next cell arent the same and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b and (xset[c][1] * xset[c][2] = xset[c][2]) // a bivavle then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //same digit to same digit if (xset[b][0] <> xset[b][3]) // start is a bivavle and (xset[c][0] = xset[c][3]) // 2nd set same digit. and (xset[c][0] = xset[b][3]) // sees the same exchange and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][2] * xset[c][1] = []) // no overlapping cell and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; end; // end check end;// end c cycle end; // end B cycle assign(output,'C:\sudoku\Aic.txt'); erase(output); rewrite(output); close(output); For b:= low(xset) to high(xset) do begin append(output); writeln(output); //gotoxy(2,61+b); write(output,'set: ',B,' weak-linked to: '); for g:= low(act[b]) to high(act[b]) do begin write(output,act[b][g],' '); end; close(output); end; assign(output,'C:\sudoku\Chain.txt'); erase(output); rewrite(output); close(output); //chain walk For A:= low(xset) to high(xset) do If high(act[A])>-1 then begin setlength(act3,0,0); b:=0; setlength(act3,b+1,max+1); //sets step storing //for e:= 0 to max do act3[b][0]:=-1; // sets the first "0" as -1 to allow code to see it as off act3[b][A]:=A; // saves used nodes for e:= low(act2[a]) to high(act2[A]) DO ACT3[B][act2[a,e]]:=act2[a,e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[a])>-1 then h[b]:=High(act[a]) //sets the link list node count else h[b]:= -1; setlength(phase,b+1); // sets the first node phase[b]:=A; // notes // act2 = twins // act = list of sets // act 3 = working list in the chain walk {append(output); writeln(output); write(output,'start: ',A); write(output,'(',h[b],')'); for e:= low(act3[b]) to high(act3[b]) DO write(output,act3[b][e]);} while (h[b] > -1) do begin if (act[phase[b],h[b]] <> act3[b,act[phase[b],h[b]]]) then begin inc(b); setlength(act3,b+1,max+1); //sets step storing act3[b]:=act3[b-1]; // copies the previous step setlength(phase,b+1); // sets the node phase[b]:=act[phase[b-1],h[b-1]]; act3[b][phase[b]]:=phase[b]; {append(output); write(output,' - ',phase[b]);} if k = 1 then begin F:=((b+1)*4); setlength(techwrite[u],0); setlength(techwrite[u],f+15); end; for e:= low(act2[phase[b]]) to high(act2[phase[b]]) DO ACT3[B][act2[phase[b],e]]:=act2[phase[b],e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[phase[b]])>-1 then h[b]:=High(act[phase[b]]) //sets the link list node count else h[b]:=-1; // eliminations //start and end same digit & peers of each other if (xset[a][8] * xset[phase[b]][9] <> []) and (xset[a][0] = xset[phase[b]][3]) then begin for n in (xset[a][0] * xset[phase[b]][3]) do if (xset[a,8] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,8] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,8] * xset[phase[b],9]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,8] * xset[phase[b],9]) do write(output,e,' '); write(output,']');} end; end; // A) start and end diffrent digit and visible to all copies of canddites used if (xset[phase[b]][3] * xset[a][6] = xset[phase[b]][3]) // is in the exchange cells and (xset[phase[b]][9] * xset[a][1] = xset[a][1])// sees all the digits and (xset[a][6] <> [0]) // is not a grouped digit ! // and (xset[a][0] = xset[a][3]) { single digit} // and (xset[phase[b]][3] = xset[phase[b]][0]) {single digit} and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[phase[b]][3]) do if (xset[a,1] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,1] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,1] * xset[phase[b],9]); {append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,1] * xset[phase[b],9]) do write(output,e,' '); write(output,']'); } end; end; // B) start and end diffrent digit and visible to all copies of canddites used if (xset[A][0] * xset[phase[b]][7] = xset[a][0]) // is in the exchange cells and (xset[A][8] * xset[phase[b]][2] = xset[phase[b]][2])// sees all the digits and (xset[phase[b]][7] <> [0]) // is not a grouped digit ! // and (xset[a][0] = xset[a][3]) { single digit} //and (xset[phase[b]][3] = xset[phase[b]][0]) {single digit} and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[A][0]) do if (xset[phase[B],2] * xset[A,8]) <> [] then begin covered2[n]:=covered2[n] + (xset[phase[B],2] * xset[A,8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[B],2] * xset[A,8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[phase[B],2] * xset[A,8]) do write(output,e,' '); write(output,']');} end; end; //loop end is a bivavle and start has its ending digit if ((xset[a][0] = xset[phase[b]][3]) and (xset[phase[b]][1] = xset[phase[b]][2]) //is a bivavle and (xset[phase[b]][9] * xset[a][1] = xset[a][1])) // all of b sees As cells //loop start is a bivavle and end has its starting digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][1] = xset[a][2]) //is a bivavle and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) // start and end are same digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) then begin For G:= 0 to b-1 do for e:= g+1 to b do begin //e:= g+1; // digits are the same for n in (xset[phase[G]][3]* xset[phase[e]][0]) do if ((xset[phase[g]][9]*xset[phase[e]][8]) <> []) then begin covered2[n]:= covered2[n] + (xset[phase[g]][9]*xset[phase[e]][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[g]][9]*xset[phase[e]][8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for j in (xset[phase[g]][9] * xset[phase[e]][8]) do write(output,j,' '); write(output,']');} end; // digits swap in cell cell becomes locked to the exchange digits //2nd and first if (xset[phase[g]][2] = xset[phase[e]][1]) and (xset[phase[g]][7] * xset[phase[e]][0] = xset[phase[e]][0]) and (xset[phase[e]][6] * xset[phase[g]][3] = xset[phase[g]][3]) then begin for J in (xset[phase[g]][2]* xset[phase[e]][1]) do if ((pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][3] + xset[phase[e]][0]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; // digits swap in cell cell becomes locked to the exchange digits // first and 2 if (xset[phase[g]][1] = xset[phase[e]][2]) and (xset[phase[g]][6] * xset[phase[e]][3] = xset[phase[e]][3]) and (xset[phase[e]][7] * xset[phase[g]][0] = xset[phase[g]][0]) then begin for J in (xset[phase[g]][1]* xset[phase[e]][2]) do if ((pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][0] + xset[phase[e]][3]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; end; end; // loop elimination code. // loop end and start land on same cell. <canabalistic> if (xset[a][1] = xset[phase[b]][2]) // first and last cell overlap and (xset[a][0] = xset[phase[b]][3]) // first and last digit is the same and (xset[phase[b]][7] <> [0]) // exchange is on and (xset[a][6] <> [0]) // exchange is on then begin for j in xset[a][1] do begin active:=true; covered[j]:=covered[j] + (pm[j] - xset[a][0]); if k = 1 then for n in (pm[j] - (xset[a][0])) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; for n in xset[a][0] do begin covered2[n]:=covered2[n] + (xset[a][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] + (xset[a][8]); end end; end; //chain display saving trigger if ((techwrite[u][1+f+3] + techwrite[u][2+f+3] + techwrite[u][3+f+3] + techwrite[u][4+f+3] + techwrite[u][5+f+3] + techwrite[u][6+f+3] + techwrite[u][7+f+3] + techwrite[u][8+f+3] + techwrite[u][9+f+3] )<> [] ) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[b]; for e:= 0 to b do begin techwrite[u,(e*4)+2]:=xset[phase[e],0]; techwrite[u,(e*4)+3]:=xset[phase[e],1]; techwrite[u,(e*4)+4]:=xset[phase[e],2]; techwrite[u,(e*4)+5]:=xset[phase[e],3]; end; if u = 32767 then begin //chaindisplay(#26,u); setlength(techwrite,0,0); u:=0; end; u:=u+1; setlength(techwrite,u+1); setlength(techwrite[u],f+15); end; //saving chain display end else begin dec(h[b]); repeat if (h[b] < 0) and (b > 0) then begin { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: ');} dec(b); {for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; // back tracking if the while h[b] > -1 condition triggers repeat if (h[b] < 0) and (b > 0) then begin // eliminations { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: '); } dec(b); { for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; { close(output);} end; // chain walk if k = 1 then chaindisplay(#120,u); end; {xy chain}

Aic

A.I.C: Show

Code: Select all: {A.I.C } procedure AIC(K:integer); type xsets = array of array of numberset; steps = array of array of numberset; stepper = array of integer; used2 = array of numberset; hold = array of integer; acts = array of array of integer; acts2 = array of array of integer; acts3 = array of array of integer; acts4 = array of integer; var h:hold; xset: xsets; step:steps; phase:stepper; use2: used2; act: acts; act2: acts2; act3: acts3; act4:acts4; n,a,b,c,d,e,f,g,j,u,m,r,max:integer; check: boolean; output: text; begin {alsfinder;} links; setlength(xset,0,0); if k = 1 then begin u:=0; setlength(techwrite,0,0); end; b:=-1; for n in [1..9] do for a in [0..5] do for c:= low(linkset[n][a]) to high(linkset[n][a]) do begin b:=b+1; setlength(xset,b+1,10); xset[b]:=linkset[n,a,c]; end; //finds the arrays that are the same data points //finds arrays that use a bivavle as on max:= high(xset); setlength(act2,0,0); setlength(act2,max+1); {writexy(2,60,'max: '); write(high(linkset[1][5]));} for b:= low(xset) to high(xset) do begin g:=0; for e:= low(xset) to high(xset) do if e <> b then begin {same set} {reverse twin } if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] =xset[e][3]) // first and last are the same and (xset[b][1] + xset[b][2] = xset[e][1] + xset[e][2]) // same cells but swapped position then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "on cell" position 2 set 1 and set2 postion 2 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][2] * xset[e][2] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // bi local sets same digit " on" cannot be "off" some where else if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][2] * xset[e][1] <> []) // on cell for same digit cant be off then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; //same "off cell" position 1 set 1 and set 2 postion 1 are the same on values if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) // first and last are the same digit and (xset[e][0] = xset[e][3]) // first and last are the same and (xset[b][1] * xset[e][1] <> []) // 2nd cell contains same "on cells" then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; {find bivavle cell twins} if (xset[b][0]+ xset[b][3] = xset[e][0] + xset[e][3]) // digit set the same and (xset[b][1] = xset[b][2])//uses 1 cell and (xset[e][1] = xset[e][2])//uses 1 cell and( xset[e][1] = xset[b][1]) // 1 cell in both sets and( xset[e][2] = xset[b][2])// 1 cell in both sets then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // bivavle digit is "on" postion linking same digit sets cant reuse the ending cell. if (xset[b][1] = xset[b][2]) // first set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[e][0] = xset[e][3]) // 2nd is a single digit and (xset[b][2] * xset[e][2] <> []) // cannot re use the "on" cell from a & b then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // first set is a bi-local 2nd set is a bivavle if (xset[e][1] = xset[e][2]) // 2nd set uses 1 cell and (xset[b][3] = xset[e][0]) // 2nd set starting digit uses exchange digit and (xset[b][0] = xset[b][3]) // 1st is a single digit and (xset[b][1] * xset[e][1] <> []) // cannot re use the "off" cell from then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; // first set is a 1 digit- 2nd set is a bivavle if (xset[e][1] = xset[e][2]) // 2nd set uses 1 cell and (xset[b][3] = xset[e][3]) // 2nd set starting digit uses exchange digit and (xset[b][0] = xset[b][3]) // 1st is a single digit and (xset[b][1] * xset[e][1] <> []) // cannot re use the "off" cell from then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; end; end; {assign(output,'C:\sudoku\twins.txt'); erase(output); rewrite(output); close(output); // sister tester print info to screen checks to see if the above works gotoxy(2,60); write(max,' '); For b:= low(xset) to high(xset) do begin append(output); writeln(output); write(output,'set: ',B,' sister to:'); for g:= low(act2[b]) to high(act2[b]) do begin write(output,act2[b][g],' '); end; close(output); end;} // weak-link builder setlength(act,0,0); setlength(act,max+1); //stores the weak-link visible to C for B:= low(xset) to high(xset) do begin g:=-1; For C:= low(xset) to high(xset) do if b <> c then begin check:=True; for e:= low(act2[b]) to high(act2[b]) do if act2[b][e] = C then check:= false; if check then begin //same digit to same digit if (xset[b][0]+xset[b][3] = xset[c][3]) // digit @ link is identical to first and last and (xset[c][3] = xset[c][0]) // 2nd set same digit. and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][2] * xset[c][1] = []) // no overlapping cell and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //digit exchange @ strong link if (xset[b][3] <> xset[c][0]) // last and next digit are the diffrent and (xset[b][2] = xset[c][1]) // last cell and next cell are the same and (xset[b][7] * xset[c][0] = xset[c][0]) // overlap exchange is true and (xset[c][6] * xset[b][3] = xset[b][3]) // overlap exchange is true and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[c][1] * xset[c][2] = []) // cant be a bivavle then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //digit exchange @ bivavle if (xset[b][3] = xset[c][0]) // last and next digit are the same and (xset[c][0] <> xset[c][3]) // last and next digit in new link are diffrent and (xset[b][2] * xset[c][1] = []) // last cell and next cell arent the same and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b and (xset[c][1] * xset[c][2] = xset[c][2]) // a bivavle then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; //same digit to same digit if (xset[b][0] <> xset[b][3]) // start is a bivavle and (xset[c][0] = xset[c][3]) // 2nd set same digit. and (xset[c][0] = xset[b][3]) // sees the same exchange and (xset[b][5] * xset[c][4] <> []) // shares a sector and (xset[b][2] * xset[c][1] = []) // no overlapping cell and (xset[b][9] * xset[c][1] = xset[c][1]) // all of c lands in the peer cells of b then begin g:=g+1; setlength(act[b],g+1); act[b][g]:= C; end; end; // end check end;// end c cycle end; // end B cycle { assign(output,'C:\sudoku\Aic.txt'); erase(output); rewrite(output); close(output); For b:= low(xset) to high(xset) do begin append(output); writeln(output); //gotoxy(2,61+b); write(output,'set: ',B,' weak-linked to: '); for g:= low(act[b]) to high(act[b]) do begin write(output,act[b][g],' '); end; close(output); end;} { assign(output,'C:\sudoku\Chain.txt'); erase(output); rewrite(output); close(output);} //chain walk {setlength(act4,0); setlength(act4,max+1); act4[0]:=-1; } For A:= low(xset) to high(xset) do If (high(act[A])>-1) {and (act4[a] <> a)} then begin setlength(act3,0,0); b:=0; setlength(act3,b+1,max+1); //sets step storing //for e:= 0 to max do act3[b][0]:=-1; // sets the first "0" as -1 to allow code to see it as off act3[b][A]:=A; // saves used nodes for e:= low(act2[a]) to high(act2[A]) DO ACT3[B][act2[a,e]]:=act2[a,e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[a])>-1 then h[b]:=High(act[a]) //sets the link list node count else h[b]:= -1; setlength(phase,b+1); // sets the first node phase[b]:=A; // notes // act2 = twins // act = list of sets // act 3 = working list in the chain walk {append(output); writeln(output); write(output,'start: ',A); write(output,'(',h[b],')'); for e:= low(act3[b]) to high(act3[b]) DO write(output,act3[b][e]);} while (h[b] > -1) do begin if (act[phase[b],h[b]] <> act3[b,act[phase[b],h[b]]]) then begin inc(b); setlength(act3,b+1,max+1); //sets step storing act3[b]:=act3[b-1]; // copies the previous step setlength(phase,b+1); // sets the node phase[b]:=act[phase[b-1],h[b-1]]; act3[b][phase[b]]:=phase[b]; {act4[phase[b]]:=phase[b]; } {append(output); write(output,' - ',phase[b]);} if k = 1 then begin F:=((b+1)*4); setlength(techwrite,u+1); setlength(techwrite[u],0); setlength(techwrite[u],f+13); end; for e:= low(act2[phase[b]]) to high(act2[phase[b]]) DO ACT3[B][act2[phase[b],e]]:=act2[phase[b],e]; setlength(h,b+1); // sets first step {als links list to choose from} if High(act[phase[b]])>-1 then h[b]:=High(act[phase[b]]) //sets the link list node count else h[b]:=-1; // eliminations //start and end same digit & peers of each other if (xset[a][8] * xset[phase[b]][9] <> []) and (xset[a][0] = xset[phase[b]][3]) then begin for n in (xset[a][0] * xset[phase[b]][3]) do if (xset[a,8] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,8] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,8] * xset[phase[b],9]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,8] * xset[phase[b],9]) do write(output,e,' '); write(output,']');} end; end; // A) start and end diffrent digit and visible to all copies of canddites used if (xset[phase[b]][3] * xset[a][6] = xset[phase[b]][3]) // is in the exchange cells and (xset[phase[b]][9] * xset[a][1] = xset[a][1])// sees all the digits and (xset[a][6] <> [0]) // is not a grouped digit ! and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[phase[b]][3]) do if (xset[a,1] * xset[phase[b],9]) <> [] then begin covered2[n]:=covered2[n] + (xset[a,1] * xset[phase[b],9]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[a,1] * xset[phase[b],9]); {append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[a,1] * xset[phase[b],9]) do write(output,e,' '); write(output,']'); } end; end; // B) start and end diffrent digit and visible to all copies of canddites used if (xset[A][0] * xset[phase[b]][7] = xset[a][0]) // is in the exchange cells and (xset[A][8] * xset[phase[b]][2] = xset[phase[b]][2])// sees all the digits and (xset[phase[b]][7] <> [0]) // is not a grouped digit ! and (xset[a][0] <> xset[phase[b]][3]) // cannot be linked and (xset[a][1] <> xset[phase[b]][2]) // cannot start and end same cells then begin for n in (xset[A][0]) do if (xset[phase[B],2] * xset[A,8]) <> [] then begin covered2[n]:=covered2[n] + (xset[phase[B],2] * xset[A,8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[B],3] * xset[A,8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for e in (xset[phase[B],2] * xset[A,8]) do write(output,e,' '); write(output,']');} end; end; //loop end is a bivavle and start has its ending digit if ((xset[a][0] = xset[phase[b]][3]) and (xset[phase[b]][1] = xset[phase[b]][2]) //is a bivavle and (xset[phase[b]][9] * xset[a][1] = xset[a][1])) // all of b sees As cells //loop start is a bivavle and end has its starting digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][1] = xset[a][2]) //is a bivavle and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) // start and end are same digit or ((xset[a][0] = xset[phase[b]][3]) and (xset[a][8] * xset[phase[b]][2] = xset[phase[b]][2])) then begin For G:= 0 to b do for e:= 0 to b do begin // digits are the same for n in (xset[phase[G]][3]* xset[phase[e]][0]) do if ((xset[phase[g]][9]*xset[phase[e]][8]) <> []) then begin covered2[n]:= covered2[n] + (xset[phase[g]][9]*xset[phase[e]][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] +(xset[phase[g]][9]*xset[phase[e]][8]); { append(output); write(output,'[=> eliminates:',n,' @ '); for j in (xset[phase[g]][9] * xset[phase[e]][8]) do write(output,j,' '); write(output,']');} end; // digits swap in cell cell becomes locked to the exchange digits //2nd and first if (xset[phase[g]][2] = xset[phase[e]][1]) and (xset[phase[g]][7] * xset[phase[e]][0] = xset[phase[e]][0]) and (xset[phase[e]][6] * xset[phase[g]][3] = xset[phase[g]][3]) then begin for J in (xset[phase[g]][2]* xset[phase[e]][1]) do if ((pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][3] + xset[phase[e]][0])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][3] + xset[phase[e]][0]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; // digits swap in cell cell becomes locked to the exchange digits // first and 2 if (xset[phase[g]][1] = xset[phase[e]][2]) and (xset[phase[g]][6] * xset[phase[e]][3] = xset[phase[e]][3]) and (xset[phase[e]][7] * xset[phase[g]][0] = xset[phase[g]][0]) then begin for J in (xset[phase[g]][1]* xset[phase[e]][2]) do if ((pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])) <> []) then begin covered[j]:=covered[j] + (pm[j]-(xset[phase[g]][0] + xset[phase[e]][3])); active:=true; //append(output); //write(output,'[=>',j,' eliminates: '); if k = 1 then for n in pm[j] - (xset[phase[g]][0] + xset[phase[e]][3]) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; // write(output,n,' '); // write(output,']'); end; end; end; end; // loop elimination code. // loop end and start land on same cell. <canabalistic> if (xset[a][1] = xset[phase[b]][2]) // first and last cell overlap and (xset[a][0] = xset[phase[b]][3]) // first and last digit is the same and (xset[phase[b]][7] <> [0]) // exchange is on and (xset[a][6] <> [0]) // exchange is on then begin for j in xset[a][1] do begin active:=true; covered[j]:=covered[j] + (pm[j] - xset[a][0]); if k = 1 then for n in (pm[j] - (xset[a][0])) do techwrite[u][n+f+3]:=techwrite[u][n+f+3] +[j]; for n in xset[a][0] do begin covered2[n]:=covered2[n] + (xset[a][8]); active:= true; if k = 1 then techwrite[u][n+f+3]:=techwrite[u][n+f+3] + (xset[a][8]); end end; end; //chain display saving trigger if k = 1 then if ((techwrite[u][1+f+3] + techwrite[u][2+f+3] + techwrite[u][3+f+3] + techwrite[u][4+f+3] + techwrite[u][5+f+3] + techwrite[u][6+f+3] + techwrite[u][7+f+3] + techwrite[u][8+f+3] + techwrite[u][9+f+3] ) <> [] ) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[b]; for e:= 0 to b do begin techwrite[u,(e*4)+2]:=xset[phase[e],0]; techwrite[u,(e*4)+3]:=xset[phase[e],1]; techwrite[u,(e*4)+4]:=xset[phase[e],2]; techwrite[u,(e*4)+5]:=xset[phase[e],3]; end; u:=u+1; end; //saving chain display if (u > 32767) then begin chaindisplay(#26,u-1); setlength(techwrite,0,0); u:=0; end; end else begin dec(h[b]); repeat if (h[b] < 0) and (b > 0) then begin { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: ');} dec(b); {for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; // back tracking if the while h[b] > -1 condition triggers repeat if (h[b] < 0) and (b > 0) then begin // eliminations { append(output); writeln(output); write(output,'back track 1'); writeln(output); write(output,'start: '); } dec(b); { for g:= 0 to b do begin write(output,phase[g]); if g <> b then write(output,' - '); end; } setlength(act3,b+1,max+1); setlength(h,b+1); setlength(phase,b+1); dec(h[b]); { if (b =0) and (h[b] <= -1) then write(output,' Terminated');} end; until( h[b]>=0) or (b <=0) end; { close(output);} end; // chain walk if k = 1 then chaindisplay(#26,u); end; {A.I.C}

ALS-Chain: Show

Code: Select all: {A.L.S chain {m.e} } procedure alsMe(K:integer); {mutual exclusion} type xsets = array of array of numberset; steps = array of array of numberset; used2 = array of numberset; hold = array of integer; acts = array of array of integer; acts2 = array of array of integer; var h:hold; xset: xsets; step:steps; use2: used2; act: acts; act2: acts2; n,a,b,c,d,e,f,g,j,u,m,r,max:integer; begin alsfinder; links; setlength(xset,0,0); if k = 1 then begin u:=0; setlength(techwrite,u+1,0); end; b:=-1; for n in[1..9] do for a in [0,7] do for c:= low(linkset[n][a]) to high(linkset[n][a]) do begin b:=b+1; setlength(xset,b+1,12); xset[b]:=linkset[n,a,c]; end; //finds the arrays that are the same data points max:= high(xset); setlength(act2,0,0); setlength(act2,max+1); for b:= 0 to max do begin g:=0; setlength(act2[b],0); for e:= 0 to max do begin {same set} {reversed } if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) //first and last are the same digit and ((xset[b][1] * xset[e][2]) = (xset[b][1] ) )// first cells match and ((xset[b][2] * xset[e][1]) = (xset[b][2] ) )// last cells match then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; {same set diffrent sector} {if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) //first and last are the same digit and ((xset[b][1] * xset[e][1]) = (xset[b][1] ) )// first cells match and ((xset[b][2] * xset[e][2]) = (xset[b][2] ) )// last cells match then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end;} {same starting digit diffrent starting cells 2nd cells cannot be reused.} if (xset[b][0] = xset[e][0]) // first digit is the same and (xset[b][3] = xset[e][3]) // last digit is the same and (xset[b][0] = xset[b][3]) //first and last are the same digit //and ((xset[b][1] * xset[e][1]) <> (xset[b][1] ) )// first cells match and (((xset[b][1] * xset[e][1]) <> [] )// first cells match or ((xset[b][2] * xset[e][2]) <> [] ))// last cells match then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; if (xset[b][10] = xset[e][10]) // first set is the same as 2nd set and (xset[b][10] <> []) // sets arent empty and (xset[b][11] = xset[e][11]) // digits are identical then begin setlength(act2[b],g+1); act2[b][g]:=e; g:=g+1; end; end; { gotoxy(2,60); write(max,' '); if b= 3 then begin write('Cells A: '); for r in xset[b][1] do write(' ',r); writeln; write('Cells B: '); for r in xset[b][2] do write(' ',r); writeln; write('Digit A: '); for r in xset[b][0] do write(' ',r); writeln; write('Digit b: '); for r in xset[b][3] do write(' ',r); writeln; write(' shared with: '); for r in act2[b] do write(r,' '); writeln; delay(150); end;} end; for a:= max downto 0 do begin setlength(act,0,0); b:=0; setlength(act,b+1,max+2); act[b][a+1]:=a+1; for R in act2[a] do begin act[b][R+1]:=R+1; end; setlength(use2,b+1); use2[b]:= xset[a][2]+ xset[a][1] ; //used cells; setlength(h,b+1); h[b]:=max; setlength(step,b+1,12); step[b]:=xset[a]; {gotoxy(2,60); write(max,' ',a,' ');} repeat for c:= h[b] downto 0 do if (act[b][c+1] <> C+1 ) //array wasnt used befor and (step[b][5] * xset[c][4] <> []) // sectors must shared at the link and ( ( // C shares end digit with B, // can be any strong link or a bivavle { this is stricktly non - overlappy} (step[b][3] * xset[c][0] = xset[c][0]) // last digit of b is same as 1 of C and (step[b][9] * xset[c][1] = xset[c][1]) // first step of C must see last step of B and (xset[c][2] * step[b][1] = [] ) // step c cannot over lap B's end point. ) or ( // ( 3-1 | [1 -1 or 1-3 ] transfer digit when c is not a bivavle (xset[c][0] = xset[c][3]) // same digit at link and (step[b][0] = step[b][3]) // same digit at link // found an error fixing it and (xset[c][0] <> step[b][3]) // b and c dont share a digit and (xset[c][6] * step[b][3] = step[b][3]) // checks the cells of B is able to transfer digits to C and (step[b][7] * xset[c][0] = xset[c][0]) // checks the cells of C is able to transfer digits to B and (xset[c][1] * step[b][2] = xset[c][1]) // the cells of C & B overlap. ) or ( // cell b is a bivavle then cell C <> be an overlapping bivavle and c is a 1-1 |1-3 link (step[b][1] = step[b][2] ) // one cell and (xset[c][2] <> xset[c][1] ) // cannot be a bivavle and (step[b][3] = xset[c][0] ) // cell must transfer digit to C and (xset[c][6] * step[b][3] = step[b][3]) // checks the cells of B is able to transfer digits to C and (step[b][7] * xset[c][0] = xset[c][0]) // checks the cells of C is able to transfer digits to B and (xset[c][1] * step[b][2] = xset[c][1]) // checks that c[1] cells are exclusivly in step[b] and (xset[c][2] * step[b][1] = []) // checks that cells of c[2] are not in step b ) or ( // cell b is a 1-1|3-1 link then cell C can be a bivavle (step[b][1] <> step[b][2] ) // not a bivavle and (xset[c][2] = xset[c][1] ) // is a bivavle and (step[b][3] = xset[c][0] ) // cell must transfer digit to C and (xset[c][6] * step[b][3] = step[b][3]) // checks the cells of B is able to transfer digits to C and (step[b][7] * xset[c][0] = xset[c][0]) // checks the cells of C is able to transfer digits to B and (xset[c][1] * step[b][2] = xset[c][1]) // checks that c[1] cells are exclusivly in step[b] and (xset[c][2] * step[b][1] = []) // checks that cells of c[2] are not in step b ) ) then begin {h[b]:=h[b] - 1;} b:=b+1; setlength(act,b+1); act[b]:=act[b-1]; act[b][c+1]:=C+1; for R in act2[c] do begin act[b][R+1]:=R+1; end; setlength(h,b+1); setlength(use2,b+1); use2[b]:= use2[b-1]+xset[c][1]+xset[c][2] ; h[b]:=max; setlength(step,b+1,12); step[b]:=xset[c]; { gotoxy(2,61); write(B,': ( '); if b > 2 then for r:= 0 to b do begin for n in step[r][0] do write(n,')'); for n in step[r][1] do write(n,' '); write(' = '); for n in step[r][2] do write(n,' '); write(' ( '); for n in step[r][3] do write(n, ' ) - '); writeln; delay(1500); end; } { break;} if k = 1 then begin m:=((b+1)*4); setlength(techwrite[u],0); setlength(techwrite[u],m+14); end; {end points visible to each other same digits} if (b > 0) and (xset[a][0] = xset[c,3]) and (xset[c][5] * xset[a][4] = [])and (((xset[a][8]*xset[c][9]) -(use2[b])) <> [])//normal then begin active:=true; for n in (xset[a][0] + xset[c,3] ) do begin covered2[n]:=covered2[n] + ((xset[a][8]*xset[c][9]) -(use2[b])); if k = 1 then techwrite[u,n+m+3]:=techwrite[u,n+m+3] + (digitcell[n] *((xset[a][8]*xset[c][9]) -(use2[b]))); end; {chain loop? } end; {end points visible to each other diffrent digits} if (b > 0) and (xset[a][0] <> xset[c,3]) {and (xset[c][5] * xset[a][4] <> [])} and (xset[c][9] * xset[a][1] = xset[a][1]) and ( xset[c][2] * xset[a][1] =[])//and dont use the same cells at start and end then begin active:=true; for n in xset[a][0] do if N in xset[C][7] then begin covered2[n]:=covered2[n] + (xset[c][2]); if k = 1 then techwrite[u,n+m+3]:=techwrite[u,n+m+3] + (digitcell[n]*(xset[c][2])); end; for n in xset[c][3] do if n in xset[a][6] then begin covered2[n]:=covered2[n] + (xset[a][1]); if k = 1 then techwrite[u,n+m+3]:=techwrite[u,n+m+3] + (digitcell[n]*(xset[a][1])); end; {chain walk to see if 2 points are the same digits} end; //end points overlap = loop if (b > 0) //bi local over lap specifically and (((xset[a][0] <> xset[c,3]) and (xset[c][5] * xset[a][4] <> []) and ( xset[c][2] = xset[a][1]) and (xset[c][7] * xset[a][6] <> [0])) // bivalve intial digit is seen by the end point or ((xset[a][0] = xset[c][3]) and (xset[c][5] * xset[a][4] <> []) and (xset[c][2] * xset[a][1] = [])) ) then begin for e:= (0) to (b-1) do for d:= e+1 to (b) do begin active:=true; //overlapping weaklinks are locked //below verifies the the step befor can be overlaped by next digit if (step[e][2] * step[d][1] = step[e][2]) and (step[e][3] * step[d][6] <> []) then for n in step[e][2]*step[d][1] do begin covered[n]:= covered[n] +( pm[n]-(step[e][3]+step[d][0])); if k = 1 then begin for r in (pm[n]-(step[e][3]+step[d][0])) do techwrite[u,r+m+3]:=techwrite[u,r+m+3]+[n]; end; end; if (step[e][1] * step[d][2] = step[e][1]) and (step[e][0] * step[d][7] <> []) then for n in step[e][1]*step[d][2] do begin covered[n]:= covered[n] +( pm[n]-(step[e][0]+step[d][3])); if k = 1 then begin for r in (pm[n]-(step[e][0]+step[d][3])) do techwrite[u,r+m+3]:=techwrite[u,r+m+3]+[n]; end; end; //peers of weaklinks are removed if they share the same digit. if step[d][0] = step[e][3] then for n in step[d][0] do begin covered2[n]:=covered2[n] + ((step[d][8] * step[e][9]) - use2[b]); if k = 1 then techwrite[u,n+m+3]:=techwrite[u,n+m+3] + (digitcell[n]*((step[d][8] * step[e][9]) - use2[b])); end; end; end; if (k = 1) and (techwrite[u,1+m+3]+ (techwrite[u,2+m+3])+ (techwrite[u,3+m+3] ) + (techwrite[u,4+m+3] ) + (techwrite[u,5+m+3])+ (techwrite[u,6+m+3] ) + (techwrite[u,7+m+3] ) + (techwrite[u,8+m+3])+ (techwrite[u,9+m+3] ) <> []) and (b > 0) //and (techwrite[u,1+m+3] * [17] = [17]) then begin techwrite[u,0]:=[4]; techwrite[u,1]:=[b]; for e:= 0 to b do begin if step[e,10] = [] then begin techwrite[u,(e*4)+2]:=step[e,0]; techwrite[u,(e*4)+3]:=step[e,1]; techwrite[u,(e*4)+4]:=step[e,2]; techwrite[u,(e*4)+5]:=step[e,3]; end; if step[e,10] <> [] then begin techwrite[u,(e*4)+2]:=step[e,0]; techwrite[u,(e*4)+3]:=step[e,1]; techwrite[u,(e*4)+4]:= step[e,10]; techwrite[u,(e*4)+5]:=(step[e,11]-step[e,0]); end; end; if u = 32767 then begin chaindisplay(#11,u); setlength(techwrite,0,0); u:=0; end; u:=u+1; setlength(techwrite,u+1); setlength(techwrite[u],m+14); end; {break;} end else h[b]:= h[b] - 1; if (h[b] < 0) and (b > 0) then begin b:=b-1; setlength(use2,b+1); setlength(h,b+1); setlength(step,b+1,12); setlength(act,b+1); { h[b]:=h[b]-1;} end; until (h[b] < a) and (b = 0) end; if k = 1 then chaindisplay(#11,u); end; {als chain}

ALS+AIC: Show

by **StrmCkr** » Mon Jan 30, 2017 11:38 am

Distributed Disjoint Subsets

SueDeCoq: Show

Code: Select all: procedure Suedecoq(K,l,v:integer); { http://forum.enjoysudoku.com/two-sector-disjoint-subsets-t2033.html} type hold = array of integer; Nuse = array of integer; base = array of integer; rcc = array of array of nums; RCDs = array of nums; TRCC = array of nums; usednum= array of nums; usednum2= array of nums; used = array of numberset; used2 = array of numberset; cellused=array of numberset; almostlockedset3= array of array of integer; RCSTORE= array of array of nums; var xn,w,p,p2,n,n2,a,m,z,xn2,yn,yn3,yn2,yn4,xn3,yn5,yn6,xn4,q,r,u,b,b2,B3,max,size,f,count,g:integer; h:hold; nouse: nuse; step: base; rc:rcc; RCD:RCDs; TRC:TRCC; als3: almostlockedset3; store: RCSTORE; A3:numberset; z1:nums; z2:nums; lx1: rcbpeer; lx2: rcbpeer; use:used; use2:used; usenum : usednum; usenum2 : usednum2; celluse : cellused; begin alsfinder; //ahsfinder; setlength(als3,high(als)+1); setlength(store,high(als)+1); for a:= high(als) downto 0 do {startin array} begin w:=-1; for p:= high(als) downto 0 do {iteration of peers} if (als[p,1]+1 = als[p,2] ) then if (popcnt(dword((comboset2[als[a,4]]*Comboset2[als[p,4]]) ) ) >=1 ) {set a & B must share >=1 digits} and (combosets[als[a,0],als[a,3]] - combosets[als[p,0],als[p,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[p,0],als[p,3]] - combosets[als[a,0],als[a,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als[a,0]; xn2:=als[p,0]; yn:=als[a,3]; yn3:=als[p,3]; yn2:=als[a,4]; yn4:= als[p,4]; z1:=[]; {restricted common chcek} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if ( ( popcnt(dword(z1)) >=1 ) ) then begin w:=w+1; setlength(als3[a],w+1); setlength(store[a],w+1); als3[a,w]:=p; store[a,w]:=z1; end; end; end; if k=1 then begin u:=0; setlength(techwrite,u+1,0); end; for a:= high(als) downto 0 do {startin array} if (high(als3[a]) +1 >= (als[a,2] - als[a,1])) and (als[a,2] - als[a,1] >L) and (als[a,2] - als[a,1] <=v) then begin w:=0; setlength(h,w+1); h[w]:=high(als3[a]); setlength(TRC,(w+1)); {set the array size to w} TRC[w]:= []; {{stores the RC between A and all steps}} setlength(RCD,(w+1)); {set the array size to w} RCD[w]:= []; {{stores the RC between A and current steps}} setlength(usenum,w+1); usenum[w]:=comboset[als[a,4]]; {digits used in the step} setlength(celluse,w+1); celluse[w]:=combosets[als[a,0],als[a,3]]; {cells used in step} setlength(use,(w+1)); {set the array size to w} use[w]:=[0..80] - combosets[als[a,0],als[a,3]]; {cells unused to choose from} size:= (als[a,2] - als[a,1]); {stes the number of added sets to search for is equal to the missing space size of A } h[w]:= high(als3[a]); {keeps track of what array is the next stop used for step W } setlength(use2,(w+1)); {set the array size to w} use2[w]:=combosets[als[a,0],als[a,3]]; {all cells used} setlength(usenum2,w+1); usenum2[w]:=comboset[als[a,4]]; {all digits used} repeat for p:= h[w] downto 0 do if ((use[w] * combosets[als[als3[a,p],0],als[als3[a,p],3]]) <> []) {checks the new set selected adds cells} and (( store[a,p] - TRC[w] <>[]) {checks that a new RC is added} or (w=1) ) then begin h[w]:=h[w]-1; inc(w); setlength(h,w+1); h[w]:=p-1; setlength(step,w+1); step[w]:=p; setlength(usenum,w+1); {stores digits used at step} usenum[w]:=Comboset[als[als3[a,p],4]]; setlength(celluse,w+1); {stores the cells used at step} celluse[w]:=combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(TRC,(w+1)); TRC[w]:= store[a,p]+TRC[w-1]; {stores the RC between A and all steps} setlength(RCD,(w+1)); RCD[w]:= store[a,p]; {stores the RC between A and current steps} setlength(use,(w+1)); {removes the cells from the unused list} use[w]:= use[w-1] - combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(use2,(w+1)); {all cells used} use2[w]:=use2[w-1] + combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(usenum2,w+1); {all digits used} usenum2[w]:=usenum2[w-1]+Comboset[als[als3[a,p],4]]; count:=0; for g in use2[w] do inc(count); {removes the common RC if its used in muti sets} {z1:=[]; for R:= 1 to w-1 do for q:= (R+1) to w do z1:=Z1 + (RCD[r] * RCD[Q]); } z2:=usenum2[w]; if (size = w) and (count = popcnt(dword(usenum2[w] ))) then {begin // removed version faster rendition is below for R in usenum2[w] do //numbers for q in [ 0..26] do //sector if (combosetS[q,510]) * (use2[w] * Digitcell[R] ) = (use2[w] * Digitcell[R] ) then z2:=z2 - [r]; //identifies digits not in 1 sector end; } for R in usenum2[w] do begin for q in (use2[w] * Digitcell[r]) do for g in CellSec[q] do if combosets[g,510] * (use2[w]*digitcell[r] ) = (use2[w]*digitcell[r] ) then begin z2:=z2 - [r]; break; end; end; //type 1: N cells with N digits where each of the N digits is locked to 1 sector exactly ie N sectors. if (size = w) and (count = popcnt(dword(usenum2[w]-z2 ))) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; // elimnations for als parts back to the first one. { for R:= w downto 1 do For B in RCD[R] -z1 do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((celluse[r] + celluse[0])*digitcell[b]))) = ((celluse[r] + celluse[0])*digitcell[b]) ) and ( ((celluse[r] + celluse[0])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; } // elliminations for RC's as z1 digits common to all als { For B in z1 do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((use2[w])*digitcell[b]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; } // elliminations for all digits since each digit is only in 1 sector we can use all cells and all digits. For B in usenum2[w] {- (RCD[W] + Z1)} do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * (use2[w]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end ;{ case 1} break; end else h[w]:=h[w] -1; if ((h[w] < 0) and (w >0)) or (w = size) then begin dec(w); //set the array size to w setlength(h,w+1); setlength(use,(w+1)); setlength(TRC,(w+1)); setlength(RCD,(w+1)); setlength(usenum,w+1); setlength(celluse,w+1); setlength(usenum2,w+1); setlength(use2,(w+1)); end; until (w = 0) and (h[w] < 0) end; chaindisplay(#100,u); end; {sue de coq}

DeathBlossom: Show

Code: Select all: procedure DeathBlossom(K,l,v:integer); {4 sector disjoint set} type hold = array of integer; Nuse = array of integer; base = array of integer; rcc = array of array of nums; RCDs = array of nums; TRCC = array of nums; usednum= array of nums; usednum2= array of nums; used = array of numberset; used2 = array of numberset; cellused=array of numberset; almostlockedset3= array of array of integer; RCSTORE= array of array of nums; var xn,w,p,p2,n,n2,a,m,z,xn2,yn,yn3,yn2,yn4,xn3,yn5,yn6,xn4,q,r,u,b,b2,B3,max,size,f,count,g:integer; h:hold; nouse: nuse; step: base; rc:rcc; RCD:RCDs; TRC:TRCC; als3: almostlockedset3; store: RCSTORE; A3:numberset; z1:nums; z2:nums; lx1: rcbpeer; lx2: rcbpeer; use:used; use2:used; usenum : usednum; usenum2 : usednum2; celluse : cellused; begin alsfinder; //ahsfinder; setlength(als3,high(als)+1); setlength(store,high(als)+1); for a:= high(als) downto 0 do {startin array} begin w:=-1; for p:= high(als) downto 0 do {iteration of peers} if (als[p,1]+1 = als[p,2] ) then if (popcnt(dword((comboset2[als[a,4]]*Comboset2[als[p,4]]) ) ) >=1 ) {set a & B must share >=1 digits} and (combosets[als[a,0],als[a,3]] - combosets[als[p,0],als[p,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[p,0],als[p,3]] - combosets[als[a,0],als[a,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als[a,0]; xn2:=als[p,0]; yn:=als[a,3]; yn3:=als[p,3]; yn2:=als[a,4]; yn4:= als[p,4]; z1:=[]; {restricted common chcek} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if ( ( popcnt(dword(z1)) >=1 ) ) then begin w:=w+1; setlength(als3[a],w+1); setlength(store[a],w+1); als3[a,w]:=p; store[a,w]:=z1; end; end; end; if k=1 then begin u:=0; setlength(techwrite,u+1,0); end; for a:= high(als) downto 0 do {startin array} if (high(als3[a]) +1 >= (als[a,2] - als[a,1])) and (als[a,2] - als[a,1] >L) and (als[a,2] - als[a,1] <=v) then begin w:=0; setlength(h,w+1); h[w]:=high(als3[a]); setlength(TRC,(w+1)); {set the array size to w} TRC[w]:= []; {{stores the RC between A and all steps}} setlength(RCD,(w+1)); {set the array size to w} RCD[w]:= []; {{stores the RC between A and current steps}} setlength(usenum,w+1); usenum[w]:=comboset[als[a,4]]; {digits used in the step} setlength(celluse,w+1); celluse[w]:=combosets[als[a,0],als[a,3]]; {cells used in step} setlength(use,(w+1)); {set the array size to w} use[w]:=[0..80] - combosets[als[a,0],als[a,3]]; {cells unused to choose from} size:= (als[a,2] - als[a,1]); {stes the number of added sets to search for is equal to the missing space size of A } h[w]:= high(als3[a]); {keeps track of what array is the next stop used for step W } setlength(use2,(w+1)); {set the array size to w} use2[w]:=combosets[als[a,0],als[a,3]]; {all cells used} setlength(usenum2,w+1); usenum2[w]:=comboset[als[a,4]]; {all digits used} repeat for p:= h[w] downto 0 do if ((use[w] * combosets[als[als3[a,p],0],als[als3[a,p],3]]) <> []) {checks the new set selected adds cells} and (( store[a,p] - TRC[w] <>[]) {checks that a new RC is added} or (w=1) ) then begin h[w]:=h[w]-1; inc(w); setlength(h,w+1); h[w]:=p-1; setlength(step,w+1); step[w]:=p; setlength(usenum,w+1); {stores digits used at step} usenum[w]:=Comboset[als[als3[a,p],4]]; setlength(celluse,w+1); {stores the cells used at step} celluse[w]:=combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(TRC,(w+1)); TRC[w]:= store[a,p]+TRC[w-1]; {stores the RC between A and all steps} setlength(RCD,(w+1)); RCD[w]:= store[a,p]; {stores the RC between A and current steps} setlength(use,(w+1)); {removes the cells from the unused list} use[w]:= use[w-1] - combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(use2,(w+1)); {all cells used} use2[w]:=use2[w-1] + combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(usenum2,w+1); {all digits used} usenum2[w]:=usenum2[w-1]+Comboset[als[als3[a,p],4]]; count:=0; for g in use2[w] do inc(count); {removes the common RC if its used in muti sets} {z1:=[]; for R:= 1 to w-1 do for q:= (R+1) to w do z1:=Z1 + (RCD[r] * RCD[Q]); } z2:=usenum2[w]; if (size = w) and (count = popcnt(dword(usenum2[w] ))) then {begin // removed version faster rendition is below for R in usenum2[w] do //numbers for q in [ 0..26] do //sector if (combosetS[q,510]) * (use2[w] * Digitcell[R] ) = (use2[w] * Digitcell[R] ) then z2:=z2 - [r]; //identifies digits not in 1 sector end; } for R in usenum2[w] do begin for q in (use2[w] * Digitcell[r]) do for g in CellSec[q] do if combosets[g,510] * (use2[w]*digitcell[r] ) = (use2[w]*digitcell[r] ) then begin z2:=z2 - [r]; break; end; end; //type 1: N cells with N digits where each of the N digits is locked to 1 sector exactly ie N sectors. if (size = w) and (count = popcnt(dword(usenum2[w]-z2 ))) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; // elimnations for als parts back to the first one. { for R:= w downto 1 do For B in RCD[R] -z1 do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((celluse[r] + celluse[0])*digitcell[b]))) = ((celluse[r] + celluse[0])*digitcell[b]) ) and ( ((celluse[r] + celluse[0])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; } // elliminations for RC's as z1 digits common to all als { For B in z1 do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((use2[w])*digitcell[b]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; } // elliminations for all digits since each digit is only in 1 sector we can use all cells and all digits. For B in usenum2[w] {- (RCD[W] + Z1)} do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * (use2[w]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end ;{ case 1} break; end else h[w]:=h[w] -1; if ((h[w] < 0) and (w >0)) or (w = size) then begin dec(w); //set the array size to w setlength(h,w+1); setlength(use,(w+1)); setlength(TRC,(w+1)); setlength(RCD,(w+1)); setlength(usenum,w+1); setlength(celluse,w+1); setlength(usenum2,w+1); setlength(use2,(w+1)); end; until (w = 0) and (h[w] < 0) end; chaindisplay(#69,u); end; {Death blossom}

DDS: Show

Code: Select all: procedure DDS(K,l,v:integer); { http://forum.enjoysudoku.com/distributed-disjoint-subsets-t5423.html} type hold = array of integer; Nuse = array of integer; base = array of integer; rcc = array of array of nums; RCDs = array of nums; TRCC = array of nums; usednum= array of nums; usednum2= array of nums; used = array of numberset; used2 = array of numberset; cellused=array of numberset; almostlockedset3= array of array of integer; RCSTORE= array of array of nums; var xn,w,p,p2,n,n2,a,m,z,xn2,yn,yn3,yn2,yn4,xn3,yn5,yn6,xn4,q,r,u,b,b2,B3,max,size,f,count,g:integer; h:hold; nouse: nuse; step: base; rc:rcc; RCD:RCDs; TRC:TRCC; als3: almostlockedset3; store: RCSTORE; A3:numberset; z1,z2,z3:nums; //z2:nums; //z3:nums; lx1,lx2: rcbpeer; //lx2: rcbpeer; use:used; use2:used; usenum : usednum; usenum2 : usednum2; celluse : cellused; begin alsfinder; //ahsfinder; setlength(als3,high(als)+1); setlength(store,high(als)+1); for a:= high(als) downto 0 do {startin array} begin w:=-1; for p:= high(als) downto 0 do {iteration of peers} if (als[p,1]+1 = als[p,2] ) then if (popcnt(dword((comboset2[als[a,4]]*Comboset2[als[p,4]]) ) ) >=1 ) {set a & B must share >=1 digits} and (combosets[als[a,0],als[a,3]] - combosets[als[p,0],als[p,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} and (combosets[als[p,0],als[p,3]] - combosets[als[a,0],als[a,3]] <> [] ) { sectors can over lap, however cells cannot overlap in full} then begin xn:=als[a,0]; xn2:=als[p,0]; yn:=als[a,3]; yn3:=als[p,3]; yn2:=als[a,4]; yn4:= als[p,4]; z1:=[]; {restricted common chcek} for z in (comboset[yn4] * comboset[yn2]) do if ((Digitcell[z] * combosets[xn,yn]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z digit has cells out side the overlap} and ((Digitcell[z] * combosets[xn2,yn3]) - (combosets[xn2,yn3] * combosets[xn,yn]) <> [] ) {checks that the sector for z dgit has cells out side the overlap} and (digitcell[z] *( combosets[xn,yn] * combosets[xn2,yn3]) = []) {resticted commons cannot be found in an overlap cell} then begin lx2:=[0..26]; { a RC should only exist in the common intersections of the selected sets} for q in (combosets[xn,yn]+combosets[xn2,yn3]) *digitcell[z] do {combine common cells in both a&b for common sectors amongts those cells} lx2:= lx2 * cellsec[q]; if (popcnt(dword(lx2)) >0) and (popcnt(dword(lx2)) < 3) {check that those cells only existing in 1 or 2 sectors to be restircted} then z1:=z1 + [z]; {saves the resticted commons} end; if ( ( popcnt(dword(z1)) >=1 ) ) then begin w:=w+1; setlength(als3[a],w+1); setlength(store[a],w+1); als3[a,w]:=p; store[a,w]:=z1; end; end; end; if k=1 then begin u:=0; setlength(techwrite,u+1,0); end; for a:= high(als) downto 0 do {startin array} if (high(als3[a]) +1 >= (als[a,2] - als[a,1])) and (als[a,2] - als[a,1] >L) and (als[a,2] - als[a,1] <=v) then begin w:=0; setlength(h,w+1); h[w]:=high(als3[a]); setlength(TRC,(w+1)); {set the array size to w} TRC[w]:= []; {{stores the RC between A and all steps}} setlength(RCD,(w+1)); {set the array size to w} RCD[w]:= []; {{stores the RC between A and current steps}} setlength(usenum,w+1); usenum[w]:=comboset[als[a,4]]; {digits used in the step} setlength(celluse,w+1); celluse[w]:=combosets[als[a,0],als[a,3]]; {cells used in step} setlength(use,(w+1)); {set the array size to w} use[w]:=[0..80] - combosets[als[a,0],als[a,3]]; {cells unused to choose from} size:= (als[a,2] - als[a,1]); {stes the number of added sets to search for is equal to the missing space size of A } h[w]:= high(als3[a]); {keeps track of what array is the next stop used for step W } setlength(use2,(w+1)); {set the array size to w} use2[w]:=combosets[als[a,0],als[a,3]]; {all cells used} setlength(usenum2,w+1); usenum2[w]:=comboset[als[a,4]]; {all digits used} repeat for p:= h[w] downto 0 do if ((use[w] * combosets[als[als3[a,p],0],als[als3[a,p],3]]) <> []) {checks the new set selected adds cells} and (( store[a,p] - TRC[w] <>[]) {checks that a new RC is added} or (w=1) ) then begin h[w]:=h[w]-1; inc(w); setlength(h,w+1); h[w]:=p-1; setlength(step,w+1); step[w]:=p; setlength(usenum,w+1); {stores digits used at step} usenum[w]:=Comboset[als[als3[a,p],4]]; setlength(celluse,w+1); {stores the cells used at step} celluse[w]:=combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(TRC,(w+1)); TRC[w]:= store[a,p]+TRC[w-1]; {stores the RC between A and all steps} setlength(RCD,(w+1)); RCD[w]:= store[a,p]; {stores the RC between A and current steps} setlength(use,(w+1)); {removes the cells from the unused list} use[w]:= use[w-1] - combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(use2,(w+1)); {all cells used} use2[w]:=use2[w-1] + combosets[als[als3[a,p],0],als[als3[a,p],3]]; setlength(usenum2,w+1); {all digits used} usenum2[w]:=usenum2[w-1]+Comboset[als[als3[a,p],4]]; count:=0; for g in use2[w] do inc(count); {removes the common RC if its used in muti sets} {z1:=[]; for R:= 1 to w-1 do for q:= (R+1) to w do z1:=Z1 + (RCD[r] * RCD[Q]); } // checks for common z to all z3:=[1..9]; for r:= w downto 0 do z3:= usenum[r] * z3; z2:=usenum2[w]; if (size = w) and (count = popcnt(dword(usenum2[w] ))) then for R in usenum2[w] do begin for q in (use2[w] * Digitcell[r]) do for g in CellSec[q] do if combosets[g,510] * (use2[w]*digitcell[r] ) = (use2[w]*digitcell[r] ) then begin z2:=z2 - [r]; break; end; end; //type 1: N cells with N digits where each of the N digits is locked to 1 sector exactly ie N sectors. if (size = w) and (count = popcnt(dword(usenum2[w]-z2 ))) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; // elliminations for all digits since each digit is only in 1 sector we can use all cells and all digits. For B in usenum2[w] do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * (use2[w]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end ;{ case 1} // type 2: N als N RC - common z's of all als if (size = w) and (popcnt(dword(trc[w])) >=size) and (z3 <> []) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; // elliminations z3 digits common to all als if RC's counts are still above link size For B in z3 do begin z1:= TRC[w] - [b]; if (popcnt(dword(z1)) >=size) then for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((use2[w])*digitcell[b]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end ;{ case 2} // type 3: N- asl with RC count >= x2 link size if (size = w) and (popcnt(dword(trc[w])) >=size*2) then begin if k = 1 then begin if u = 32765 {max array size error code safty exit} then begin chaindisplay(#22,u); setlength(techwrite,0,0); u:=0; setlength(techwrite,u+1,0) //exit; end; f:=((w+1)*2); setlength(techwrite[u],0); setlength(techwrite[u],((f+13)+1)); end; // elimnations for parts back to the first. for R:= w downto 1 do For B in RCD[R] do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * ((celluse[r] + celluse[0])*digitcell[b]))) = ((celluse[r] + celluse[0])*digitcell[b]) ) and ( ((celluse[r] + celluse[0])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; // set a is locked for z digit when set - RC leaves at least 1. For B in usenum2[0] do begin z1:= TRC[w] - [b]; if (popcnt(dword(z1)) >=size*2) then for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (digitcell[b] * (use2[w]))) = ((use2[w])*digitcell[b]) ) and ( ((use2[w])*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; end; // if the first set is locked to all sets then all sets are locked sets if TRC[w] * usenum[0] = usenum[0] then for R:= w downto 1 do For B in usenum2[r] - RCD[r] do for Q in (digitcell[b] - (use2[w]*digitcell[b])) do if ((peer[q] * (celluse[r] *digitcell[b])) = ((celluse[r] )*digitcell[b]) ) and ( ((celluse[r] )*digitcell[b]) <> []) then begin Active:=true; covered2[B]:=covered2[B] + [Q]; if k = 1 then begin techwrite[u,(b+F+3)]:=techwrite[u,(b+f+3)] + [q]; techwrite[u,(f+3)]:=techwrite[u,(f+3)] + [b]; end; end; if (k=1) and (techwrite[u,(f+3)] <> []) then begin techwrite[u,0]:=[3]; techwrite[u,1]:=[f]; techwrite[u,(f+3-1)]:=trc[w]; //techwrite[u,(f+3)]:=z1; techwrite[u,2]:=comboset[als[a,4]]; techwrite[u,3]:=combosets[als[a,0],als[a,3]]; for b:= 1 to w do begin techwrite[u,(b*2)+2]:=techwrite[u,(b*2)+2] + comboset[als[als3[a,step[b]],4]]; techwrite[u,(b*2)+3]:=techwrite[u,(b*2)+3]+ combosets[als[als3[a,step[b]],0],als[als3[a,step[b]],3]]; end; u:=u+1; setlength(techwrite,u+1); end; end ;{ case 3} break; end else h[w]:=h[w] -1; if ((h[w] < 0) and (w >0)) or (w = size) then begin dec(w); //set the array size to w setlength(h,w+1); setlength(use,(w+1)); setlength(TRC,(w+1)); setlength(RCD,(w+1)); setlength(usenum,w+1); setlength(celluse,w+1); setlength(usenum2,w+1); setlength(use2,(w+1)); end; until (w = 0) and (h[w] < 0) end; chaindisplay(#106,u); end; {DDS}

Almost Disjointed distributed subset{A.d.d.S}

ADDS: Show

Code: Select all: procedure Adds(K,M,Q:integer); { k is writting function M is starting size q is ending size} type hold = array of integer; base = array of numberset; base2 = array of integer; hold2 = array of RCBpeer; base3 = array of array of numberset; base4 = array of nums; var p,S,F,C,w,j,a,b,z,lx,x,g,l,n,act:integer; z1:nums; z2:base4; p2,lx1:numberset; p3: base3; h: hold; step: base; loc: base2; List: hold2; begin cellcombo; If M = 0 then L:= 2 else L:= M; repeat begin for C:= slist[l] to flist[l] do if (combocell[c] <> []) then begin act:=0; for p in combocell[c]do begin inc(act); if act >=L then break; end; if act >= L then for p in combocell[c] do if (peer[p] * combocell[c]<> []) 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(p3,10,(w+1)); { digits cells} setlength(loc,(w+1)); {starting cell} setlength(z2,(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; z2[w]:=[]; for n:= 1 to 9 do begin if n in pm[p] then p3[n,w]:= [p] else p3[n,w]:=[]; if n in pm[p] then z2[w]:=z2[w]+[n]; end; repeat for J:= h[w] downto 0 do begin if not (peer2[loc[w],j] in step[w]) and ( peer2[loc[w],j] in (combocell[c])) and (( peer[peer2[loc[w],j]] * (combocell[c]-step[w]) <> []) or (w+2 = 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[loc[w-1],j]]] + [Cy[peer2[loc[w-1],j]]+9] + [BXY[peer2[loc[w-1],j]]+18]; H[w]:=19; setlength(step,(w+1)); {set the array size to w} step[w]:=step[w-1] + [peer2[loc[w-1],j]] ; { keeps track of what cells are used at each step W } setlength(p3,10,(w+1)); { digits cells} setlength(z2,(w+1)); { digits cells} for n:= 1 to 9 do begin if n in pm[peer2[loc[w-1],j]] then p3[n,w]:= [peer2[loc[w-1],j]] + p3[n,w-1] else p3[n,w]:=p3[n,w-1]+p3[n,w]; if n in pm[peer2[loc[w-1],j]] then z2[w]:=z2[w-1]+[n] + z2[w] else z2[w]:=z2[w-1] + z2[w]; end; end else dec(H[w]); if (W = (l-1)) and (comboset[c] = z2[w] ) then begin lx1:=[]; z1:=[]; For N in comboset[c] do for z in list[w] do if (DigitRCB[z,n] * p3[n,w] = p3[n,w] ) then begin lx1:=lx1 + [z]; z1:=z1+[n]; end; if ( L - popcnt(dword(z1)) = 1 ) and (z2[w] + z1 = comboset[c]) then begin for n in (comboset[c] -z1) do for z in ([0..80] - p3[n,w] ) do if (peer[z] * p3[n,w] = p3[n,w] ) and ( n in pm[z] ) then begin active:=true; covered2[n]:= covered2[n] + [z]; end; end; 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} setlength(p3,10,(w+1)); setlength(z2,w+1); until (H[w]> -1) or (w=0) end; end; until (h[W] = -1) end; end; end; if m = 0 then inc(L); until (L = m) or (L > q); { change the 6 to a range of 2-9 to stop the cycles} end; {aDDS}

The New Sudoku Players' Forum

StormDoku

StormDoku

Grid space index

Data sets and type cast

Displaying txt fuctions

initiate, load, save , & functions

Peer building functions

Main Body & controllers

Issomorphic

Pattern Overlay Method

Hidden & Naked Subsets

Fishing

Named Wings

Almost locked Sets

Chains

Distributed Disjoint Subsets