/* Prolog Implementation of Search Methods

 Copyright (c) 1997-2006 Miguel Filgueiras mig@ncc.up.pt Universidade do Porto

    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 2 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 should have received a copy of the GNU General Public License
      along with this program.


	Search predicates use
		trans(State,New_State)		transition between states
		equiv(State1,State2)		equivalence between states

	Heuristics are evaluated by calling
		heur(State,Value)		on state
		dheur(Depth,Value)		on depth

	Function to be optimized is evaluated by calling
		func(Path,Value)
		bound(State,Value)		gives bound on function

	For games:
		move(State,Who,New_State)	Who = min OR max
		final(State,Value)
		eval(State,Value)

*/

%%%% Blind search

/*
	The farmer, the wolf, the sheep and the cabbage:

	State = Boat_whereabouts-List_of_inhabitants_of_left_margin
	Boat_whereabouts = left OR right
	Inhabitants = wolf OR sheep OR cabbage

	trans(left-L,right-L) :- safe(L).
	trans(left-L,right-NL) :- delete(L,E,NL), safe(NL).
	trans(right-L,left-L) :- complement(L,[wolf,sheep,cabbage],RL),
		safe(RL).
	trans(right-L,left-[E|L]) :- complement(L,[wolf,sheep,cabbage],RL),
		delete(RL,E,NRL), safe(NRL).

	safe([]).
	safe([_]).
	safe([wolf,cabbage]).
	safe([cabbage,wolf]).

	equiv(B-Xs,B-Ys) :- eqlist(Xs,Ys).

	?- dsearch(left-[wolf,sheep,cabbage],right-[],P).
	?- bsearch(left-[wolf,sheep,cabbage],right-[],P).
	?- itdeep(left-[wolf,sheep,cabbage],right-[],P).
*/


/* Depth-first search: dsearch(Initial,Final,Path) */

dsearch(I,F,P) :- dsearch(I,F,[I],P).	% 3rd arg is the history

dsearch(St,F,_,[F]) :- equiv(St,F).
dsearch(St,F,H,[St|R]) :- trans_new(St,H,NSt), dsearch(NSt,F,[NSt|H],R).

trans_new(St,H,NSt) :- trans(St,NSt), new_state(H,NSt).

new_state([],_).
new_state([St|H],NSt) :- not(equiv(St,NSt)), new_state(H,NSt).


/* Breadth-first search:   bsearch(Initial,Final,Inverse_Path) */

bsearch(I,F,P) :- bsearch_([I+[]],F,P).  % 1st: list of (node+path) to expand

bsearch_(LNs,F,P) :- bsearch_end(LNs,F,P).	% check final
bsearch_(LNs,F,P) :- bsearch_exp(LNs,F,[],P).	% expand

bsearch_end([N+NP|_],F,[F|NP]) :- equiv(N,F).
bsearch_end([_|R],F,P) :- bsearch_end(R,F,P).

bsearch_exp([],F,[N|NL],P) :- bsearch_([N|NL],F,P).
bsearch_exp([N+NP|R],F,NL,P) :- all_(D+[N|NP],trans_new(N,[N|NP],D),LNs),
	append(NL,LNs,NNL), bsearch_exp(R,F,NNL,P).


/* Iterative deepening: up to depth 100 */

itdeep(I,F,P) :- natural(100,N), itdeep(N,I,F,[I],P).  % 4th arg is the history

itdeep(0,St,F,_,[F]) :- equiv(St,F).
itdeep(N,St,F,H,[St|R]) :- N>0, trans_new(St,H,NSt), K is N-1,
	itdeep(K,NSt,F,[NSt|H],R).


%%%% Heuristic search

/*
	Shortest-path between entry and exit of a maze

	State = (X,Y)	coordinates of crossings and corners

	trans_((0,3),(1,3)).
	trans_((1,3),(2,3)).
	trans_((1,3),(1,1)).
	trans_((1,1),(3,1)).
	trans_((2,3),(2,4)).
	trans_((2,4),(1,4)).
	trans_((1,4),(1,6)).
	trans_((1,6),(2,6)).
	trans_((2,6),(2,5)).
	trans_((2,5),(3,5)).
	trans_((3,1),(3,3)).
	trans_((3,5),(3,3)).
	trans_((3,5),(3,6)).
	trans_((3,3),(4,3)).

	trans(A,B) :- trans_(A,B).
	trans(A,B) :- trans_(B,A).

	equiv(X,X).

	?- dsearch((0,3),(4,3),P).

	heur((X,Y),V) :- Z is ((X-4)*(X-4)+(Y-3)*(Y-3))^0.5, V is -Z.

	?- steep((0,3),(4,3),P).
	?- bestf((0,3),(4,3),P).

	dheur(X,X).

	?- astar((0,3),(4,3),P).

*/

