
--
-- Copyright (C) 2021  <fastrgv@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You may read the full text of the GNU General Public License
-- at <http://www.gnu.org/licenses/>.
--




with utiltypes;
with splaypq;
with splaylist;
with splaytree;
with text_io;
with emhungarian;
with interfaces.c;

with ada.integer_text_io;
with ada.float_text_io;

with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;

with ada.command_line;
with ada.calendar;

with emutils;


package body emsolver is





-- currently, this is Secondary Solver:
function box4( timeout_sec: float;
	puzz: emutils.puzarray;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- default time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds

	use ada.float_text_io;
	use interfaces.c;
	use Ada.Strings.Unbounded;
	use Ada.Strings.Unbounded.Text_IO;

	use text_io;

	use emutils;
	use mysplaytype;



	--tsec1,
	et,tsec1,tsec9: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);





	pqstatus: mypqtype.statustype;
	exstatus: mysplaytype.statustype;

	ibestcost,ibestpred: vftype;

	omitHungarian: boolean := true; --default for embedded
	pushOpt: boolean := true; --Push-Optimal + BestMoves [hbox4e]

	memoryexit: boolean := false;

	maxGb: constant float := 1.5;

	knodesPerGb: constant float := 2_000.0;





procedure pullup(
	orec: in  hashrectype;
	okey: in  keytype;
	xbr,xbc: in ushort
	) is

	br: ushort := xbr;
	bc: ushort := xbc;
	pr: ushort := br-1;
	pc: ushort := bc;
	ob: constant ushort := indx(br,bc);
	op: constant ushort := indx(pr,pc);
	obr: constant ushort := br;
	obc: constant ushort := bc;
	xplz: ushort := orec.totpulz;
	xmvz: ushort := orec.totmovz;
	mvz: ushort := dppathexists(pr,pc,ibestcost);

begin
	if mvz<254 and testup(br,bc) 
	then 

		vf(ob):=0;
		vf(op):=1;

		br:=pr; bc:=pc;
		pr:=pr-1;
		xplz:=xplz+1;
		xmvz:=xmvz+mvz+1;

		saveifnew4e(orec,okey,0,xplz,xmvz,pr,pc,br,bc);

			vf(op):=0;
			vf(ob):=1;

	end if;
end pullup;


procedure pulldown(
	orec: in  hashrectype;
	okey: in  keytype;  
	xbr,xbc: in ushort
	) is

	br: ushort := xbr;
	bc: ushort := xbc;
	pr: ushort := br+1;
	pc: ushort := bc;
	ob: constant ushort := indx(br,bc);
	op: constant ushort := indx(pr,pc);
	obr: constant ushort := br;
	obc: constant ushort := bc;
	xplz: ushort := orec.totpulz;
	xmvz: ushort := orec.totmovz;
	mvz: ushort := dppathexists(pr,pc,ibestcost);

begin
	if mvz<254 and testdown(br,bc)
	then 

		vf(ob):=0;
		vf(op):=1;

		br:=pr; bc:=pc;
		pr:=pr+1;
		xplz:=xplz+1;
		xmvz:=xmvz+mvz+1;

		saveifnew4e(orec,okey,1,xplz,xmvz,pr,pc,br,bc);

			vf(op):=0;
			vf(ob):=1;

	end if;
end pulldown;


procedure pullleft(
	orec: in  hashrectype;
	okey: in  keytype;  
	xbr,xbc: in ushort
	) is

	br: ushort := xbr;
	bc: ushort := xbc;
	pr: ushort := br;
	pc: ushort := bc-1;
	ob: constant ushort := indx(br,bc);
	op: constant ushort := indx(pr,pc);
	obr: constant ushort := br;
	obc: constant ushort := bc;
	xplz: ushort := orec.totpulz;
	xmvz: ushort := orec.totmovz;
	mvz: ushort := dppathexists(pr,pc,ibestcost);

begin
	if mvz<254 and testleft(br,bc)
	then 

		vf(ob):=0;
		vf(op):=1;

		br:=pr; bc:=pc;
		pc:=pc-1;
		xplz:=xplz+1;
		xmvz:=xmvz+mvz+1;

		saveifnew4e(orec,okey,3,xplz,xmvz,pr,pc,br,bc);

			vf(op):=0;
			vf(ob):=1;

	end if;
end pullleft;


