

separate( asud )

-- returns 1st Xcycle, bad or good

procedure goodXcycle(
	xcycle: in out xcycletype;
	ca, cz: out ocoords;
	odig : out i9;
	found, bad: out boolean;
	deletable: out candidatetype;
	forceoutput: in boolean := false
	) is

-- a bad Xcycle has an odd # cells
-- where the first & last are in same house;
-- a good Xcycle has an even # cells.

-- odd links are weak:		dig@A => not dig@B
-- even links are strong:	not dig@A => dig@B
--
-- ca is ON so look for a weak link to cb
-- using any cell in same house with digit=d;
--
-- then cb is OFF so look for a strong link to cc
-- using 3 predefined arrays: rowPair, colPair, boxPair:
-- rowPair(d,c1)=c2, colPair(d,r1)=r2,
-- and boxPair(d, bn, i1) = i2


	npairs: integer := 0; --track length of xCycle

--------------------------------------------------------------------------


--ftn "match"...
--input: coords of 2 cells
--output: 
--		0=>no visibility
--		1=>visibility (same house)
function match( cell1, cell2: ocoords ) return integer is
	r1,c1, r2,c2,
	br1,bc1,b1, br2,bc2,b2: integer;
begin
	r1:=cell1(1); c1:=cell1(2);
	r2:=cell2(1); c2:=cell2(2);

	br1:= (r1-1)/3;		--0..2	zero-based box row
	bc1:= (c1-1)/3; 		--0..2	zero-based box col
	b1 := br1*3 + bc1;	--0..8	lexicographic box number

	br2:= (r2-1)/3;		--0..2
	bc2:= (c2-1)/3;		--0..2
	b2 := br2*3 + bc2;	--0..8

--  rowmatch  colmatch  boxmatch

	if r1=r2 then -- rowmatch
		return 1;
	elsif c1=c2 then -- colmatch
		return 1;
	elsif b1=b2 then -- boxmatch
		return 1;
	else
		return 0;
	end if;

end match;





-- if any, find cs: 1st house pair of cw (OTHER than ca)
-- Note: this version does NOT avoid c0 to allow closing loop!
procedure strongsearch(
	idg: in i9; 
	c0, ca, cw: in ocoords; 
	cs: out ocoords; 
	ssfound: out boolean) is

	boxnum,
	br,bc,cellw, rx,cx,cellx, cc,cr : integer;
	ok: boolean;
begin

--need ca to avoid using it again...

	ssfound:=false;



	--search row of cw [cw(1)]
	for c in 1..9 loop
	ok := ca(1)/=cw(1) or ca(2)/=c; --avoid ca
	if not ssfound and ok and c/=cw(2) --avoid cw
	and rowPair(idg,cw(1),cw(2))=c 
	and rowPair(idg,cw(1),c)=cw(2)
	then
		ssfound:=true;
		cs(1):=cw(1);
		cs(2):=c;
	end if;
	end loop; --c



	--search col of cw [cw(2)]
	for r in 1..9 loop
	ok := ca(1)/=r or ca(2)/=cw(2); --avoid ca 21
	if not ssfound and ok and r/=cw(1) --avoid cw 26
	and colPair(idg,cw(2),cw(1))=r 
	and colPair(idg,cw(2),r)=cw(1)
	then --56=bad (r=5)
		ssfound:=true;
		cs(1):=r;
		cs(2):=cw(2);
	end if;
	end loop; --r



	--search box of cw
	br:= ( cw(1) - 1 ) / 3; -- 0..2 = box-row of cw 1
	bc:= ( cw(2) - 1 ) / 3; -- 0..2 = box-col of cw 1
	boxnum:=br*3+bc+1; -- 1..9: lexicographic box#  6

	cr:=(cw(1)-1)-br*3;--0..2: zero-based row within box of cw
	cc:=(cw(2)-1)-bc*3;--0..2: 0-based col w/in box of cw
	cellw:=cr*3+cc+1; --1..9: lexicographic pos of cw within box

	for r in 0..2 loop
	for c in 0..2 loop
	rx:=br*3+r+1; -- 1..9: row of cx
	cx:=bc*3+c+1; -- 1..9: col of cx
	cellx:=r*3+c+1; -- 1..9 = pos within box of cx
	ok := ca(1)/=rx or ca(2)/=cx; --avoid ca
	if not ssfound and ok
	and (rx/=cw(1) or cx/=cw(2)) --avoid cw
	and boxPair(idg,boxnum,cellw)=cellx 
	and boxPair(idg,boxnum,cellx)=cellw 
	then
		ssfound:=true;
		cs(1):=rx;
		cs(2):=cx;
	end if;
	end loop; --c
	end loop; --r



end strongsearch;


lastcw: ocoords;