/* Steepest ascent (hill climbing) */

steep(I,F,P) :- steep_([I+[]],F,P).  % 1st: list of (node+path) to expand

steep_(LNs,F,P) :- steep_end(LNs,F,P).	% check final
steep_(LNs,F,P) :- steep_exp(LNs,F,P).	% expand

steep_end([N+NP|_],F,[F|NP]) :- equiv(N,F).
steep_end([_|R],F,P) :- steep_end(R,F,P).

steep_exp([N+NP|R],F,P) :- all_(D+[N|NP],trans_new(N,[N|NP],D),LNs),
	hsort(LNs,SLNs,R), steep_(SLNs,F,P).

hsort([],L,L).    % quicksort decreasing
hsort([N+NP|R],L,Lr) :- heur(N,V), hpart(R,V,Sm,Lg),
	hsort(Lg,L,[N+NP|S]), hsort(Sm,S,Lr).

hpart([],_,[],[]).
hpart([N+NP|R],V,[N+NP|Ln],Lx) :- heur(N,NV), NV=<V, !,
	hpart(R,V,Ln,Lx).
hpart([N+NP|R],V,Ln,[N+NP|Lx]) :- hpart(R,V,Ln,Lx).


/* Best-first search */

bestf(I,F,P) :- bestf_([I+[]],F,P).  % 1st: list of (node+path) to expand

bestf_(LNs,F,P) :- bestf_end(LNs,F,P).	% check final
bestf_(LNs,F,P) :- bestf_exp(LNs,F,P).	% expand

bestf_end([N+NP|_],F,[F|NP]) :- equiv(N,F).
bestf_end([_|R],F,P) :- bestf_end(R,F,P).

bestf_exp([N+NP|R],F,P) :- all_(D+[N|NP],trans_new(N,[N|NP],D),LNs),
	append(LNs,R,NL), hsort(NL,SLNs,[]), bestf_(SLNs,F,P).


/* A* algorithm */

astar(I,F,P) :- astar_([I+[]],F,P).  % 1st: list of (node+path) to expand

astar_(LNs,F,P) :- astar_end(LNs,F,P).	% check final
astar_(LNs,F,P) :- astar_exp(LNs,F,P).	% expand

astar_end([N+NP|_],F,[F|NP]) :- equiv(N,F).
astar_end([_|R],F,P) :- astar_end(R,F,P).

astar_exp([N+NP|R],F,P) :- all_(D+[N|NP],trans_new(N,[N|NP],D),LNs),
	append(LNs,R,NL), asort(NL,SLNs,[]), astar_(SLNs,F,P).

asort([],L,L).    % quicksort decreasing
asort([N+NP|R],L,Lr) :- ahr(N+NP,V), apart(R,V,Sm,Lg),
	asort(Lg,L,[N+NP|S]), asort(Sm,S,Lr).

apart([],_,[],[]).
apart([N+NP|R],V,[N+NP|Ln],Lx) :- ahr(N+NP,NV), NV=<V, !,
	apart(R,V,Ln,Lx).
apart([N+NP|R],V,Ln,[N+NP|Lx]) :- apart(R,V,Ln,Lx).

ahr(N+NP,V) :- heur(N,A), length(NP,X), D is X+1, dheur(D,B), V is A-B.


%%%% Search for an optimum

/*
	Shortest path in a graph (edges all of length 1)

        trans(1,2).     trans(1,3).     trans(1,4).
        trans(2,3).     trans(2,5).     trans(2,7).
        trans(3,5).     trans(3,6).     trans(4,3).
        trans(4,7).     trans(5,6).     trans(5,7).
        trans(6,4).     trans(6,7).

        equiv(X,X).

        func(P,V) :- length(P,X), V is -X.
        estimate(P,V) :- length(P,X), V is -X-1.

        ?- gentest(1,7,Ps,M).

        ?- bbound(1,7,Ps,M).

*/

/* Generate and test: gentest(Initial,Final,Paths,Max_Value)  */

gentest(I,F,Ps,V) :- all(X,dsearch(I,F,X),LP),
	maxof(LP,Ps,V).

maxof([P],[P],V) :- !, func(P,V).
maxof([P|R],Qs,M) :- maxof(R,Ss,X), func(P,Y), maxof(X,Y,Ss,P,M,Qs).

maxof(X,X,Ss,P,X,[P|Ss]) :- !.
maxof(X,Y,Ss,_,X,Ss) :- X>Y, !.
maxof(_,Y,_,P,Y,[P]).


