You selected traveler1.pl
headline:-
model(D),
figure(D),
wn('%-----------------------------------------------------------'),
wn('% shortest path algorithms by Ford-Bellman and Dijkstra'),
wn('% 最短経路選択の問題'),
wn('%-----------------------------------------------------------'),
h0.
me:-
wn('% file: search.pl (25 Nov 2001)'),
wn('% file: traveler.pl (2-4 Mar 2003)'),
wn('% modified: 4-5 Mar 2003 negative circuit case'),
wn('% modified: 3 Apr 2003 bug fix. evaluate_path/7 '),
wn('% author: Kenryo INDO (Kanto Gakuen University)').
references:-
wn('% references:'),
wn('% [1] 久保幹雄、『組合わせ最適化とアルゴリズム』、共立出版．'),
wn('% [Kubo, M. (2000). Combinatorial Optimization and Algorithms. Kyoritsu Shuppan. (Japanese)] '),
wn('% [2] 猪平進ら、『インターネット時代の情報管理概論』、共立出版．'),
wn('% [Inohira, S. et al.(1999). "Introductory Course of Information Management in the Era of Internet". Kyoritsu Shuppan. (Japanese)] '),
wn('% [3] Bellman, R.(1956). On a routing problem. Quarterly of Applied Mathematics 16: 87-93. '),
wn('% [4] Dijkstra, E.(1959). A note on two problems in connection with graphs. Numerische Mathematics 1: 269-271. ').
h0:-
wn('| node(Name,Symbol)'),
wn('| arc(From,To, [Cost|_]): direct move'),
wn('| min_cost(M,Start,End,Path,Costs)'),
wn('| M: ford_bellman or dijkstra'),
nl.
wn(Z):- write(Z), nl.
:- dynamic potential /3.
:- dynamic pred /3.
:- dynamic model /1.
:- dynamic detect_circuit_data /2.
% default model
model(Default):- Default = yado1.
% node, arc, network
node(A,B):- model(M), example(M,node(A,B)).
arc(A,B,C):- model(M), example(M,arc(A,B,C)).
arc(A,B,[infinite]):- model(M), \+ example(M,arc(A,B,_C)).
network(M,[N,E,C]):-
model(M),
nodes(N,_L),
arcs_and_costs(E,C).
nodes(Ns,L):-
findall(X, node(X,_), Ns),
length(Ns,L).
arcs_and_costs(E,C):-
findall((X,Y,Z), arc(X,Y,[Z|_]), C),
findall((X,Y), member((X,Y,Z),C), E).
display_nodes:-
wn('----node (name, symbol)-------'),
forall(node(X,Y),(write(Y),tab(5),wn(X))).
display_arcs:-
wn('----arc (from, to, cost)-------'),
forall(arc(X,Y,[C|_]),(write(Y),tab(5),wn(X),tab(5),wn(C))).
%-----------------------------------------------------------
% examples of network problem
%-----------------------------------------------------------
%
% A network is a directed graph consists of the nodes, N, and the
% arcs, E, and the arc costs per unit flow C(e), e in E.
% An arc is a pair of nodes (v,w) in E in the network (N,E,C)
% which represents possible flow via the arc.
% example 1.
% transshipment system of spring water in Japan
% of 300 years ago.(cf.,[2]).
% 宿場町の例題（文献[1]）
%------------------------------------------------------
% nodes (i.e.,vertics)
example(yado, node(s, '富士山')).
example(yado, node(1, '宿場町1')).
example(yado, node(2, '宿場町2')).
example(yado, node(3, '宿場町3')).
example(yado, node(t, '江戸')).
% arcs (i.e., edges) with direction
example(yado, arc(s, 1, [10])).
example(yado, arc(2, 1, [3])).
example(yado, arc(s, 2, [5])).
example(yado, arc(1, 2, [2])).
example(yado, arc(2, 3, [2])).
example(yado, arc(1, t, [1])).
example(yado, arc(3, t, [6])).
% example 2.
% adding an arc with negative cost to example 1. [1]
%------------------------------------------------------
example(yado1, node(A, B)):-
example(yado, node(A, B)).
example(yado1, arc(A, B, C)):-
example(yado, arc(A, B, C)).
example(yado1, arc(3, 1, [-5])).
%
% example 3. Japanese railroad system of a few years ago. (cf.,[2]).
% 鉄道路線の例題（文献[2]参照。ただしデータは一部訂正した）
%------------------------------------------------------
% nodes (i.e., vertics)
example(eki, node(tokyo, '東京駅')).
example(eki, node(ueno, '上野駅')).
example(eki, node(kyoto, '京都駅')).
example(eki, node(sendai, '仙台駅')).
example(eki, node(niigata, '新潟駅')).
example(eki, node(mito, '水戸駅')).
% arcs (i.e., edges) with direction
example(eki, arc(tokyo, kyoto, [7800])).
example(eki, arc(tokyo, ueno, [300])).
example(eki, arc(tokyo, mito, [2500])).
example(eki, arc(tokyo, sendai, [5700])).
example(eki, arc(kyoto, tokyo, [7800])).
example(eki, arc(ueno, tokyo, [300])).
example(eki, arc(mito, tokyo, [2500])).
example(eki, arc(sendai, tokyo, [5700])).
example(eki, arc(kyoto, ueno, [8400])).
example(eki, arc(sendai, ueno, [5600])).
example(eki, arc(niigata, ueno, [5000])).
example(eki, arc(ueno, kyoto, [8400])).
example(eki, arc(ueno, niigata, [5000])).
example(eki, arc(ueno, sendai, [5600])).
example(eki, arc(sendai, niigata, [5300])).
example(eki, arc(kyoto, niigata, [8000])).
example(eki, arc(niigata, kyoto, [8000])).
example(eki, arc(niigata, sendai, [5300])).
example(eki, arc(mito, sendai, [3500])).
example(eki, arc(sendai, mito, [3500])).
figure(yado):-
wn('% [1]------------- [t]'),
wn('% 10 /| 1 /'),
wn('% / | 6/ '),
wn('% / 3| / '),
wn('% / |2 / '),
wn('% / | / '),
wn('% [s]-----[2]------[3] '),
wn('% 5 2 '),
nl.
figure(yado1):-
wn('% [1]------------- [t]'),
wn('% 10 /| | 1 /'),
wn('% / | |-5 6/ '),
wn('% / 3| | / '),
wn('% / |2 | / '),
wn('% / | | / '),
wn('% [s]-----[2]------[3] '),
wn('% 5 2 '),
nl.
figure(eki):-
wn('% [niigata]------ [sendai]'),
wn('% / | /'),
wn('% / | [mito]'),
wn('% / | / '),
wn('% / [ueno] '),
wn('% / | '),
wn('% [kyoto]----------[tokyo]'),
wn('% '),
nl.
%-----------------------------------------------------------
% algorithms for shortest path problem
%-----------------------------------------------------------
% ==================================== %
% Main Program
% ==================================== %
min_cost(Method,S,T,Path,CP):-
member(Method,[ford_bellman, dijkstra]),
initialize_potentials(0,S),
initialize_predecessors(0,Method),
initialize_circuit_data,
iteratively_update_potentials(K,Method,S,T,[T|Path0]),
display_tables(Method,K),
trace,
evaluate_path(Method,S,T,Path0,Path,CP,Cir),
(Cir = 0
-> display_optimal_path(CP,[T|Path])
; display_circuit(K,CP,Path)
).
% ==================================== %
% Ford-Bellman's iterative method. [3]
% ==================================== %
% Two classical algorithms of Ford and Bellman [3] use the
% node potential functions
% P: N -> R, and
% iteratively update them in finite steps ( in order of product of
% nodes and arcs, O(nm), if no negative cost ).
% Potential function of a network transshipment problem
% is the Lagrange multiplier (of complementary slackness conditions)
% for the linear programming styled formalization of it.
iteratively_update_potentials(0,ford_bellman,_,_,[]).
iteratively_update_potentials(K,ford_bellman,S,T,[N|Path]):-
iteratively_update_potentials(K0,ford_bellman,S,T,Path),
K is K0 + 1,
nodes(Nodes,LN),
subtract(Nodes,[T],Vs0),
% stop condition
( K < LN -> nth1(K,Vs0,N); K is LN -> N = T; !,fail),
initialize_potentials(K,S),
initialize_predecessors(K,ford_bellman),
% The following code is somewhat of forcing me to do procedurally.
forall(arc(V,W,[Cvw|_]),
(
potential(K0,W,Yw0),
potential(K0,V,Yv0),
greater_than(Yw0, Yv0 + Cvw, Yvw, F),
update_node_potential(K,W,Yw0->Yvw,F),
update_node_predecessor(K,W,_Pw0->V,F)
)
).
% ==================================== %
% Dijkstra's iterative method. [4]
% ==================================== %
% Although it can be applied only to networks without negative cost arc,
% the labeling method is efficiently (in the order of square of nodes)
% than the method by Ford-Bellman.
iteratively_update_potentials(0,dijkstra,_,_,[]).
iteratively_update_potentials(K,dijkstra,S,T,[V|Path]):-
iteratively_update_potentials(K0,dijkstra,S,T,Path),
K is K0 + 1,
nodes(Nodes,LN),
subtract(Nodes,Path,Vs0),
% select and stop condition
G = find_min(P,potential(K0,V,P),member(V,Vs0)),
( K < LN -> G; K is LN -> V = T; !,fail),
initialize_potentials(K,S),
initialize_predecessors(K,dijkstra),
subtract(Nodes,[V],Vs),
forall((node(V,_),arc(V,W,[Cvw|_]),member(W,Vs)),
(
potential(K0,W,Yw0),
potential(K0,V,Yv0),
greater_than(Yw0, Yv0 + Cvw, Yvw, F),
update_node_potential(K,W,Yw0->Yvw,F)
)
).
% find the minimum of potential (is locally used)
%-----------------------------------------------
find_min(P,potential(L,W,P),member(W,Vs)):-
potential(L,W,P),
member(W,Vs),
\+ (
potential(L,X,Q),
member(X,Vs),
greater_than(P, Q + 0,_,yes)
).
% ==================================== %
% Common Utilities
% ==================================== %
% initilization for potentials
%-----------------------------------------------------------
initialize_potentials(K,S):-
node(S,_),
(
K = 0 -> abolish(potential /3)
; clean_kth_potentials_up(K)
),
initialize_potentials_0(K,S),
initialize_potentials_1(K,S).
initialize_potentials_0(K,S):-
assert(
potential(K,S,0) % fixed
).
initialize_potentials_1(0,S):-
P = infinite,
forall(
(node(X,_), X \= S),
assert(
potential(0,X, P)
)
).
initialize_potentials_1(K,S):-
K > 0,
K0 is K - 1,
forall(
(
potential(K0,X,P),
X \= S
),
assert(
potential(K,X, P)
)
).
initialize_circuit_data:-
abolish(detect_circuit_data /2),
assert(detect_circuit_data(non,[])).
% initilization for predecessors
%-----------------------------------------------------------
initialize_predecessors(_,dijkstra).
initialize_predecessors(0,ford_bellman):-
abolish(predecessor /3),
forall(node(X,_),
assert(
predecessor(0,X, -)
)
).
initialize_predecessors(K,ford_bellman):-
K > 0,
K0 is K - 1,
clean_kth_predecessors_up(K),
forall(
predecessor(K0,X,V),
assert(
predecessor(K,X,V)
)
).
% update potential of a node
%-----------------------------------------------------------
update_node_potential(_K,_W,Y->Y, no).
update_node_potential(K,W,_Y0->Y, yes):-
\+ K = 0,
\+ var(K),
\+ var(W),
%Y = Yvw,
erase_potential(K,W),
assert(
potential(K,W,Y)
).
erase_potential(K,N):-
\+ clause(potential(K,N,_),true).
erase_potential(K,N):-
\+ var(K),
\+ var(N),
clause(potential(K,N,_P),true),
retractall(
potential(K,N,_)
).
clean_kth_potentials_up(K):-
\+ var(K),
forall(node(N,_),
erase_potential(K,N)
).
% update best predecessor of a node
%-----------------------------------------------------------
update_node_predecessor(_K,_N,V->V,no).
update_node_predecessor(K,N,V0->V,yes):-
\+ K = 0,
\+ var(K),
\+ var(N),
K0 is K - 1,
predecessor(K0,N,V0),
erase_predecessor(K,N),
assert(
predecessor(K,N,V)
).
erase_predecessor(K,N):-
\+ clause(predecessor(K,N,_),true).
erase_predecessor(K,N):-
\+ var(K),
\+ var(N),
clause(predecessor(K,N,_),true),
retractall(
predecessor(K,N,_)
).
clean_kth_predecessors_up(K):-
\+ var(K),
forall(node(N,_),
erase_predecessor(K,N)
).
% decision tree (including the cases of infinite values)
greater_than(Yw0, Yv0 + Cvw, Z, F):-
Case1 = (Yv0 = infinite; Cvw = infinite), % RHS=infinite
Case2 = (Yw0 = infinite; Yw0 > Yvw),
(
Case1-> (Z=Yw0, F=no)
;
(
Yvw is Yv0 + Cvw,
(
Case2 -> (Z=Yvw, F=yes)
;
(Z=Yw0, F=no)
)
)
).
% evaluation of the found route
%----------------------------------------------------------
% modified: 3 Apr 2003. final_time_of_potentials/1
final_time_of_potentials(L):-
findall(T,potential(T,_N,_P),Ts),
max_of(L,Ts),
!.
evaluate_path(Method, S,T,Path0,Path,CP,Cir):-
%nodes(_N,L),
final_time_of_potentials(L),
(Method = dijkstra -> Path = Path0 ; true),
(evaluate_path_0(Method, L,S, T, [T|Path], CP)
-> Cir=0
; Cir=1
).
evaluate_path_0(ford_bellman, _K, S, S, [S], [0]).
evaluate_path_0(ford_bellman, K, S, W, [W|[V|Path]], [P|CP]):-
predecessor(K,W,V),
potential(K,W,P),
detect_circuit(W,DC),
(DC= no -> true; !,fail),
evaluate_path_0(ford_bellman, K, S, V, [V|Path], CP).
evaluate_path_0(dijkstra, _K, S, S, [S], [0]).
evaluate_path_0(dijkstra, K, S, W, [W|Path], [P|CP]):-
evaluate_path_0(dijkstra, K, S, _V, Path, CP),
potential(K,W,P).
evaluate_path_0(circuit, _K, S, S, [S], [0]).
evaluate_path_0(circuit, K, S, W, [W|Path], [P|[P1|CP]]):-
evaluate_path_0(circuit, K, S, V, Path, [P1|CP]),
arc(V,W,[C|_]),
P is P1 + C.
% detection of negative cycle by Ford-Bellman method
%-----------------------------------------------------
detect_circuit_data(non,[]).
detect_circuit(V,yes):-
detect_circuit_data(non,Path),
member(V,Path),
update_circuit_data(V,Path).
detect_circuit(V,no):-
detect_circuit_data(non,Path),
\+ member(V,Path),
update_circuit_data(non,[V|Path]).
update_circuit_data(A,D):-
retractall(detect_circuit_data(_,_)),
assert(detect_circuit_data(A,D)).
% display for the results
%----------------------------------------------------------
display_tables(dijkstra,K):-
wn('---- potentials -------------------------------------'),
forall(potential(K,A,B),wn(((t=K),(node=A),(pot=B)))).
display_tables(ford_bellman,K):-
wn('---- potentials -------------------------------------'),
forall(potential(K,A,B),wn(((t=K),(node=A),(pot=B)))),
wn('---- predecessors -----------------------------------'),
forall(predecessor(K,A,B),wn(((t=K),(node=A),(pred=B)))),
wn('---- end -------------------------------------').
display_optimal_path(CP,Path):-
CP = [V|_],
nl,write('optimal cost='(V)),
reverse(Path,Path0),
reverse(CP,CP0),
findall('->'(X/Y),(nth1(I,Path0,X),nth1(I,CP0,Y)),Path1),
nl,write('optimal route/cumulative cost='),nl,
tab(2),forall(member(W,Path1),write(W)),nl.
display_circuit(K,CP,Circ):-
wn(' The circuit of negative or zero cost has detected : '),
detect_circuit_data(V,Path),
wn([V|Path]),
findall(X,
(
nth1(J,Path,V),
nth1(I,Path,X),
I =< J
),
Circ0),
reverse(Circ0,Circ1),
append(Circ1,[V],Circ),
evaluate_path_0(circuit, K, V, V, Circ,CP).
:- headline.
% max,min
% ----------------------------------------------------------- %
% added: 3 Apr 2003. cited from math1.pl
max_of(X,[X]).
max_of(Z,[X|Y]):-
max_of(Z1,Y),
(X > Z1 -> Z=X; Z=Z1).
min_of(X,[X]).
min_of(Z,[X|Y]):-
min_of(Z1,Y),
(X < Z1 -> Z=X; Z=Z1).
%end
return to front page.