home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / turbopas / spoc88.arc / SEARCH.ARC / SEARCH.PRO < prev   
Text File  |  1988-05-31  |  3KB  |  139 lines
  1. /* Graph Searching */
  2.  
  3. domains
  4.   node = integer    /* Modify this to fit the problem. */
  5.   pointer = ptr(node,node)    
  6.   pointers = pointer*        
  7.   path = node*        
  8.                 
  9. database
  10.   mark(node)
  11.  
  12. /* Predicates defining the search space    */
  13. /* Change these to fit the problem.    */
  14.  
  15. predicates
  16.   start_node(node)
  17.   goal_node(node)
  18.   arcc(node,node)
  19.  
  20. clauses
  21.   start_node(0).
  22.  
  23.   goal_node(13). goal_node(14). goal_node(15).
  24.  
  25.   arcc(0,5).   arcc(0,6).   arcc(0,7).   arcc(3,1).   
  26.   arcc(4,2).   arcc(5,8).   arcc(6,9).   arcc(7,10).  
  27.   arcc(8,3).   arcc(8,9).   arcc(9,11).  arcc(9,12).  
  28.   arcc(9,14).  arcc(10,4).  arcc(10,9).  arcc(11,13). 
  29.   arcc(11,14). arcc(12,14). arcc(12,15).
  30.  
  31. /* General purpose predicates */
  32.  
  33. predicates
  34.   member(pointer,pointers)
  35.   member(node,path)
  36.   append(path,path,path)
  37.   my_retractall(string)
  38.  
  39. clauses
  40.   member(H,[H|_]).
  41.   member(H,[_|T]) :-
  42.     member(H,T).    
  43.    
  44.   append([],L,L).    
  45.   append([H|T],L,[H|T1]) :-
  46.     append(T,L,T1).
  47.     
  48.   my_retractall(mark) :-
  49.     retract(mark(_)),
  50.     my_retractall(mark).
  51.   my_retractall(_).
  52.  
  53. /* The search mechanism    */
  54.  
  55. predicates
  56.   better(node,node) /* Modify this to suit the problem. */
  57.   unmarked_successor(node,node)
  58.   search(string,path,pointers,node,path)
  59.   continue_search(string,path,pointers,node,path,path) 
  60.   insert(node,path,path)
  61.   merge(string,path,path,path)
  62.   findpath(pointers,path,path)
  63.   markall(path)
  64.   update_pointers(node,path,pointers,pointers)
  65.  
  66. clauses
  67.   better(X,Y) :- 
  68.     X >= Y.
  69.  
  70.   unmarked_successor(N,M) :-
  71.     arcc(N,M),
  72.     not(mark(M)).
  73.  
  74.   search(_,[TheGoal | _],P,TheGoal,Path) :-
  75.     goal_node(TheGoal),
  76.     findpath(P,[TheGoal],Path),
  77.     !.
  78.   search(Type,[N | R],P,TheGoal,Path) :-
  79.     findall(X,unmarked_successor(N,X),New),  
  80.     continue_search(Type,[N|R],P,TheGoal,Path,New).
  81.  
  82.   continue_search(_,[N | _],P,TheGoal,Path,New) :-
  83.     member(TheGoal,New),
  84.     goal_node(TheGoal),
  85.     findpath(P,[N,TheGoal],Path),
  86.     !.
  87.   continue_search(Type,[N|R],P,TheGoal,Path,New) :-
  88.     markall(New),
  89.     merge(Type,New,R,NewL),
  90.     update_pointers(N,New,P,NewP),
  91.     search(Type,NewL,NewP,TheGoal,Path).
  92.     
  93.   findpath(P,[H|T],Path) :-
  94.     member(ptr(X,H),P),
  95.     !,
  96.     findpath(P,[X,H|T],Path).
  97.   findpath(_,Path,Path).
  98.  
  99.   markall([H|T]) :-
  100.     assert(mark(H)),
  101.     markall(T).
  102.   markall([]).
  103.  
  104.   insert(Node,[H|T],[Node,H|T]) :-
  105.     better(Node,H),
  106.     !.
  107.   insert(Node,[H|T],[H|NewT]) :-
  108.     insert(Node,T,NewT).
  109.   insert(Node,[],[Node]).
  110.  
  111.   merge("depth",New,R,NewL) :-
  112.     append(New,R,NewL).
  113.   merge("breadth",New,R,NewL) :-
  114.     append(R,New,NewL).
  115.   merge("best",[H|T],L,NewL) :-
  116.     insert(H,L,TempL),
  117.     merge("best",T,TempL,NewL).
  118.   merge("best",[],NewL,NewL).
  119.  
  120.   update_pointers(N,[H|T],P,NewP) :-
  121.     update_pointers(N,T,[ptr(N,H) | P],NewP).
  122.   update_pointers(_,_,NewP,NewP).
  123.  
  124. goal
  125.   makewindow(1,7,7,"",5,5,10,65),
  126.   my_retractall(mark),
  127.   write("\n\tWhat type of search (depth, breadth, best)? "),
  128.   readln(Type),
  129.   clearwindow,
  130.   start_node(S),
  131.   search(Type,[S],[],TheGoal,Path),
  132.   write("\n\tThe goal ",TheGoal,
  133.         " was reached via a ",Type,"-first search."),
  134.   nl,
  135.   nl,
  136.   write("\tA path leading from a start node to this goal is:\n\n\t",
  137.         Path),
  138.   nl,nl.
  139.