procedure add2links(ca, cw, cs: ocoords) is
--due to the recursive nature of the search, some
--of these links get overwritten. But once the loop
--is closed, there are no more changes.
begin

	npairs:=npairs+1;

	xcycle( ca(1), ca(2) ) := cw;
	xcycle( cw(1), cw(2) ) := cs;

	lastcw:=cw;

end add2links;




procedure add1link(ca, cw: ocoords) is
begin

	npairs:=npairs+1;

	xcycle( ca(1), ca(2) ) := cw;
	xcycle( cw(1), cw(2) ) := cw; --bogus but allows Red Draw

	lastcw:=cw;

end add1link;









--recursive proc...
--due to the recursive nature of the search,
--some links in a failed branch get overwritten. 
--But once the loop is closed, 
--there are no more changes.
--
-- This proc develops a chain from c0 to cz=c0.
-- If you assume c0 is ON then read chain forward.
-- It works equally well to assume c0 is OFF,
-- if you read chain backward.
procedure nextChainPair( 
	idig: in i9;
	c0,					--root cell ON
	ca: in ocoords; 	--this cell ON
	cz: out ocoords; 	--final cell ON and equals c0
	victor, goodCycle : out boolean) is

	cw, cs: ocoords; -- Weak, Strong

	notseen, ok2,
	sfound, fail: boolean:=false;
	boxnum: i9;

	br0,bc0,cellrow,cellcol,
	rx,cx,cellx,
	bra,bca,cella: integer;

begin
	victor:=false;
	goodCycle:=false;

	--We assume ca has idig:ON

	--Note that xcycle(r,c)(1)=0 is a test to avoid revisiting same cell

------------------------------------------------------------

	--weakrowsearch...simply find one:
	for c in 1..9 loop --try each col in same row as ca
	notseen := xcycle( ca(1), c )(1)=0;
	if not victor and c/=ca(2) and notseen and not fail then
		ok2 := rowPair(idig,ca(1),ca(2)) /= c; --ca is NOT a rowpair with cw
		if ok2 and candidate( ca(1), c )(idig) then
			cw(1):=ca(1);
			cw(2):=c; --idig OFF...weaklink found in same row
			strongsearch(idig,c0,ca,cw,cs,sfound); 
			--find any housemate of cw that is one of a pair
			if sfound then
				if match(c0,cs)=0 then --cs cannot see starting cell
					add2links(ca,cw,cs); --cs is ON
					nextChainPair(idig,c0,cs,cz,victor,goodCycle);

				elsif cs=c0 then --close the loop
					add1link(ca,cw);
					victor:=true;
					goodCycle:=true;
					odig:=idig;

				else -- cs shares house with c0
					fail:=true; --badXcycle
				end if;
			end if; --not sfound
		end if; --candidate
	end if; --not victor
	end loop; --c

------------------------------------------------------------

	--weakcolsearch...simply find one
	for r in 1..9 loop --try each row in same col as ca
	notseen := xcycle(r,ca(2))(1)=0; --cw not yet visited in this chain
	if not victor and r/=ca(1) and notseen and not fail then
		ok2 := colPair(idig,ca(2),ca(1)) /= r; --ca is NOT a colpair of cw
		if ok2 and candidate( r, ca(2))(idig) then
			cw(1):=r;
			cw(2):=ca(2); --idig OFF weaklink found in same col
			strongsearch(idig,c0,ca,cw,cs,sfound);
			--find any housemate of cw that is one of a pair
			if sfound then
				if match(c0, cs)=0 then --cs cannot see starting cell
					add2links(ca,cw,cs); --cs ON
					nextChainPair(idig,c0,cs,cz,victor,goodCycle);

				elsif cs=c0 then --close the loop
					add1link(ca,cw);
					victor:=true;
					goodCycle:=true;
					odig:=idig;

				else --cs shares house with c0
					fail:=true; --badXcycle
				end if;
			end if; --sfound
		end if; --candidate
	end if; --not victor
	end loop; --c


------------------------------------------------------------


	--weakboxsearch...simply find one
	bra:= ( ca(1) - 1 ) / 3; --0..2
	bca:= ( ca(2) - 1 ) / 3; --0..2
	boxnum := bra*3+bca+1; --1..9	

	br0:=bra*3+1; --1..7: row of box UL cell
	bc0:=bca*3+1; --1..7: col of bux UL cell
	cellrow:=ca(1)-br0; --0..2: row of ca within its box
	cellcol:=ca(2)-bc0; --0..2: col of ca within its box
	cella := cellrow*3+cellcol+1; --1..9: lexicographic cell# of ca within its box

	for r in 0..2 loop
	for c in 0..2 loop
	rx:=bra*3+r+1; --1..9 true row# of cw
	cx:=bca*3+c+1; --1..9 true col# of cw
	cellx:=r*3+c+1; --1..9 lexi cell# of cw withiin box of ca
	notseen:=xcycle(rx,cx)(1)=0; --cw not yet visited in this chain
	if not victor and cellx/=cella and notseen and not fail then
		ok2 := boxPair(idig, boxnum, cellx) /= cella; --cw is NOT a boxpair of ca
		if ok2 and candidate(rx,cx)(idig) then
			cw(1):=rx;
			cw(2):=cx; --idig OFF weaklink found in same box

			strongsearch(idig,c0,ca,cw,cs,sfound);
			--find any housemate of cw that is one of a pair

			if sfound then
				if match(c0, cs)=0 then --cs cannot see starting cell
					add2links(ca,cw,cs); -- cs ON
					nextChainPair(idig,c0,cs,cz,victor,goodCycle);

				elsif cs=c0 then --close the loop
					add1link(ca,cw);
					victor:=true;
					goodCycle:=true;
					odig:=idig;

				else -- cs is in same house as c0
					fail:=true; --badXcycle
				end if; --not done
			end if; --not sfound
		end if; --candidate
	end if; --not victor
	end loop; --c
	end loop; --r


