% search.pl version 1.1: automaton expansion included
:- dynamic visited/1, fringe/1, node/2, var/2,initial/1, goal/1, h/2, transition/4, write_action/1,write_state/1.
:- dynamic var/2, trans/3.


set_var(X,V) :- (retract(var(X,_)),!;true),assert(var(X,V)).
incr_var(X,V,I) :- retract(var(X,V)),V1 is V+I, assert(var(X,V1)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% a node has the form n(State,ParentNodeNum,Action,Cost,Depth)

new_node(N,I):- node(I,N),!.
new_node(N,I):- incr_var(nextnode,I,1), assert(node(I,N)).

store_trans(S1,S2,C) :- var(automaton,1),!,(trans(S1,S2,C),!;assert(trans(S1,S2,C))).
store_trans(_,_,_).

config(depth,list,first).
config(breadth,list,last).
config(uniform,heap,priority_c).
config(greedy,heap,priority_h).
config(a_star,heap,priority_f).

load_domain(D) :-
    (retractall(initial(_)),!;true),
    (retractall(goal(_)),!;true),
    (retractall(transition(_,_,_,_)),!;true),
    (retractall(h(_,_)),!;true),
    (retractall(write_action(_)),!;true),
    (retractall(write_state(_)),!;true),
    consult(D).

search(Domain,Algorithm) :- search(Domain,Algorithm,_).
search(Domain,Algorithm,Plan) :-
    (config(Algorithm,_,_),!;write_all(['Unrecognized algorithm ',Algorithm]),nl,fail),
    load_domain(Domain),
    set_var(algorithm,Algorithm),
    (retractall(node(_,_)),!;true),
    (retractall(visited(_)),!;true),
    (retractall(trans(_,_,_)),!;true),
    set_var(nextnode,0),
    set_var(expanded_nodes,0),
    set_var(max_fringe,0),
    initial(S),
    new_node(n(S,none,none,0,0),I),
    empty_fringe(F),
    insert_fringe([I],F,F1),

    (time(graph_search(F1,Sol)),!,get_plan(Sol,Plan); write('Search failed.'),nl,Plan=fail),

    var(expanded_nodes,EN),
    write_all(['Expanded nodes: ',EN,'\n']),
    var(max_fringe,MF),
    write_all(['Maximum fringe size: ',MF,'\n']).

expand(I,n(S,_,_,C,D),J) :-
    incr_var(expanded_nodes,_,1),
    transition(S,A,S1,AC),
    C1 is C+AC,
    D1 is D+1,
    N=n(S1,I,A,C1,D1),
    new_node(N,J),
    store_trans(S,S1,AC).  % only for automaton construction

graph_search(F,_):- empty_fringe(F),!,fail.

graph_search(F,Sol) :-
    pop_fringe(F,I,F1),
    node(I,N),
    N=n(S,_,_,_,_),
    ( check_goal(S),!,Sol=I
    ; visited(S),!,retract(node(I,N)),graph_search(F1,Sol)
    ; assert(visited(S)),
      findall(J,expand(I,N,J),Js),
      insert_fringe(Js,F1,F2),
      graph_search(F2,Sol)
    ).

check_goal(S) :- var(automaton,1),!,fail; goal(S).   % When building the automaton, we ignore the goal

execute(S,[]):-!,write_state(S).
execute(S,[A|As]):- write_state(S),nl,write_action(A),nl,transition(S,A,S1,_),!,execute(S1,As).
		 
get_plan(I,Plan) :-
    solution_path([],I,Path),
    write_plan(Path,Plan),nl,
    node(I,n(_,_,_,C,D)),
    write_all(['Depth: ',D]),nl,
    write_all(['Cost: ',C]),nl.

solution_path(Js,I,L):- node(I,n(_,J,_,_,_)), (J=none,!,L=Js; solution_path([I|Js],J,L)).

write_plan(Path,Plan):-
    findall(Act,(member(J,Path),node(J,n(_,_,Act,_,_)) ),Plan),
    ( var(verbose,1),!,
      repeat,
      (member(I,Path),node(I,n(S,_,A,_,_)),write_action(A),nl,write_state(S),nl,fail; true),!
    ; write(Plan)).

%%%%% Different types of fringe operations

empty_fringe(F) :- var(algorithm,A),(config(A,list,_),!,F=[]; empty_heap(F)).
insert_fringe(Is,F,F1) :-
    var(algorithm,A),config(A,Type,P),
    (Type=list,!,
          (P=first,!,append(Is,F,F1); P=last,append(F,Is,F1)),
           length(F1,N)
    ;Type=heap,!,insert_heap(Is,F,F1), heap_size(F1,N)
    ),var(max_fringe,M), (N>M,!,set_var(max_fringe,N);true).
pop_fringe(F,X,F1) :- var(algorithm,A),(config(A,list,_),!,F=[X|F1]; get_from_heap(F,_,X,F1)).
priority(I,Pr) :- var(algorithm,A),config(A,_,P),!, Call =.. [P,I,Pr], Call.

insert_heap([],F,F) :- !.
insert_heap([I|Is],F,Fn) :- priority(I,P),add_to_heap(F,P,I,F1),insert_heap(Is,F1,Fn).

priority_c(I,C) :- node(I,n(_,_,_,C,_)).  % Using the path cost = Dijkstra's algorithm
priority_h(I,H) :- node(I,n(S,_,_,_,_)), (h(S,H),!;H=0).
priority_f(I,F) :- node(I,n(S,_,_,C,_)), (h(S,H),!;H=0), F is C+H.

%%%%%% Display predicates
write_all([]) :- !.
write_all([X|Xs]):- write(X), write_all(Xs).
			  
:- ['automaton.pl'].