/* Branch and bound: bbound(Initial,Final,Paths,Max_Value)  */

bbound(I,F,Ps,V) :- recorda(cbound,-1e30,_), recorda(csol,[],_),
	bbsearch(I,F), recorded(cbound,V,RV), erase(RV),
	recorded(csol,Ps,RS), erase(RS).

bbsearch(I,F) :- bbsearch(I,F,[I]), fail.
bbsearch(_,_).

bbsearch(St,F,H) :- equiv(St,F), func(H,V), recorded(cbound,B,RB),
	update(V,B,H,RB).
bbsearch(St,F,H) :- estimate(H,V), recorded(cbound,B,_),
	B=<V, trans_new(St,H,NSt), bbsearch(NSt,F,[NSt|H]).

update(V,V,P,_) :- !, recorded(csol,LP,RS), erase(RS),
	recorda(csol,[P|LP],_).
update(V,B,P,RB) :- V>B, !, erase(RB), recorda(cbound,V,_),
	recorded(csol,_,RS), erase(RS), recorda(csol,[P],_).
update(_,_,_,_).


%%%% Game search

/*
	Tic-tac-toe ("jogo do galo")

	State = [[A1,A2,A3],[B1,B2,B3],[C1,C2,C3]]
		where Ai, Bi, Ci are either - OR min OR max

	move([L1,L2,L3],W,[NL,L2,L3]) :- occ(L1,W,NL).
	move([L1,L2,L3],W,[L1,NL,L3]) :- occ(L2,W,NL).
	move([L1,L2,L3],W,[L1,L2,NL]) :- occ(L3,W,NL).

	occ([-|R],W,[W|R]).
	occ([X|R],W,[X|S]) :- occ(R,W,S).

	final(St,1000) :- lncldg(St,[max,max,max]).
	final(St,-1000) :- lncldg(St,[min,min,min]).

	lncldg(St,L) :- member(St,L).	% line.
	lncldg(St,L) :- column(St,L).	% column
	lncldg(St,L) :- diag(St,L).	% diagonal

	column([[A|_],[B|_],[C|_]],[A,B,C]).
	column([[_,A|_],[_,B|_],[_,C|_]],[A,B,C]).
	column([[_,_,A],[_,_,B],[_,_,C]],[A,B,C]).

	diag([[A|_],[_,B|_],[_,_,C]],[A,B,C]).
	diag([[_,_,A],[_,B|_],[C|_]],[A,B,C]).

		% naive evaluation: 2 open in line = 500, otherwise 0
	eval(St,0) :- lncldg(St,L), two(max,L), two(min,L), !.
	eval(St,500) :- lncldg(St,L), two(max,L), !.
	eval(St,-500) :- lncldg(St,L), two(min,L), !.
	eval(_,0).

	two(W,[W,W,-]).  two(W,[W,-,W]). two(W,[-,W,W]).

*/

/* Minimax:  minimax(Initial,Depth,Next_Best,Value)  */

minimax(I,D,N,V) :- minimax(D,I,max,N,V).

minimax(_,St,_,St,V) :- final(St,V), !.
minimax(0,St,_,St,V) :- eval(St,V).
minimax(D,St,W,N,V) :- D>0, all(X,move(St,W,X),Ms),
	opp(W,Z), K is D-1, minimax(Ms,K,W,Z,N,V).

minimax([St],D,_,Z,St,V) :- !, minimax(D,St,Z,_,V).
minimax([St|R],D,W,Z,N,V) :- minimax(D,St,Z,_,X),
	minimax(R,D,W,Z,B,Y), best(W,X,Y,St,B,N,V).

best(max,X,Y,A,_,A,X) :- X>=Y, !.
best(max,_,Y,_,B,B,Y).
best(min,X,Y,A,_,A,X) :- X=<Y, !.
best(min,_,Y,_,B,B,Y).

opp(max,min).
opp(min,max).


%%%% Varia

eqlist([],[]).
eqlist([X|R],L) :- delete(L,X,RL), eqlist(R,RL).

delete([X|R],X,R).
delete([X|R],Y,[X|S]) :- delete(R,Y,S).

complement([],L,L).
complement([X|R],L,C) :- delete(L,X,RL), complement(R,RL,C).

append([],L,L).
append([X|R],S,[X|T]) :- append(R,S,T).

all_(X,P,S) :- all(X,P,S), !.
all_(_,_,[]).

natural(Max,N) :- nat(0,Max,N).

nat(N,_,N).
nat(N,M,K) :- N<M, N1 is N+1, nat(N1,M,K).