1% ***************************************************************
    2% HEURISTIC SEARCH ENGINE in CILog, from
    3% Computational Intelligence: A Logical Approach
    4% Copyright, Poole, Mackworth, Goebel, and Oxford University Press, 1997. 
    5
    6% hsearch is an instance of the genertic search algorithm.
    7
    8% Elements of the frontier are of the form: 
    9% node(Node,Path,Pathcost,Nodecost)
   10%   where Node is the current node, Path is the path found to Node,
   11%   Pathcost is the cost of the path and Nodecost is the `value' of the node,
   12%     for which ever search strategy we are using.
   13
   14% hsearch(M,F,S) if method M from frontier F results in path S to goal.
   15%   This works for methods in {breadth,depth,astar,best,hdepth,shortest}.
   16%   Note that S is the list of nodes in the reverse order.
   17
   18hsearch(M,F,[N|P]) <-
   19   choose(M,node(N,P,_,_),F,_) &
   20   is_goal(N).
   21hsearch(M,F,S) <-
   22   choose(M,node(N,P,PC,_),F,F1) &
   23   neighbours(N,NN) &
   24   add_paths2(M,N,NN,[N|P],PC,NN2) &
   25   hadd_to_frontier(M,NN2,F1,F2) &
   26   hsearch(M,F2,S).
   27
   28% add_paths2(Method,Node,Neighs,Path,PathCost,NewFrontierElts) is true if
   29%   Method is a search method
   30%   Node is a node in the graph
   31%   Neighs is a list of neighbors of Node
   32%   Path is a path from the start to node N
   33%   PathCost is the cost of this path
   34%   NewFrontierElts is the list of elements that needs to be added to
   35%       the frontier for neighbor in Neighs
   36add_paths2(_,_,[],_,_,[]).
   37add_paths2(M,N,[NN|R],P,PC,[node(NN,P,NPC,NNC)|PR]) <-
   38   cost(N,NN,AC) &
   39   NPC is PC + AC &
   40   value(M,NPC,NN,NNC) &
   41   add_paths2(M,N,R,P,PC,PR).
   42
   43% value(Method,NPC,NN,NNC) is true if NNC is the value of the node NN
   44% given that the search strategy is Method, and NPS is the path cost to NN
   45value(astar,NPC,NN,NNC) <-
   46   h(NN,HNN) &
   47   NNC is NPC+HNN.
   48value(best,_,NN,HNN) <-
   49   h(NN,HNN).
   50value(hdepth,_,NN,HNN) <-
   51   h(NN,HNN).
   52value(shortest,NPC,_,NPC).
   53value(breadth,_,_,0).
   54value(depth,_,_,0).
   55
   56
   57% choose(M,E,F,NF) is true if E is an element of frontier F and NF is
   58%   the remaining frontier after E is removed. M is the search method used.
   59% In each of these the frontier is the list of elements in order they
   60%   are to be chosen.
   61
   62choose(_,N,[N|F],F).
   63
   64% hadd_to_frontier(M,Ns,F1,F2) is true if when using search method M, when
   65%   nodes Ns are added to frontier F1, the resulting frontier is list F2.
   66
   67hadd_to_frontier(depth,Ns,F1,F2) <- 
   68   append(N,F1,F2).
   69
   70hadd_to_frontier(breadth,N,F1,F2) <- 
   71   append(F1,N,F2).
   72
   73hadd_to_frontier(hdepth,N,F1,F2) <- 
   74   mergeinto(N,[],NF) &
   75   append(NF,F1,F2).
   76
   77hadd_to_frontier(astar,N,F1,F2) <-
   78   mergeinto(N,F1,F2).
   79hadd_to_frontier(best,N,F1,F2) <-
   80   mergeinto(N,F1,F2).
   81hadd_to_frontier(shortest,N,F1,F2) <-
   82   mergeinto(N,F1,F2).
   83
   84% mergeinto(NNs,Fr0,Fr1) is true if adding frontier elements NNs to
   85% frontier Fr0 results in frontier Fr1. The frontier is sorted by the
   86% fourth argument to the node function sysmbol.
   87mergeinto([],L,L).
   88mergeinto([H|T],L1,L3) <-
   89   insertinto(H,L1,L2) &
   90   mergeinto(T,L2,L3).
   91
   92% insertinto(NN,Fr0,Fr1) is true if adding frontier element NN to
   93% frontier Fr0 results in frontier Fr1. The frontier is sorted by the
   94% fourth argument to the node function sysmbol.
   95
   96insertinto(E,[],[E]).
   97insertinto(node(N,P,PC,NC),[node(N1,P1,PC1,NC1)|R],
   98              [node(N,P,PC,NC),node(N1,P1,PC1,NC1)|R]) <-
   99   NC =< NC1.
  100insertinto(node(N,P,PC,NC),[node(N1,P1,PC1,NC1)|R],
  101              [node(N1,P1,PC1,NC1)|R1]) <-
  102   NC > NC1 &
  103   insertinto(node(N,P,PC,NC),R,R1).
  104
  105% **************************************************
  106% Auxiliary definitions
  107
  108% append(A,B,R) is true if R is the list containing the elements of A
  109% followed by the elements of B 
  110append([],R,R).
  111append([H|T],L,[H|R])