procedure pullright(
	orec: in  hashrectype;
	okey: in  keytype;  
	xbr,xbc: in ushort
	) is

	br: ushort := xbr;
	bc: ushort := xbc;
	pr: ushort := br;
	pc: ushort := bc+1;
	ob: constant ushort := indx(br,bc);
	op: constant ushort := indx(pr,pc);
	obr: constant ushort := br;
	obc: constant ushort := bc;
	xplz: ushort := orec.totpulz;
	xmvz: ushort := orec.totmovz;
	mvz: ushort := dppathexists(pr,pc,ibestcost);

begin
	if mvz<254 and testright(br,bc)
	then 

		vf(ob):=0;
		vf(op):=1;

		br:=pr; bc:=pc;
		pc:=pc+1;
		xplz:=xplz+1;
		xmvz:=xmvz+mvz+1;

		saveifnew4e(orec,okey,2,xplz,xmvz,pr,pc,br,bc);

			vf(op):=0;
			vf(ob):=1;

	end if;
end pullright;















	function itrim( i: integer ) return string is
	begin
		return ada.strings.fixed.trim( integer'image(i), ada.strings.left);
	end itrim;

	function utrim( i: ushort ) return string is
	begin
		return ada.strings.fixed.trim( ushort'image(i), ada.strings.left);
	end utrim;








procedure trymove is
	use mypqtype;
	use mysplaytype;

	rec: hashrectype;

	bog: array(0..3) of integer := (others=>0);

	k,avg4,abog,
	bestbog,
	pri0,pri1,pri2,pri3,pri4: integer := 0;

	iboxes: constant integer := integer(nboxes);

	key: keytype;

	fstat: mypqtype.StatusType;

	estatus: mysplaytype.StatusType;

	--et: float;

	pulls,
	xr,xc, vpr,vpc,
	ii : ushort := 0;

	nbog,
	ole,ile,ilf : integer := 0;

	gb: float := 0.0;
	knodes, pcmem, orobin, robin: integer := 0;


begin --trymove


ole:=0;


outer_main:
loop

	ilf:=mypqtype.length(frontier);
	ile:=mysplaytype.length(explored);

	if false then
		put(" Ex="&itrim(ile));
		put(" Fr="&itrim(ilf));
		put(" avg4="&itrim(avg4));
		put(" abog="&itrim(abog));
		put(" best="&itrim(bestbog)&"/"&utrim(nboxes));
		new_line;
	end if;



	if ile>ole+49999 then

		knodes := ile/1000 + ilf/1000;

		gb := float(knodes)/knodesPerGb;

		if gb > maxGb then
			memoryexit:=true;
			failure:=true;
			exit outer_main; --quit: low memory
		end if;

	end if;




	exit outer_main when ilf=0;


tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer_main when failure;



-- set round robin control parameters:

	orobin:=robin;

	--default round robin:
	--robin := (robin+1) mod 5; -- {0,1,2,3,4}
	robin := (robin+1) mod 4; -- {0,1,2,3}

	abog := (avg4+bestbog)/2; --progress measure...
	--compromise between immediate trend & overall progress



	if bestbog>3*iboxes/4 then --hbox3 very good
		robin:=0; skip3:=true; 
		-- => skip expensive countCorrals ftn (& 2others)
	end if;


-- note hbox4: robin=0..4 (never skip3)
-- note hbox0: robin=0 (always skip3)
--robin:=0; skip3:=true; --hbox0


-- Reasoning behind above control-settings for "robin":
-- It is often true near the beginning and endgame
-- that there are many corrals and blocked rooms.
-- Thus, one initially needs to have all 4 measures in 
-- play to unblock them. Eventually around mid-puzzle 
-- the blockages have been reduced, so one can focus more 
-- on the single measure #BOG. And since one can also expect 
-- blockages @ endgame, we avoid resisting that by ignoring 
-- measures 2,3,4 near endgame.
-- Remember too, this solver is a puller that works backwards.

--pri#1: nb-bog [0=>all boxes on goal]
--pri#2: nCorr - 1
--pri#3: nBlRoom
--pri#4: nBlBox


	case robin is

	when 0 => -- pri1 = #Boxes - #BOG

		mypqtype.popNode(frontier,key,rec,1,pri1,pri2,pri3,pri4,pri0,fstat);

	when 1 => -- pri2 = #corrals - 1

		mypqtype.popNode(frontier,key,rec,2,pri1,pri2,pri3,pri4,pri0,fstat);

	when 2 => --pri3 = #blockedRooms

		mypqtype.popNode(frontier,key,rec,3,pri1,pri2,pri3,pri4,pri0,fstat);

	when 3 => --pri4 = #blockedBoxes

		mypqtype.popNode(frontier,key,rec,4,pri1,pri2,pri3,pri4,pri0,fstat);

	when others => null;
	end case;


	nbog := iboxes - pri1;

	k:=(k+1) mod 4;
	bog(k):=nbog;
	avg4 := ( bog(0)+bog(1)+bog(2)+bog(3) ) / 4;
	-- previous 4 readings shows recent trend



	if nbog>bestbog then bestbog:=nbog; end if;



		--add to {explored}
		mysplaytype.addnode( key, rec, explored, estatus);

--restore2(vf,rec,vpr,vpc);
--rdump0(vf,vpr,vpc);

		swinnertest(solutionPath, key, rec);
		exit outer_main when winner;


		if 
			estatus=Ok -- avoid dupid [Ok => noDup]
		then

			restore2(vf,rec,vpr,vpc);

			--find puller bestcost for each loc in p-corral
			--so that dpPathExists() works correctly within pull*
			dppathprep(vpr,vpc,ibestcost,ibestpred);

			for br in ushort range 2..nrows-1 loop
			for bc in ushort range 2..ncols-1 loop
			if vf( indx(br,bc) ) = 1 then

				pullup(rec,key,br,bc);

				pullright(rec,key,br,bc);

				pulldown(rec,key,br,bc);

				pullleft(rec,key,br,bc);

			end if;
			end loop;
			end loop;

		end if; --status not dupId-------------------------------------------



end loop outer_main;


end trymove;










begin -- box4


	interactive_timeout := ada.calendar.day_duration(timeout_sec);

	failure:=false;
	winner:=false;

	readArr(puzz); --sets pvalid/bvalid arrays, win_key
	emhungarian.inithun(vf,ff,bvalid,nrows,ncols);
	-- here, bvalid is "improved" (further restricted)


	if failure then return false; end if;


	set_unbounded_string(solutionPath, "");
	myassert( length(solutionPath)=0, 98989, "initialSol" );

	hsave0(vf,ff,nrows,ncols,ee,pvalid,omitHungarian);



		tsec0:=ada.calendar.seconds(ada.calendar.clock);

		bestnk:=0;


		trymove;


		tsec9:=ada.calendar.seconds(ada.calendar.clock);



		mysplaytype.make_empty(explored,exstatus);
		mypqtype.make_empty(frontier,pqstatus);



	return winner;

exception
	when others => 
		mysplaytype.make_empty(explored,exstatus);
		mypqtype.make_empty(frontier,pqstatus);
	
		return false;

end box4;








-- currently, this is the Primary Solver:
function puller( timeout_sec: float;
	puzz: emutils.puzarray;
	--ilevel, imaxlevel : integer;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- put a time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds


	timeLim, retryLim : ada.calendar.day_duration;



	use Ada.Strings.Unbounded;
	use Ada.Strings.Unbounded.Text_IO;

	use text_io;
	use emutils;
	use mysplaylist;



	onestep: boolean;

	density,relenting: ushort;

	et,tsec1,
	tsec9: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);







-- puller1...simpler logic versus puller, now taking single steps 
-- when not pulling seems to produced a queue ordering that finds 
-- better solutions.  After first solution is found, the longer
-- search tree branches are skipped.  Now exits only after entire
-- queue is searched.
-- 
--
-- Sokoban Reverse-BFS solver : 
-- a brute-force breadth-first-search in reverse
--
-- Puller-centric version... (good for small,dense puzzles)
-- chooses puller direction {no,so,ea,we} to try
-- and then whether or not to pull any adjacent box.
--
-- An article by Frank Takes shows clear advantages to working from
-- a solved position backwards to the start position, which prevents
-- deadlocked positions from taking up space in the search tree.
-- I am aware that puller-deadlocks are still possible, but they are
-- less problematic because they self-terminate fairly quickly in a BFS.
--
-- This version attempts to detect tunnels
-- and avoids placing configs onto the priority queue that represent
-- partial traversals thru them.  The only exceptions are a) if pulling
-- and the box lands on a box-target;  b) if the puller lands on a
-- puller-target = initial pusher position.
--
-- Uses a splaytree, to test whether a given config was seen before.  
-- Extremely fast access, but can only solve relatively small puzzles
-- due to memory constraints.
--
-- Uses a fullproof Key-type, for which we must define
-- operators "<" and ">".










