1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE    : lib/alpha_star.pl
    4%
    5%    Abstract A* Algorithm Variation
    6%
    7%    DESCRIPTION:    An A* path finding implementation for use with
    8%                    indigolog programs.
    9%    ORIGINAL:	     http://www.csupomona.edu/~jrfisher/www/prolog_tutorial/5_1.html
   10%    LAST REVISED:	 Stavros Vassos (March 8st, 2005)
   11%    
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13%
   14%
   15%    MAIN PREDICATE: pathfind(+Start, +End, -Solution)
   16%    NEEDS:          pathfind_move(+Start, -End, -Action) 
   17%                       pathfind_move/3 specifies what moves can be achieved 
   18%                       and where they leed to
   19%                    pathfind_heuristic(+State,+Goal,-H)
   20%                       pathfind_heuristic/3 specifies a heuristic metric needed
   21%                       for prioritizing the possible actions
   22%    
   23%    NOTES:          
   24%                    - All predicates in this file have the prefix "pathfind" so
   25%                    that there is no conflict with any other library.
   26%    
   27%    NOTES/DESCRIPTION FROM ORIGINAL:
   28%     Nodes have form    S#D#F#A
   29%            where S describes the state or configuration
   30%                  D is the depth of the node
   31%                  F is the evaluation function value
   32%                  A is the ancestor list for the node
   33%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   34
   35:- multifile pathfind_f_function/6.   36	
   37:- op(400,yfx,'#').    /* Node builder notation */
   38%:- dynamic(pathf/1).
   39
   40
   41%path finding that takes considers exactly one heuristic function along with the depth of
   42%the search so far. pathfind_f_function is the actual function used to order the nodes,
   43%pathfind_heuristic is the one given by the user
   44pathfind(State,Goal,Soln) :- 
   45		pathfind_f_function(State,Goal,0,F),
   46		%retractall(pathf(_)),
   47		pathfind_search([State#0#F#[]],Goal,S), reverse(S,Soln).
   48
   49pathfind_f_function(State,Goal,D,F) :- pathfind_heuristic(State,Goal,H), F is D + H.
   50
   51pathfind_search([State#_#_#Soln|_], State, Soln).
   52pathfind_search([B|R],Goal,S) :- 
   53		%B = State#_#_#_,
   54		%assert(pathf(State)),
   55		pathfind_expand(B,Goal,Children),
   56		pathfind_insert_all(Children,R,Open),
   57		pathfind_search(Open,Goal,S).
   58
   59pathfind_insert_all([F|R],Open1,Open3) :- 
   60		pathfind_insert(F,Open1,Open2),
   61		pathfind_insert_all(R,Open2,Open3).
   62pathfind_insert_all([],Open,Open).
   63
   64pathfind_insert(B,Open,Open) :- pathfind_repeat_node(B,Open), ! .
   65pathfind_insert(B,[C|R],[B,C|R]) :- pathfind_cheaper(B,C), ! .
   66pathfind_insert(B,[B1|R],[B1|S]) :- pathfind_insert(B,R,S), !.
   67pathfind_insert(B,[],[B]).
   68
   69pathfind_repeat_node(P#_#_#_, [P#_#_#_|_]).
   70
   71pathfind_cheaper( _#_#F1#_ , _#_#F2#_ ) :- F1 < F2.
   72
   73pathfind_expand(State#D#_#S,Goal,All_My_Children) :-
   74     bagof(Child#D1#F#[Move|S],
   75			(D1 is D+1,
   76			pathfind_move(State,Child,Move),
   77			%\+ pathf(Child),
   78			pathfind_f_function(Child,Goal,D1,F)),
   79           	All_My_Children).
   80
   81
   82%path finding that takes as an argument which determins which pair of heuristic-moves to use.
   83%the user provides functions by giving definitions for pathfind_f_function/5 and pathfind_move/4
   84%which are conditioned on a type
   85
   86%     Nodes have form    S#D#F#P#A#T
   87%            where S describes the state or configuration
   88%                  D is the cost computed so far to go from the starting node to this one
   89%                  F is the evaluation of the additional cost needed to get to the destination
   90%                  P is the list of actions performed so far
   91%                  A is the list of ancestor nodes visited so far
   92%                  T termination condition
   93
   94pathfind(State,Goal,Type,Lim,Soln,Stats) :- 
   95		pathfind_f_function(State,Goal,Type,0,_,0,_,F),
   96		pathfind_search_adv([State#0#F#[]#[State]#0],Goal,Type,Lim,S,Stats), reverse(S,Soln).
   97
   98pathfind_search_adv([State#D#_#Soln#_#T|L], State, _, _, Soln,
   99			[[totalcost,D],[stacksize,T],[termvalue,N]]):- length(L,N).
  100%pathfind_search_adv([State#D#_#Soln#_#T|L], State, _, _, Soln,[D,T,N]):- length(L,N).
  101pathfind_search_adv([B|R],Goal,Type,Lim,S,Stats) :-
  102		pathfind_expand_adv(B,Goal,Type,Lim,Children),
  103		pathfind_insert_all_adv(Children,R,Open),
  104		pathfind_search_adv(Open,Goal,Type,Lim,S,Stats).
  105
  106pathfind_insert_all_adv([F|R],Open1,Open3) :- 
  107		pathfind_insert_adv(F,Open1,Open2),
  108		pathfind_insert_all_adv(R,Open2,Open3).
  109pathfind_insert_all_adv([],Open,Open).
  110
  111pathfind_insert_adv(B,Open,Open) :- pathfind_repeat_node_adv(B,Open), ! .
  112pathfind_insert_adv(B,[C|R],[B,C|R]) :- pathfind_cheaper_adv(B,C), ! .
  113pathfind_insert_adv(B,[B1|R],[B1|S]) :- pathfind_insert_adv(B,R,S), !.
  114pathfind_insert_adv(B,[],[B]).
  115
  116pathfind_repeat_node_adv(P#_#_#_#_, [P#_#_#_#_|_]).
  117
  118pathfind_cheaper_adv( _#D1#F1#_#_#_ , _#D2#F2#_#_#_ ) :- V1 is F1+D1,V2 is F2+D2, V1 < V2.
  119
  120pathfind_expand_adv(State#D#_#S#Path#T,Goal,Type,Lim,All_My_Children) :-
  121     bagof(Child#D1#F1#[Move|S]#[Child|Path]#T1,
  122			(pathfind_move(State,Child,Type,Move),
  123			\+ member(Child,Path),
  124			pathfind_f_function(Child,Goal,Type,D,D1,T,T1,F1),
  125			(Lim=inf -> true; T1<Lim)), 
  126           	All_My_Children).
  127
  128
  129%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  130% EOF: lib/alpha_star.pl
  131%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%