

--
-- Copyright (C) 2019  <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/>.
--


-- Sokoban Reverse-BFS solver : 
-- a brute-force breadth-first-search in reverse
--
-- ibox3:  BoxInertia...[fixed-urgency] tunnel skipper+relent.
-- Not purely BFS so...after first solution is found, 
-- the longer search tree branches are skipped.  
-- Now exits only after entire queue is searched.
--
-- Inertial Box-centric version (for larger/lishout puzzles)...
-- choose a box, then direction to move it as far as possible
-- in that same direction, while saving critical intermediate 
-- positions. Ignores exact puller position but saves puller-corral.
--
-- 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 ">".







with splaylist;
with text_io;

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

with ada.command_line;
with ada.calendar;

with utils;



procedure ibox3 is


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

	use text_io;
	use utils;
	use mysplay;








-- these test box-moves




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










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

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br-1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	irc: ushort;
begin --pullup
	changed:=false;
	if dppathexists(pr,pc) and then btestup(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;
			irc := indx(br,bc);

			exit when not btestup(br,bc);
			exit when ff(irc)=2;
			exit when bnexus(irc); --Bvalid+Enexus
			exit when enexus(indx(pr,pc));

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






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

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br+1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	irc: ushort;
begin
	changed:=false;
	if dppathexists(pr,pc) and then btestdown(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;
			irc := indx(br,bc);

			exit when not btestdown(br,bc);
			exit when ff(irc)=2;
			exit when bnexus(irc);
			exit when enexus(indx(pr,pc));

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






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

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc-1;
	boxmoves: ushort := 0;
	irc: ushort;
begin
	changed:=false;
	if dppathexists(pr,pc) and then btestleft(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;
			irc := indx(br,bc);

			exit when not btestleft(br,bc);
			exit when ff(irc)=2;
			exit when bnexus(irc);
			exit when enexus(indx(pr,pc));

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






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

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc+1;
	boxmoves: ushort := 0;
	irc: ushort;
begin
	changed:=false;
	if dppathexists(pr,pc) and then btestright(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;
			irc := indx(br,bc);

			exit when not btestright(br,bc);
			exit when ff(irc)=2;
			exit when bnexus(irc);
			exit when enexus(indx(pr,pc));

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





















procedure trymove is
	odiff,diff, newstop, oldstop, avg2: integer := 0;
	okey: keytype;
	orec: hashrectype;
	opr, opc, ii : ushort;
	bxfrac : float;
	difference : boolean;
begin --trymove

	if relent then
		put_line("################### relented Mode");
	else
		put_line("################### UNrelented Mode");
	end if;

	newstop:=0;

	loop

		--exit when winner;

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



		bxfrac := float(bestnk*100)/float(gngoals+1);
		-- in order to win, we must end up with puller in the
		-- proper corral, in addition to positioning all boxes.


		if winner then
			--put_line("#########WINNER################");
			null;
		else
		--if not winner then
			put(" NewCfg="&integer'image(newstop-oldstop));
			put(" depth="&integer'image(depth)&", %=");
			myfloat_io.put(item=>bxfrac,fore=>2,aft =>1,exp=>0);
			if newstop<2000 then
				put(" TotCfg="&integer'image(newstop));
			else
				put(" TotCfg(k)="&integer'image(newstop/1000));
			end if;
			new_line;
		end if;


		for it in 1 .. diff loop

			--exit when winner;

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

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

			olpulz:=orec.totpulz;

		if 
			(olpulz+1<minBoxPulls) --only works AFTER 1st soln
			and 
			(
				relent or 
				(orec.ngoals>=ubyte(bestnk/2)) --skip if not half of best
			)
		then --otherwise, no chance to improve



			brestore(orec, opr,opc); --,opr,opc);
			dppathprep(opr,opc);


			-- 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,br,bc,difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


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


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


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


				end if;

			end loop; --bc
			end loop; --br2

		end if;

		end loop; --it::944


	end loop; -- while::940




end trymove;




	Ok: boolean;

begin -- ibox2

	checkForUserFile(Ok);
	-- defines:  infilname, level, maxlevel

	if Ok then

		winner:=false;

		readPuzzle(level);

		put_line(" nrows="&ushort'image(nrows));
		put_line(" ncols="&ushort'image(ncols));
		put_line(" pfmax="&ushort'image(pfmax));
		put_line(" nBox="&ushort'image(gngoals));

		myassert( mysplay.length(mytree) = 0, 99999, "initialSplay" );

		bsave0;

		findnexii;

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

		depth:=0;


		trymove;

		if not winner then
			relent:=true;
			trymove;
		end if;


		if not winner then
			new_line;
			put_line("Failure to find solution.");
		else
			put_line("Winner=========================================");
		end if;

		put_line(" minBoxPulls="&ushort'image(minBoxPulls));

		put_line(" nrows="&ushort'image(nrows));
		put_line(" ncols="&ushort'image(ncols));
		put_line(" pfmax="&ushort'image(pfmax));
		put_line(" nBox="&ushort'image(gngoals));
		put_line(" ibox3: tunnel-skipper + relent");

		bdump(0,0); --show nexii on screen
		dumpvalid;

	end if;

exception
	when storage_error =>
		put_line("Memory insufficient to solve this problem with this algorithm!");
		raise;


end ibox3;