end nextChainPair;

--------------------------------------------------------------------------

	kount: integer := 0;
	victory, good : boolean := false;

	xxon,xxoff,
	xcell, oncell, offcell: ocoords;

	debug: constant boolean := false;

begin --findXcycle: 1st only

	found:=false;

	for r in 1..9 loop
	for c in 1..9 loop	--for each cell
	for d in 1..9 loop	--for each digit

	if not victory and candidate(r,c)(d) then

		npairs:=0;
		xcycle:=(others=>(others=>(others=>0)));
		ca(1):=r; ca(2):=c;

		--we assume ca is ON



		-- recursive proc:
		nextChainPair( d, ca, ca, cz, victory, good  );

		if victory and good then

	set_unbounded_string( consoleBuf, "");
	append(consoleBuf,crlf);
	append(consoleBuf," dig="&i2st(d));
	append(consoleBuf,crlf);

			--now runthru finalized linkages 
			--to set xoncycle, xoffcycle arrays properly
			xoncycle:=(others=>(others=>false));
			xoffcycle:=(others=>(others=>false));
			xxon:=ca;
			xxoff:=xcycle(xxon(1),xxon(2));
			loop

				xoncycle(xxon(1),xxon(2)):=true;
				xoffcycle(xxoff(1),xxoff(2)):=true;

	append(consoleBuf," On:"&i2st( xxon(1) )&i2st( xxon(2) ));
	append(consoleBuf,",");
	append(consoleBuf," Off:"&i2st( xxoff(1) )&i2st( xxoff(2) ));
	append(consoleBuf,crlf);


				--update xxon
				xxon:=xcycle(xxoff(1),xxoff(2));
				exit when xxoff=xxon; --signals EndOfChain
				xxoff:=xcycle(xxon(1),xxon(2));

			end loop;

		end if; --victory & good



		bad:=not good;
		if npairs<1 then victory:=false; end if;

		deletable:=(others=>(others=>(others=>false)));

		if victory and good  then --fill deletable array

			cz:=lastcw;

			kount:=0;

			--now we mark as deletable any non-cycle-chain digit
			--that can see 2 cycle digits of different "colors".
			for xrow in 1..9 loop
			for xcol in 1..9 loop
			xcell(1):=xrow; xcell(2):=xcol;
			if candidate(xrow,xcol)(d) 
			and not xoncycle(xrow,xcol) 
			and not xoffcycle(xrow,xcol) 
			then 	--test this cell: xcell (off-chain)

				for onr in 1..9 loop
				for onc in 1..9 loop
				oncell(1):=onr; oncell(2):=onc;
				if xoncycle(onr,onc) and match(xcell,oncell)>0 then
				--xcell sees oncell

					for ofr in 1..9 loop
					for ofc in 1..9 loop
					offcell(1):=ofr; offcell(2):=ofc;
					if xoffcycle(ofr,ofc) and match(xcell,offcell)>0 then
					--xcell also sees offcell
						deletable(xrow,xcol)(d):=true;
						kount:=kount+1;

	--debug output here:
	if debug then
	put(
	i2st(xrow)&i2st(xcol)&" sees "&
	i2st(onr)&i2st(onc)&"=ON, and also "&
	i2st(ofr)&i2st(ofc)&"=OFF");
	new_line;
	end if;

					end if;
					end loop; --ofc
					end loop; --ofr

				end if;
				end loop; --onc
				end loop; --onr

			end if;
			end loop; --xcol
			end loop; --xrow

		end if; -- victory and good


		if kount=0 then --no deletables for this nice loop
			victory:=false; --continue looking
		end if;

	end if; --not victory
	end loop; --d
	end loop; --c
	end loop; --r

	if kount=0 then
		if forceoutput then
			put(consoleBuf);
		end if;
		put(" good-xCycle: No deletables found.");
		new_line;
	else
		put(consoleBuf);
	end if;

	found := victory and (kount>0); --only bother if something to show

end goodXcycle;