procedure moveup(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pr:=pr-1;
	moves:=1;
	while 
		ptestup(pr,pc) and 
		not ptestright(pr,pc) and 
		not ptestleft(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pr:=pr-1; 
		moves:=moves+1;
	end loop;
	psaveifnew(okey,0,pr,pc,olp,olm,0,moves);
end moveup;


-- only called if testup=true
procedure pullup(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr+1,pc))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr+1,pc)):=0;
			vf(indx(pr,pc)):=1;
			pr:=pr-1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr+1,pc); --box index
			ip:=indx(pr,pc);

			exit when not ptestup(pr,pc);        --puller blocked
			exit when ff(ib)=2;		--box on goal
			exit when pr=gpr and pc=gpc; --puller on puller goal

			exit when careful and nexus(ib); 
			exit when urgent and bnexus(ib);
			--exit when urgent and enexus(ip);
			exit when urgent and not vtunl(ip);
			exit when onestep;

		end loop;
		psaveifnew(okey,0,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullup;






procedure movedown(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pr:=pr+1;
	moves:=1;
	while 
		ptestdown(pr,pc) and 
		not ptestright(pr,pc) and 
		not ptestleft(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pr:=pr+1; 
		moves:=moves+1;
	end loop;
	psaveifnew(okey,1,pr,pc,olp,olm,0,moves);
end movedown;


-- only called if testdown=true
procedure pulldown(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr-1,pc))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr-1,pc)):=0;
			vf(indx(pr,pc)):=1;
			pr:=pr+1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr-1,pc); --box index
			ip:=indx(pr,pc);

			exit when not ptestdown(pr,pc);
			exit when ff(ib)=2;		--box on goal
			exit when pr=gpr and pc=gpc;

			exit when careful and nexus(ib); 
			exit when urgent and bnexus(ib);
			--exit when urgent and enexus(ip);
			exit when urgent and not vtunl(ip);
			exit when onestep;

		end loop;
		psaveifnew(okey,1,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pulldown;







procedure moveleft(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pc:=pc-1;
	moves:=1;
	while 
		ptestleft(pr,pc) and 
		not ptestup(pr,pc) and 
		not ptestdown(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pc:=pc-1; 
		moves:=moves+1;
	end loop;
	psaveifnew(okey,3,pr,pc,olp,olm,0,moves);
end moveleft;


-- only called when testleft=true
procedure pullleft(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr,pc+1))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr,pc+1)):=0;
			vf(indx(pr,pc)):=1;
			pc:=pc-1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr,pc+1); --box index
			ip:=indx(pr,pc);

			exit when not ptestleft(pr,pc);
			exit when ff(ib)=2;		--box on goal
			exit when pr=gpr and pc=gpc;

			exit when careful and nexus(ib); 
			exit when urgent and bnexus(ib);
			--exit when urgent and enexus(ip);
			exit when urgent and not htunl(ip);
			exit when onestep;

		end loop;
		psaveifnew(okey,3,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullleft;






procedure moveright(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pc:=pc+1;
	moves:=1;
	while 
		ptestright(pr,pc) and 
		not ptestup(pr,pc) and 
		not ptestdown(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pc:=pc+1; 
		moves:=moves+1;
	end loop;
	psaveifnew(okey,2,pr,pc,olp,olm,0,moves);
end moveright;



-- only called when testright=true
procedure pullright(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr,pc-1))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr,pc-1)):=0;
			vf(indx(pr,pc)):=1;
			pc:=pc+1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr,pc-1); --box index
			ip:=indx(pr,pc);

			exit when not ptestright(pr,pc);
			exit when ff(ib)=2;		--box on goal
			exit when pr=gpr and pc=gpc;

			exit when careful and nexus(ib); 
			exit when urgent and bnexus(ib);
			--exit when urgent and enexus(ip);
			exit when urgent and not htunl(ip);
			exit when onestep;

		end loop;
		psaveifnew(okey,2,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullright;



















procedure trymove( retry: boolean := false ) is

	iet,
	diff, newstop, oldstop: integer := 0;
	okey: keytype;
	orec: hashrectype;
	prev, bp : ubyte;
	olm,olp,
	opr, opc : ushort;
	pch: character;
	lbox, rbox, ubox, dbox, changed : boolean;
	use mysplaylist;

	status: mysplaylist.statustype;

begin --trymove


	newstop:=0;

	outer:
	loop

		oldstop:=newstop;
		newstop:=mysplaylist.length(exploring);
		diff:=newstop-oldstop;

		exit outer when diff=0;


tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer when failure;


if (retry and then et>retryLim) 
	then exit outer; end if; --not failure!



		for it in 1 .. diff loop

			if oldstop=0 and it=1 then
				mysplaylist.head( exploring, status ); --put iterator @ list-head
				--myassert( status=Ok, 101, "head error" );
			else
				mysplaylist.next( exploring, status ); --move iterator to next
				--myassert( status=Ok, 102, "next error" );
			end if;


			-- get data from iterator's current position:
			mysplaylist.data( exploring, okey, orec, status ); --get okey, orec
			--myassert( status=Ok, 103, "splay.data error" );



		if
			(orec.ngoals>=ubyte(bestnk/relenting))
		then

			prestore(orec); -- restores arrangement of boxes & puller
			pwinnertest( okey, solutionPath, orec.totpulz, orec.totmovz );
			exit outer when winner;

			prev:= orec.prevmove;
			bp:= orec.boxpull; -- # [straight-line] pulls of this box

			olm:=orec.totmovz;
			olp:=orec.totpulz; --28nov20



			if bp>0 then -- was a pull

				case prev is
					when 0 => pch:='D';
					when 1 => pch:='U';
					when 2 => pch:='L';
					when 3 => pch:='R';
					when others => pch:='X';
				end case;

			else -- was a move with no pull

				case prev is
					when 0 => pch:='d';
					when 1 => pch:='u';
					when 2 => pch:='l';
					when 3 => pch:='r';
					when others => pch:='x';
				end case;

			end if;


			opr:=ushort(orec.prsave);
			opc:=ushort(orec.pcsave);
			lbox:=(vf(indx(opr,opc-1))=1);
			rbox:=(vf(indx(opr,opc+1))=1);
			ubox:=(vf(indx(opr-1,opc))=1);
			dbox:=(vf(indx(opr+1,opc))=1);

			if ptestright(opr,opc) then
				if pch/='r' then
					moveright(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if lbox then pullright(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestleft(opr,opc) then
				if pch/='l' then
					moveleft(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if rbox then pullleft(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestup(opr,opc) then
				if pch/='u' then
					moveup(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if dbox then pullup(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestdown(opr,opc) then
				if pch/='d' then
					movedown(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if ubox then pulldown(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


		end if;

		exit outer when winner;

		end loop; -- inner for it


	end loop outer; -- outer


end trymove;













begin -- puller


	myassert( not failure, 99987, "enter puller");

	interactive_timeout := ada.calendar.day_duration(timeout_sec);
	timeLim := interactive_timeout/5.0;
	retryLim:= interactive_timeout/5.0;


	--level:=ilevel;
	--maxlevel:=imaxlevel;

	winner:=false;

	--readPuzzle(infilname, level);
	readArr(puzz);
	density := 100*gngoals/ushort(nbvalid);

	if failure then return false; end if;

	set_unbounded_string(solutionPath, "");
	myassert( length(solutionPath)=0, 98989, "initialSol" );

	psave0; -- REinitializes splaytree

	bestnk:=0;
	findnexii;

	if density<20 then relenting:=2;
	else relenting:=4; urgent:=true; end if; --debug...not bad! 2dec20


	tsec0:=ada.calendar.seconds(ada.calendar.clock);


	trymove;

	if not winner and not urgent  then
		careful:=true;
		trymove;
	end if;

	if not winner and not urgent then
		urgent:=true;
		trymove;
	end if;

	while not winner  loop
		relenting:=relenting*2;
		exit when relenting>gngoals*4;
		trymove;
	end loop;

	tsec9:=ada.calendar.seconds(ada.calendar.clock);



--------------------------------------------------------------------
----------------- begin solve again, if quick: ---------------------
--------------------------------------------------------------------


		if tsec9-tsec0 < timeLim then 
		-- 1st try took less than timeLim sec, 
		-- so let's retry for more efficient soln:

			careful:=true; urgent:=true; onestep:=true;
			if relenting<4 then relenting:=4; end if;
			bestnk:=0; -- highest #boxes-on-goals so far

			winner:=false;

			--readPuzzle(infilname,level); --needed, for some unknown reason
			vf:=ovf; -- 11dec20
			psave0; -- REinitializes splaytree
			--findnexii;
			tsec0:=ada.calendar.seconds(ada.calendar.clock);

			trymove(true); --need to limit runtime, this time!

		end if;


--------------------------------------------------------------------
----------------- end solve again, if quick: ---------------------
--------------------------------------------------------------------


	return winner;

exception
	when others => return false;

end puller;









-- currently, this is Secondary Solver:
function ibox( timeout_sec: float;
	puzz: emutils.puzarray;
	--ilevel, imaxlevel : integer;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- default time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds


	use Ada.Strings.Unbounded;
	use Ada.Strings.Unbounded.Text_IO;

	use text_io;

	use emutils;
	use mysplaylist;

	onestep: boolean;

	timeLim, retryLim : ada.calendar.day_duration;

	density,relenting: ushort;

	et,tsec1,tsec9: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);


	ibestcost,ibestpred: vftype;

	status: mysplaylist.statustype;




procedure pullup(
	okey: keytype;  olp,olm,xr,xc : ushort; changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br-1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	brc,prc: ushort;
	moves: ushort := dppathexists(pr,pc,ibestcost);
begin --pullup
	changed:=false;
	if moves<254 and then testup(br,bc) then
		changed:=true;
		loop
			vf(indx(pr+1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not testup(br,bc);
			exit when ff(brc)=2;
			exit when careful and nexus( brc ); -- includes box-goals
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when urgent and not vtunl(prc);
			exit when onestep;

		end loop;
		bsaveifnew(okey,0,olp,boxmoves,olm+moves, pr,pc, br,bc);
	end if;
end pullup;






procedure pulldown(
	okey: keytype;  olp,olm,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br+1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	brc,prc: ushort;
	moves: ushort := dppathexists(pr,pc,ibestcost);
begin
	changed:=false;
	if moves<254 and then testdown(br,bc) then
		changed:=true;
		loop
			vf(indx(pr-1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not testdown(br,bc);
			exit when ff(brc)=2;
			exit when careful and nexus( brc ); -- includes box-goals
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when urgent and not vtunl(prc);
			exit when onestep;

		end loop;
		bsaveifnew(okey,1,olp,boxmoves,olm+moves, pr,pc, br,bc);
	end if;
end pulldown;






procedure pullleft(
	okey: keytype;  olp,olm,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc-1;
	boxmoves: ushort := 0;
	brc,prc: ushort;
	moves: ushort := dppathexists(pr,pc,ibestcost);
begin
	changed:=false;
	if moves<254 and then testleft(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc+1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not testleft(br,bc);
			exit when ff(brc)=2;
			exit when careful and nexus( brc ); -- includes box-goals
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when urgent and not htunl(prc);
			exit when onestep;

		end loop;
		bsaveifnew(okey,3,olp,boxmoves,olm+moves, pr,pc, br,bc);
	end if;
end pullleft;






procedure pullright(
	okey: keytype;  olp,olm,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc+1;
	boxmoves: ushort := 0;
	brc,prc: ushort;
	moves: ushort := dppathexists(pr,pc,ibestcost);
begin
	changed:=false;
	if moves<254 and then testright(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc-1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not testright(br,bc);
			exit when ff(brc)=2;
			exit when careful and nexus( brc ); -- includes box-goals
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when urgent and not htunl(prc);
			exit when onestep;

		end loop;
		bsaveifnew(okey,2,olp,boxmoves,olm+moves, pr,pc, br,bc);
	end if;
end pullright;





















	function itrim( i: integer ) return string is
	begin
		return ada.strings.fixed.trim( integer'image(i), ada.strings.left);
	end itrim;

	function utrim( i: ushort ) return string is
	begin
		return ada.strings.fixed.trim( ushort'image(i), ada.strings.left);
	end utrim;




-- time limit algo#1, before which retry is attempted:
--timeLim : ada.calendar.day_duration -- := 2.0; --seconds
--	interactive_timeout/5.0;

-- [retry] time limit algo#2
--retryLim : ada.calendar.day_duration -- := 2.0; --seconds
--	interactive_timeout/5.0;





--relenting: ushort := 0;

procedure trymove(retry: boolean := false) is
	depth,
	odiff,diff, newstop, oldstop, avg2: integer := 0;
	okey: keytype;
	orec: hashrectype;
	olm,olp, opr, opc, ii : ushort;
	difference : boolean;
	--ich: character;
	--avail: boolean := false;

begin --trymove

	newstop:=0;

	outer:
	loop

		depth:=depth+1;
		oldstop:=newstop;
		newstop:=mysplaylist.length(exploring);
		diff := newstop-oldstop;
		exit when diff=0;


tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer when failure;

if (retry and then et>retryLim) 
	then exit outer; end if; --not failure!


		for it in 1 .. diff loop


			if oldstop=0 and it=1 then
				mysplaylist.head( exploring, status ); --put iterator @ list-head
				--myassert( status=Ok, 101, "head error" );
			else
				mysplaylist.next( exploring, status ); --move iterator to next
				--myassert( status=Ok, 102, "next error" );
			end if;

			-- get data from iterator's current position:
			mysplaylist.data( exploring, okey, orec, status ); --get okey, orec
			--myassert( status=Ok, 103, "splay.data error" );

			olp:=orec.totpulz;
			olm:=orec.totmovz;


		if 
			(orec.ngoals>=ubyte(bestnk/relenting)) --greediness
		then --otherwise, no chance to improve


			brestore(orec, opr,opc); --,opr,opc);
			bwinnertest(okey,solutionPath,olp,olm);
			exit outer when winner;
			dppathprep(opr,opc,ibestcost,ibestpred);



			-- do a lexicographic search for boxes,
			-- then try to move it in 4 directions:
			for br in 2..nrows-1 loop
			for bc in 2..ncols-1 loop


				ii:=indx(br,bc);

				if vf(ii)=1 and ee(ii)<256 then --process this box

					pullright(okey,olp,olm,br,bc,difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullleft(okey,olp,olm,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullup(okey,olp,olm,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pulldown(okey,olp,olm,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


				end if;

			end loop; --bc
			end loop; --br

		end if;

		end loop; --it


	end loop outer; -- while




end trymove;





begin -- ibox

	interactive_timeout := ada.calendar.day_duration(timeout_sec);
	timeLim := interactive_timeout/5.0;
	retryLim:= interactive_timeout/5.0;


	--level:=ilevel;
	--maxlevel:=imaxlevel;

	failure:=false;
	winner:=false;

	--readPuzzle(infilname,level);
	readArr(puzz);
	density := 100*gngoals/ushort(nbvalid);

	if failure then return false; end if;

	set_unbounded_string(solutionPath, "");

	myassert( length(solutionPath)=0, 98989, "initialSol" );

	bsave0; -- REinitializes splaytree
	bestnk:=0;
	findnexii;



		if density<20 then relenting:=2;
		else relenting:=4; urgent:=true; end if;

		tsec0:=ada.calendar.seconds(ada.calendar.clock);

		bestnk:=0;

		trymove;
		if not winner and not urgent  then
			careful:=true;
			trymove;
		end if;
		if not winner and not urgent  then
			urgent:=true;
			trymove;
		end if;
		while not winner  loop
			relenting:=relenting*2;
			exit when relenting>gngoals*4;
			trymove;
		end loop;

		tsec9:=ada.calendar.seconds(ada.calendar.clock);



--------------------------------------------------------------------
----------------- begin solve again, if quick: ---------------------
--------------------------------------------------------------------

		if tsec9-tsec0 < timeLim then
		-- 1st try took a fraction of alotted time, 
		-- so let's retry for more efficient soln:

			careful:=true; urgent:=true; onestep:=true;
			if relenting<4 then relenting:=4; end if;
			bestnk:=0; -- highest #boxes-on-goals so far

			winner:=false;

			--readPuzzle(infilname,level); --needed, for some unknown reason
			vf:=ovf; -- 11dec20
			bsave0; -- REinitializes splaytree
			--findnexii;
			tsec0:=ada.calendar.seconds(ada.calendar.clock);

			trymove(true); --need to limit runtime, this time!

		end if;

--------------------------------------------------------------------
----------------- end solve again, if quick: ---------------------
--------------------------------------------------------------------
	mysplaylist.make_empty(exploring,status); -- 12jan21


	return winner;

exception
	when others => 
	mysplaylist.make_empty(exploring,status); -- 12jan21
	return false;

end ibox;










end emsolver;
