home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SPAN.ZIP / SPAN.PRO
Encoding:
Prolog Source  |  1986-05-24  |  5.9 KB  |  168 lines
  1.             /* spanning tree program*/
  2.             /* by Neil J. Rubenking */
  3.             /* in TURBO PROLOG      */
  4.             /*            */
  5. /* INPUT: A connected undirected weighted graph, expressed as facts    */
  6. /* in the predicate "wedges" (weighted edges).  The example facts are    */
  7. /* probably supposed to be air minutes between cities.            */
  8. /*                                    */
  9. /* OUTPUT: A list of edges forming a minimal spanning tree for the     */
  10. /* graph.  This will be the smallest TREE that connects all the nodes.    */
  11. /* So, if you wanted to run an airline that connected all the cities on    */
  12. /* the list, but with the minimum length of routes, and with no care    */
  13. /* to avoiding plane changes, this program will find it for you.    */
  14.  
  15. /* The predicate "del_dupes" may be of particular interest in any    */
  16. /* application that needs to change a LIST of objects into a SET --     */
  17. /* the SET will simply be a LIST of the object w/o any duplicates.    */
  18. /* Clocksin and Mellish demonstrate SET operations that depend on the    */
  19. /* assumption of no duplicates.                        */
  20.  
  21.  
  22. domains
  23.     vertex = symbol
  24.     vertices = vertex*    /* list of vertices */
  25.     weight = integer
  26.     wlist = weight*
  27. database
  28.     possible(vertex, vertex, weight)
  29.     spanning(vertex, vertex, weight)
  30. predicates
  31.     wedge(vertex, vertex, weight)    /* the INPUT facts    */
  32.     run
  33.     read_wedges(vertices)
  34.     append(vertices, vertices, vertices)
  35.     del_dupes(vertices, vertices)
  36.     spanning_tree(vertices, vertices)    
  37.     possible_bridges(vertices, vertices)
  38.     member(vertex, vertices)
  39.     member(weight, wlist)
  40.     least(weight, wlist)
  41.     least_bridge(weight)
  42.     less_than_the_rest(weight, wlist)
  43.     forget
  44.     appendOne(vertex, vertex, vertices, vertices)
  45.     RemoveOne(vertex, vertex, vertices, vertices)
  46.     efface(vertex, vertices, vertices)
  47.     head_of(vertex, vertices, vertices)
  48. goal
  49.     run.    
  50. /***************************/    
  51. clauses
  52. run:-
  53.     read_wedges([H|L]),
  54.     spanning_tree(L,[H]),!,
  55.     spanning(X,Y,W),
  56.     write("Vertices: ", X," ",Y,", weight: ",W),nl,fail.
  57.  
  58. read_wedges(L) :-            /* Make a list of all the vertices*/
  59.     findall(X,wedge(X,_,_),XList),    /* with no duplications, based on */
  60.     findall(Y,wedge(_,Y,_),YList),    /* the input database.          */    
  61.     append(XList, YList, L1),
  62.     del_dupes(L1,L).    
  63.     
  64. append([],L,L).            /* the ususl append predicate        */
  65. append([X|L1],L2,[X|L3]) if
  66.      append(L1,L2,L3).    
  67.  
  68. del_dupes([],[]).        /* Delete duplicates from a list.    */
  69. del_dupes([X],[X]).        /* There may well be a more efficient    */
  70. del_dupes([X|T],L):-        /* way to do this!            */
  71.     member(X,T),
  72.     del_dupes(T,L),!.
  73. del_dupes([X|T],L):-
  74.     not(member(X,T)),
  75.     del_dupes(T,L1),
  76.     head_of(X,L1,L),!.    
  77.     
  78. /* The algorithm for finding a minimal spanning tree is as follows:    */
  79. /* 1.    Divide the graph into two subgraphs, one (R) containing a     */
  80. /*    single node and the other (L) containing the rest.         */
  81. /* 2.    Repeat the following until the L graph is empty:         */
  82. /*    2a) Find the "bridge" of least weight between any node of     */
  83. /*        R and any node of L.  (It can be proven that this          */
  84. /*        bridge MUST be an edge in the minimal spanning tree).     */
  85. /*    2b) Take the vertex in L that was joined by the bridge,         */
  86. /*        remove it from L and add it to R.                 */
  87. /* 3.    The set of found bridges forms the desired spanning tree.     */
  88.     
  89. spanning_tree([],_).    /* if the list is empty, we succeed and end */
  90. spanning_tree(L,R) :-    
  91.     not(possible_bridges(L,R)),    /* list the possible "bridges" */
  92.     least_bridge(W),        /* find the smallest        */
  93.     possible(X,Y,W),        /* What edge had that weight?    */   
  94.     assertz(spanning(X,Y,W)),    /* Put that edge in our tree    */
  95.     not(forget),            /* Forget the "possibles" list. */
  96.     removeOne(X,Y,L,L1),        /* Remove the newly used vertex */
  97.     appendOne(X,Y,R,R1),        /* from L and add it to R    */
  98.     spanning_tree(L1,R1).        /* AND now do it again.        */
  99.     
  100. possible_bridges(L,R):-        /* List the possible "bridges" between    */
  101.     member(X,L),        /* the two lists of vertices -- that is    */
  102.     member(Y,R),        /* all edges that connect an element of    */
  103.     wedge(X,Y,W),        /* one to an element of the other.    */
  104.     assertz(possible(X,Y,W)),
  105.     fail.
  106. possible_bridges(L,R):-        /* Note that since possible_bridges    */
  107.     member(X,L),        /* forces backtracking with "fail", it    */
  108.     member(Y,R),        /* may need to be called with "not".    */
  109.     wedge(Y,X,W),
  110.     assertz(possible(X,Y,W)),
  111.     fail.    
  112.     
  113. member(X,[X|_]).        /* X is a member of a list headed by X.    */
  114. member(X,[_|T]) :- member(X,T). /* X is a member of a list if it is a    */
  115.                 /* member of the TAIL of that list.    */
  116.     
  117. least_bridge(W):-    /* Find the shortest bridge.    */
  118.     findall(X,possible(_,_,X),Xlist),
  119.     least(W,XList).
  120.  
  121. least(X,L):-            /* "naive" method for finding the least */
  122.     member(X,L),        /* element of a list -- look at each    */
  123.     less_than_the_rest(X,L)./* til one is less than all the rest.    */
  124.  
  125. less_than_the_rest(X,[H|T]):-
  126.     X <= H, less_than_the_rest(X,T).
  127. less_than_the_rest(_,[]).    
  128.     
  129. forget:-
  130.     retract(possible(_,_,_)), fail. /* empty the database of possibles*/
  131.     
  132. head_of(X,L,[X|L]).    /* stick a single element at the head of the list*/
  133.  
  134. efface(A,[A|L],L):-!.
  135. efface(A,[B|L],[B|M]):- efface(A,L,M).    /* Remove an element from the list.*/
  136.                     /* This predicate straight from C&M*/
  137.                     
  138. appendOne(X,Y,Z,Znew):-        /* Given the two vertices X and Y,     */
  139.     member(X,Z),        /* add whichever one is not already in  */
  140.     head_of(Y,Z,ZNew).    /* list Z into that list.        */
  141. appendOne(X,Y,Z,Znew):-
  142.     member(Y,Z),
  143.     head_of(X,Z,ZNew).        
  144.  
  145. removeOne(X,_,Z,Znew):-        /* Given X and Y, remove whichever    */
  146.     member(X,Z),        /* of the two is present.        */
  147.     efface(X,Z,Znew).
  148. removeOne(_,Y,Z,Znew):-    
  149.     member(Y,Z),
  150.     efface(Y,Z,Znew).
  151.  
  152. /* here is the database of weighted edges */    
  153.  
  154. wedge("BOS","NY",40).
  155. wedge("BOS","CHI",90).
  156. wedge("NY","CHI",80).
  157. wedge("NY","PHL",30).
  158. wedge("NY","DC",50).
  159. wedge("CHI","SF",100).
  160. wedge("CHI","LA",120).
  161. wedge("CHI","KC",40).
  162. wedge("CHI","PHL",80).
  163. wedge("PHL","KC",70).
  164. wedge("PHL","DC",35).
  165. wedge("DC","ATL",60).
  166. wedge("SF","LA",50).
  167. wedge("KC","ATL",80).
  168. q