You selected path.pl

% a prolog code for solving shortest path tree
% and Vickrey Prices
% code: path.pl
% date: 2005.9.29-30;10.3-12(23:35 pm)
% by Kenryo INDO (Kanto Gakuen University, Japan)

% reference:
%  J. Hersberger and S. Suri (2001).
%  Vickrey Prices and Shortest Paths: What is an edge worth?
%  Proceedings of the 42nd IEEE Symposium on Foundation of Computer Science, 
%  IEEE Computer Society.

figure:-
  wn('%                    4        2        '),
  wn('%              [1]--->---[3]-->--- [t] '),
  wn('%              /|      /  |      /     '),
  wn('%             / |2    /   |     /      '),
  wn('%          5 ^  v   9^   5|    ^       '),
  wn('%           /   |   /     v   / 3      '),
  wn('%          /    |  /      |  /         '),
  wn('%      [s]-->--[2]--->---[4]           '),
  wn('%           3         7                '),
  nl.

wn(Z):- write(Z), nl.

:- dynamic v/1, c/3.

%  vertices
% ----------------------------------------  %

v( s). % the source
v( 1).
v( 2).
v( 3).
v( 4).
v( t). % the target

%  edges and their costs
% ----------------------------------------  %

c( s, 1, 5).
c( s, 2, 3).
c( 1, 2, 2).
c( 1, 3, 4).
c( 2, 4, 7).
c( 2, 3, 9).
c( 3, t, 2).
c( 3, 4, 5).
c( 4, t, 3).



%  model base and the switcher
% ----------------------------------------  %
% added: 12 Nov 2005.

:- dynamic current_model.

current_model( no(1)).

switch_model( A-> B):-
   current_model( A),
   network_model( B,
     vertices( V),
     edges_and_costs( EC),
     figure( F)
   ),
   B \= A,
   abolish( current_model/1),
   abolish( v/1),
   abolish( c/3),
   assert( current_model(B)),
   forall( member(N,V), assert( v(N))),
   forall( member((P->Q,C),EC), assert( c(P,Q,C))),
   call( F).

network_model( no(1),
   vertices([s,1,2,3,4,t]),
   edges_and_costs([
	( s-> 1, 5),
	( s-> 2, 3),
	( 1-> 2, 2),
	( 1-> 3, 4),
	( 2-> 4, 7),
	( 2-> 3, 9),
	( 3-> t, 2),
	( 3-> 4, 5),
	( 4-> t, 3)
   ]),
   figure( figure)
).

network_model( no(2),
   vertices([s,1,2,3,4,5,6,t]),
   edges_and_costs([
	( s-> 1, 5),
	( s-> 2, 3),
	( 1-> 2, 2),
	( 1-> 3, 4),
	( 2-> 4, 7),
	( 2-> 3, 9),
	( 3-> 5, 2),
	( 3-> 4, 5),
	( 4-> 5, 3),
	( 4-> 6, 5),
	( 5-> 6, 6),
	( 5-> t, 3),
	( 6-> t, 4)
   ]),
   figure( figure_2)
).

figure_2:-
  wn('%                    4        2          3       '),
  wn('%              [1]--->---[3]-->--- [5]--->--[t]  '),
  wn('%              /|      /  |      /  |     /      '),
  wn('%             / |2    /   |     /   |    ^       '),
  wn('%          5 ^  v   9^   5|    ^    |6  /4       '),
  wn('%           /   |   /     v   / 3   v  /         '),
  wn('%          /    |  /      |  /      | /          '),
  wn('%      [s]-->--[2]--->---[4]---->--[6]           '),
  wn('%           3         7        5                 '),
  nl.


%  a sample code for explaining 
%  how to solve using dynamic programming
% ----------------------------------------  %

d( s, t, V):-
   d( s, 3, X),
   d( s, 4, Y),
   c( 3, t, Z),
   c( 4, t, W),
   min_of( V, [X + Z, Y + W]).

d( s, 4, V):-
   d( s, 3, A),
   d( s, 2, B),
   c( 3, 4, C),
   c( 2, 4, D),
   min_of( V, [A + C, B + D]).

d( s, 3, V):-
   d( s, 1, A),
   d( s, 2, B),
   c( 1, 3, C),
   c( 2, 3, D),
   min_of( V, [A + C, B + D]).

d( s, 2, V):-
   d( s, 1, A),
   c( s, 2, B),
   c( 1, 2, C),
   min_of( V, [A+C, B]).

d( s, 1, C):-
   c( s, 1, C).


%  finding a POSSIBLE path
% ----------------------------------------  %

l( S, S, [], 0):- v( S).

l( S, T, [X|Y], C + D ):-
   c( X, T, C),
   l( S, X, Y, D).


%  finding the SHORTEST path
% ----------------------------------------  %

d( S, S, [], 0):- v( S).

d( S, T, [X|Y], C + D):-
   min( L,
    (
     c( X, T, C),
     d( S, X, Y, D),
     L is D + C
    )
   ).


%  a modified code using the memoing 
%  for repetitive goals during the recursion 
% ----------------------------------------  %
%  note:
%  v/1 is needed for computing there_is_no_temp.

:- dynamic d_temp/4.

:- abolish( d_temp/4).

d_1( S, S, [], 0):- v(S).

d_1( S, T, [X|Y], C+D):-
   clause( d_temp( S, T, [X|Y], C+D),_).

d_1( S, T, [X|Y], C + D):-
   there_is_no_d_temp(  S, T),
   min( L,
    (
     c( X, T, C),
     d_1( S, X, Y, D),
     L is D + C
    )
   ),
   record_d( S, T, [X|Y], C+D).


there_is_no_d_temp( S, T):-
   v( S),
   v( T),
   \+ clause( d_temp( S, T, _, _),_).

record_d( S, T, [X|Y], C+D):-
   assert( d_temp(S, T, [X|Y], C+D)).


%  max, min
% ----------------------------------------  %


min(X,Goal):-
  max(Z,(Goal,Z is -X)).


max(X,Goal):-
  % X: the objective variable,
  % Goal: the objective function and constraints,
  setof((X,Goal),Goal,Z),
  member((X,Goal),Z),
  \+ (
    member((Y,_),Z),
    Y > X
  ).

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).


:- figure.


%  demo
% ----------------------------------------  %
/*
?- [path].
%                    4        2        
%              [1]--->---[3]-->--- [t] 
%              /|      /  |      /     
%             / |   9 ^   |     /      
%          5 ^  v    /   5|    ^       
%           /   |2  /     v   / 3      
%          /    |  /      |  /         
%      [s]-->--[2]--->---[4]           
%           3         7                

% path compiled 0.00 sec, 2,632 bytes

Yes
?- d(s,t,L).

L = 5+4+2 ;

No
?- d(s,t,X,L).

X = [3, 1, s]
L = 2+ (4+ (5+0)) ;

No
?- S=s,v(T),
d(S,T,X,L),P is L,nl,write(S-T;X;L=P),fail.

s-s;[];0=0
s-1;[s];5+0=5
s-2;[s];3+0=3
s-3;[1, s];4+ (5+0)=9
s-4;[2, s];7+ (3+0)=10
s-t;[3, 1, s];2+ (4+ (5+0))=11

No
?- abolish(d_temp/4), d_1(s,t,C,D), listing(d_temp).

:- dynamic d_temp/4.

d_temp(s, 1, [s], 5+0).
d_temp(s, 2, [s], 3+0).
d_temp(s, 3, [1, s], 4+ (5+0)).
d_temp(s, 4, [2, s], 7+ (3+0)).
d_temp(s, t, [3, 1, s], 2+ (4+ (5+0))).

C = [3, 1, s]
D = 2+ (4+ (5+0)) 

Yes
?- l(s,t,X,L),P is L,nl,write(s-t;X;L=P),fail.

s-t;[3, 1, s];2+ (4+ (5+0))=11
s-t;[3, 2, s];2+ (9+ (3+0))=14
s-t;[3, 2, 1, s];2+ (9+ (2+ (5+0)))=18
s-t;[4, 2, s];3+ (7+ (3+0))=13
s-t;[4, 2, 1, s];3+ (7+ (2+ (5+0)))=17
s-t;[4, 3, 1, s];3+ (5+ (4+ (5+0)))=17
s-t;[4, 3, 2, s];3+ (5+ (9+ (3+0)))=20
s-t;[4, 3, 2, 1, s];3+ (5+ (9+ (2+ (5+0))))=24

No
?- v(S),v(T),d(S,T,X,L),
P is L,nl,write(S-T;X;L=P),fail.

s-s;[];0=0
s-1;[s];5+0=5
s-2;[s];3+0=3
s-3;[1, s];4+ (5+0)=9
s-4;[2, s];7+ (3+0)=10
s-t;[3, 1, s];2+ (4+ (5+0))=11
1-1;[];0=0
1-2;[1];2+0=2
1-3;[1];4+0=4
1-4;[2, 1];7+ (2+0)=9
1-4;[3, 1];5+ (4+0)=9
1-t;[3, 1];2+ (4+0)=6
2-2;[];0=0
2-3;[2];9+0=9
2-4;[2];7+0=7
2-t;[4, 2];3+ (7+0)=10
3-3;[];0=0
3-4;[3];5+0=5
3-t;[3];2+0=2
4-4;[];0=0
4-t;[4];3+0=3
t-t;[];0=0

No
*/


% shortest sub-x-y paths generated from the potential
% of the shortest s-t(x-y) path tree.
% ----------------------------------------  %
% added: 10-11 Nov 2005


d_p( Y, Y, [], 0).

d_p( X, Y, Path, D):-
   clause(d_temp( X, Y, Path, D),_).

d_p( X, Y, Path, D):-
   there_is_no_d_temp( X, Y),
   d_temp( W, Y, Rsy, Py),
   d_temp( W, X, Rsx, Px),
   member(X, Rsy),
   D = Py - Px,
   subtract( Rsy, Rsx, Path).

d_p_1( _, _, _, _):-
   \+ clause(d_temp( _, _, _, _),_),
   d_1( s, t, _,_),
   fail.
   
d_p_1( S, T, P, D):-
   d_p( S, T, P, D).

d_p_1( S, T, [X|Y], C + D):-
   v( S),
   v( T),
   \+ d_p( S, T, _, _),
   min( L,
    (
     c( X, T, C),
     d_p_1( S, X, Y, D),
     L is D + C
    )
   ),
   record_d( S, T, [X|Y], C+D),
   nl,
   write(add:d_p( S, T, [X|Y], C+D)).


%  demo
% ----------------------------------------  %
/*
?- d_1(s,t,_,_).

Yes
?- d_p(X,Y,P,D),nl,write(X-Y;P;D),fail.

_G160-_G160;[];0
s-1;[s];5+0
s-2;[s];3+0
s-3;[1, s];4+ (5+0)
s-4;[2, s];7+ (3+0)
s-t;[3, 1, s];2+ (4+ (5+0))
1-3;[1];4+ (5+0)- (5+0)
1-t;[3, 1];2+ (4+ (5+0))- (5+0)
2-4;[2];7+ (3+0)- (3+0)
3-t;[3];2+ (4+ (5+0))- (4+ (5+0))

No
?- l(X,Y,P,D),
\+ d(X,Y,_,_),write([(X,Y)]),fail.

No
?- findall((X,Y),(l(X,Y,P,D),
\+ d_p(X,Y,_,_)),L),sort(L,R),write(R),fail.
[ (1, 2), (1, 4), (2, 3), (2, t), (3, 4), (4, t)]

No
?- d_p_1(X,Y,P,D),nl,write(X-Y;P;D),fail.

_G160-_G160;[];0
s-1;[s];5+0
s-2;[s];3+0
s-3;[1, s];4+ (5+0)
s-4;[2, s];7+ (3+0)
s-t;[3, 1, s];2+ (4+ (5+0))
1-3;[1];4+ (5+0)- (5+0)
1-t;[3, 1];2+ (4+ (5+0))- (5+0)
2-4;[2];7+ (3+0)- (3+0)
3-t;[3];2+ (4+ (5+0))- (4+ (5+0))
add:d_p(1, 2, [1], 2+0)
1-2;[1];2+0
add:d_p(1, 4, [2, 1], 7+ (2+0))
1-4;[2, 1];7+ (2+0)
add:d_p(1, 4, [3, 1], 5+ (4+ (5+0)- (5+0)))
1-4;[3, 1];5+ (4+ (5+0)- (5+0))
add:d_p(2, 3, [2], 9+0)
2-3;[2];9+0
add:d_p(2, t, [4, 2], 3+ (7+ (2+0)- (2+0)))
2-t;[4, 2];3+ (7+ (2+0)- (2+0))
add:d_p(2, t, [4, 2], 3+ (7+ (3+0)- (3+0)))
2-t;[4, 2];3+ (7+ (3+0)- (3+0))
add:d_p(3, 4, [3], 5+0)
3-4;[3];5+0
add:d_p(4, t, [4], 3+0)
4-t;[4];3+0

No
?-
*/

% ----------------------------------------  %
%  Marginal value of each edge:
%  Computing VCG prices of the shortest path
% ----------------------------------------  %
% added: 3-11 Nov 2005



%  finding a POSSIBLE path without an edge
% ----------------------------------------  %

lx( S, X, Y, (U,V), D):-
   c( U, V, _C),
   lx0( S, X, Y, (U,V), D).


lx0( S, S, [], _, 0):- v( S).

lx0( S, T, [X|Y], (U,V), C + D ):-
   c( X, T, C),
   (X,T) \= (U,V),
   lx0( S, X, Y, (U,V), D).

%  finding the SHORTEST path without an edge
% ----------------------------------------  %

dx( S, X, Y, (U,V), D):-
   c( U, V, _C),
   dx0( S, X, Y, (U,V), D).


dx0( S, S, [], _, 0):- v( S).

dx0( S, T, [X|Y], (U,V), C + D):-
   min( L,
    (
     c( X, T, C),
     (X,T) \= (U,V),
     dx0( S, X, Y, (U,V), D),
     L is D + C
    )
   ).


%  demo
% ----------------------------------------  %
/*
?- lx(s,t,X,(1,3),L),P is L,nl,write(s-t;X;L=P),fail.

s-t;[3, 2, s];2+ (9+ (3+0))=14
s-t;[3, 2, 1, s];2+ (9+ (2+ (5+0)))=18
s-t;[4, 2, s];3+ (7+ (3+0))=13
s-t;[4, 2, 1, s];3+ (7+ (2+ (5+0)))=17
s-t;[4, 3, 2, s];3+ (5+ (9+ (3+0)))=20
s-t;[4, 3, 2, 1, s];3+ (5+ (9+ (2+ (5+0))))=24

No
?- (S,T)=(s,t),
dx(S,T,X,E,L),P is L,nl,write(S-T;minus(E);X;L=P),fail.

s-t;minus((s, 1));[4, 2, s];3+ (7+ (3+0))=13
s-t;minus((s, 2));[3, 1, s];2+ (4+ (5+0))=11
s-t;minus((1, 2));[3, 1, s];2+ (4+ (5+0))=11
s-t;minus((1, 3));[4, 2, s];3+ (7+ (3+0))=13
s-t;minus((2, 4));[3, 1, s];2+ (4+ (5+0))=11
s-t;minus((2, 3));[3, 1, s];2+ (4+ (5+0))=11
s-t;minus((3, t));[4, 2, s];3+ (7+ (3+0))=13
s-t;minus((3, 4));[3, 1, s];2+ (4+ (5+0))=11
s-t;minus((4, t));[3, 1, s];2+ (4+ (5+0))=11

No
?- switch_model(I).
%                    4        2          3       
%              [1]--->---[3]-->--- [5]--->--[t]  
%              /|      /  |      /  |     /      
%             / |2    /   |     /   |    ^       
%          5 ^  v   9^   5|    ^    |6  /4       
%           /   |   /     v   / 3   v  /         
%          /    |  /      |  /      | /          
%      [s]-->--[2]--->---[4]---->--[6]           
%           3         7        5                 


I = no(1)->no(2) 

Yes
?- dx(s,t,A,B,C),edge_on_path(B,[t,5,3,1,s]),
D is C,nl,write((A,B,C=D)),fail.

[5, 4, 2, s], (s, 1), 3+ (3+ (7+ (3+0)))=16
[5, 4, 2, s], (1, 3), 3+ (3+ (7+ (3+0)))=16
[5, 4, 2, s], (3, 5), 3+ (3+ (7+ (3+0)))=16
[6, 4, 2, s], (5, t), 4+ (5+ (7+ (3+0)))=19

No
?- 

*/


%  edge on the path
% (only for verification)
% ----------------------------------------  %

edge_on_path((U,V),Path):-
   reverse( Path, RP),
   append( _,[U,V|_], RP).

edge_on_path_backward((U,V),Path):-
   append( _,[V,U|_],Path).

%  edge off the path
% (path infomation required)
% ----------------------------------------  %

edge_off_path((W,T),C,Path):-
   c( W, T, C),
   \+ edge_on_path((W,T), Path).


%  connected edges (represented as path) 
%  off the x-y shortest path
% ----------------------------------------  %

l_off_path_1( S, S, [], _, 0):- v( S).

l_off_path_1( S, T, [W|Z], Omit, C + D ):-
   edge_off_path( (W,T), C, Omit),
   l_off_path_1( S, W, Z, Omit, D).

l_off_path( S, T, P, (X,Y,Omit), D):-
   d_p_1( X, Y, Omit,_),
   l_off_path_1( S, T, P, [Y|Omit], D).


%  demo
% ----------------------------------------  %
/*
?- l_off_path( S, T, P, (s,t,Omit), D),
nl,write([t|Omit];[T|P]),fail.

[t, 3, 1, s];[s]
[t, 3, 1, s];[1]
[t, 3, 1, s];[2]
[t, 3, 1, s];[3]
[t, 3, 1, s];[4]
[t, 3, 1, s];[t]
[t, 3, 1, s];[2, s]
[t, 3, 1, s];[2, 1]
[t, 3, 1, s];[4, 2]
[t, 3, 1, s];[4, 2, s]
[t, 3, 1, s];[4, 2, 1]
[t, 3, 1, s];[3, 2]
[t, 3, 1, s];[3, 2, s]
[t, 3, 1, s];[3, 2, 1]
[t, 3, 1, s];[4, 3]
[t, 3, 1, s];[4, 3, 2]
[t, 3, 1, s];[4, 3, 2, s]
[t, 3, 1, s];[4, 3, 2, 1]
[t, 3, 1, s];[t, 4]
[t, 3, 1, s];[t, 4, 2]
[t, 3, 1, s];[t, 4, 2, s]
[t, 3, 1, s];[t, 4, 2, 1]
[t, 3, 1, s];[t, 4, 3]
[t, 3, 1, s];[t, 4, 3, 2]
[t, 3, 1, s];[t, 4, 3, 2, s]
[t, 3, 1, s];[t, 4, 3, 2, 1]

No
?- 
*/




%  block:
%  the connected components from/to each vertex
%  on the shortest path
% ----------------------------------------  %
% note: 
% I modified the definitions of the block and the 
% left index below with respect to the direction of edges,
% originally not clear in Hersberger and Suri. 


% off_path_block/4 (from)

% the set of edges off the x-y shortest path
% which is used to connect
% FROM a vertex on the shortest path.


off_path_block( Block, from, V, (X,Y,Path)):-
   d_p_1( X, Y, Path, _),
   member( V, [Y|Path]),
   findall( (A,B),
    (
     l_off_path( V, B, [A|_], (X,Y,Path),_)
    ),
   LB),
   sort( LB, Block).

% off_path_block/4 (to)

% the set of edges off the x-y shortest path
% which is used to connect
% TO a vertex on the shortest path.

off_path_block( Block, to, V, (X,Y,Path)):-
   d_p_1( X, Y, Path, _),
   member( V, [Y|Path]),
   findall( (A,B),
    (
     l_off_path( A, V, Z, (X,Y,Path),_),
     reverse( [V|Z], [A,B|_])
    ),
   LB),
   sort( LB, Block).



%  demo
% ----------------------------------------  %
/*

?- off_path_block( Block, from, V, (s,t,Path)),
nl,write(V;Path;Block),fail.

t;[3, 1, s];[]
3;[3, 1, s];[ (3, 4), (4, t)]
1;[3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t)]
s;[3, 1, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]

No
?- off_path_block( Block, to, V, (s,t,Path)),
nl,write(V;Path;Block),fail.

t;[3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
3;[3, 1, s];[ (1, 2), (2, 3), (s, 2)]
1;[3, 1, s];[]
s;[3, 1, s];[]

No
?-
*/

% minimal block
% ----------------------------------------  %

min_block( W, Block, (V,[Y|Pv]), (X,Y,Path)):-
   d_p_1( X, Y, Path,_),
   d_p_1( V, Y, Pv,_),
   max( K,
    (
     member( W, [Y|Pv]),
     nth1( K, [Y|Path], W),
     off_path_block( Block, to, W, (X,Y,Path))
    )
   ).

%  demo
% ----------------------------------------  %
/*
?- min_block( W, Block, Vp, (s,t,Path)),
nl,write(mb=W;[t|Path];Vp;Block),fail.

mb=t;[t, 3, 1, s];t, [t];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
mb=s;[t, 3, 1, s];s, [t, 3, 1, s];[]
mb=1;[t, 3, 1, s];1, [t, 3, 1];[]
mb=t;[t, 3, 1, s];2, [t, 4, 2];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
mb=3;[t, 3, 1, s];3, [t, 3];[ (1, 2), (2, 3), (s, 2)]
mb=t;[t, 3, 1, s];4, [t, 4];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]

No
?-
*/

% maximal block
% ----------------------------------------  %
% analogue of min_block
% because block is nondeterministic

max_block( W, Block, (U,[U|Pu]), (X,Y,Path)):-
   d_p_1( X, Y, Path,_),
   d_p_1( X, U, Pu,_),
   min( K,
    (
     member( W, [U|Pu]),
     nth1( K, [Y|Path], W),
     off_path_block( Block, from, W, (X,Y,Path))
    )
   ).

%  demo
% ----------------------------------------  %
/*
?- max_block( W, Block, Vp, (s,t,Path)),
nl,write(mb=W;[t|Path];Vp;Block),fail.

mb=s;[t, 3, 1, s];s, [s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
mb=1;[t, 3, 1, s];1, [1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t)]
mb=s;[t, 3, 1, s];2, [2, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
mb=3;[t, 3, 1, s];3, [3, 1, s];[ (3, 4), (4, t)]
mb=s;[t, 3, 1, s];4, [4, 2, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
mb=t;[t, 3, 1, s];t, [t, 3, 1, s];[]

No
?-
*/


% left and right indices
% ----------------------------------------  %

left_index_of_edge( (U,V), [], XY_Path, U):-
   d_p_1( X, Y, Path,_),
   XY_Path=(X, Y, Path),
   edge_on_path((U,V),[Y|Path]).

left_index_of_edge( (U,V), Block, XY_Path, Left):-
   max_block( Left, Block, (U,_), XY_Path),
   member( (U,V), Block).

right_index_of_edge( (U,V), [], XY_Path, V):-
   d_p_1( X, Y, Path,_),
   XY_Path=(X, Y, Path),
   edge_on_path((U,V),[Y|Path]).

right_index_of_edge( (U,V), Block, XY_Path, Right):-
   min_block( Right, Block, (V,_), XY_Path),
   member( (U,V), Block).


%  demo
% ----------------------------------------  %
/*
?- left_index_of_edge( (U,V), Block, XY_Path, Left),
XY_Path=(s,t,_),
nl,write(Left;U-V;XY_Path;Block),fail.

s;s-1;[t, 3, 1, s];[]
1;1-3;[t, 3, 1, s];[]
3;3-t;[t, 3, 1, s];[]
s;s-2;[t, 3, 1, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
1;1-2;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t)]
s;2-3;[t, 3, 1, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
s;2-4;[t, 3, 1, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
3;3-4;[t, 3, 1, s];[ (3, 4), (4, t)]
s;4-t;[t, 3, 1, s];[ (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]

No
?- right_index_of_edge( (U,V), Block, XY_Path, Right),
XY_Path=(s,t,_),
nl,write(Right;U-V;XY_Path;Block),fail.

1;s-1;[t, 3, 1, s];[]
3;1-3;[t, 3, 1, s];[]
t;3-t;[t, 3, 1, s];[]
t;4-t;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
t;1-2;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
t;s-2;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
3;2-3;[t, 3, 1, s];[ (1, 2), (2, 3), (s, 2)]
t;2-4;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]
t;3-4;[t, 3, 1, s];[ (1, 2), (2, 3), (2, 4), (3, 4), (4, t), (s, 2)]

No
?- 
*/


% ----------------------------------------  %
%  Path algorithm
%  with display of processing
% ----------------------------------------  %

:- dynamic edge_left/2.
:- dynamic edge_right/2.
:- dynamic priority_queue/2.
:- dynamic  min_weight/3.
:- dynamic  algorithm_display_mode/2.


% edge_left( (u,v), V_left).
% edge_right( (u,v), V_right).
% priority_queue( (u,v), Weight).
% min_weight( (X,Y,Path, D), (U,V), Weight).


%  diplay mode and switch for path_algorithm/1
% ----------------------------------------  %

algorithm_display_mode( on, _).

switch_algorithm_display_mode( X-> Y, Step):-
   member((X,Y),[(on,off),(off,on)]),
   algorithm_display_mode( X, Step),
   forall(
     retract( algorithm_display_mode( X, Step)),
     true
   ),
   assert( algorithm_display_mode( Y, Step)).


%  rank comparison of vertex pair
% ----------------------------------------  %

precedence_in_path(U,V,Path):-
   append( _,[V|Right],Path),
   append( _,[U|_],Right).


%  preliminary for the path algorithm
% ----------------------------------------  %

initialize_edge_lists:-
   abolish( min_weight/3),
   abolish( priority_queue/2),
   abolish( edge_left/2),
   abolish( edge_right/2).

add_left_and_right_edges( (U, V), (V_left,V_right)):-
   assert( edge_left( (U,V), V_left)),
   assert( edge_right( (U,V), V_right)).

left_precedes_right((U,V),PathInfo,Ref,T):-
   PathInfo=(_X,Y,Path),
   left_index_of_edge( (U,V), BL, PathInfo, VL),
   right_index_of_edge( (U,V), BR, PathInfo, VR),
   Ref=[(VL,VR),(BL,BR)],
   (
    precedence_in_path(VL,VR,[Y|Path])
     ->T=true
     ; T=false
   ).
   
%  demo
% ----------------------------------------  %
/*
?- X=s,Y=t,d_p_1(X,Y,Path,D),
left_precedes_right((U,V),(X,Y,Path),[Index|_],T),
nl,write(T:(U,V):Index),fail.

true: (s, 1): (s, 1)
true: (1, 3): (1, 3)
true: (3, t): (3, t)
true: (s, 2): (s, t)
true: (1, 2): (1, t)
true: (2, 3): (s, 3)
true: (2, 4): (s, t)
true: (3, 4): (3, t)
true: (4, t): (s, t)

No
?- 
*/


%  the shortest x-y path tree
% ----------------------------------------  %

shortest_path_tree( X,Y,Path,D):-
   abolish( d_temp/4),
   d_1( X, Y, Path, D),
   display_for_shortest_path_tree(X, Y, Path, D).

%  display for the spt
% ----------------------------------------  %

display_for_shortest_path_tree:-
   algorithm_display_mode( off, shortest_path_tree).

display_for_shortest_path_tree(X,Y,Path,D):-
   algorithm_display_mode( on, shortest_path_tree),
   write(['given the x-y shortest path':X-Y:Path:D]),
   nl,
   listing(d_temp).

%  main
% ----------------------------------------  %

path_algorithm( PathInfo:D):-
   (X,Y)=(s,t),
   shortest_path_tree( X,Y,Path,D),
   path_algorithm_step_1,
   PathInfo=(X,Y,Path),
   path_algorithm_step_2( PathInfo),
   path_algorithm_step_3( PathInfo).


%  step 1
% ----------------------------------------  %

path_algorithm_step_1:-
   initialize_edge_lists,
   display_for_step( 1).

%  step 2
% ----------------------------------------  %

path_algorithm_step_2( P):-
   P=(_X,Y,Path),
   forall(
    (
     edge_off_path((U,V),_C,[Y|Path]),
     left_precedes_right((U,V),P,[(VL,VR)|_],T),
     T=true
    ),
    (
     add_left_and_right_edges( (U,V), (VL,VR))
    )
   ),
   display_for_step( 2).


%  step 3
% ----------------------------------------  %

path_algorithm_step_3( P):-
   P=(_X, Y, Path),
   %E =(Vi,Next),
   forall(
     edge_on_path( E,[Y|Path]),
     path_algorithm_step_3( P, E)
   ),
   display_for_step( 3).

path_algorithm_step_3( P, E):-
   %P =(_X, Y, Path),
   %E =(Vi,Next),
   path_algorithm_step_3_a( P, E),
   path_algorithm_step_3_a_x( P, E),
   path_algorithm_step_3_b( P, E),
   path_algorithm_step_3_c( P, E).


%  substeps of step 3
% ----------------------------------------  %

path_algorithm_step_3_a( P, (Vi,Vnext)):-
   P =(X, Y, _),
   forall(
    (
     edge_left( (U,V), Vi)
    ),
    (
     d_p_1( X, U, _, Dx),
     c( U, V, C),
     d_p_1( V, Y, _, Dy),
     Weight = Dx + C + Dy,
     W is Weight,
     assert( priority_queue( (U,V), Weight=W))
    )
   ),
   display_for_step( (3,a,(Vi,Vnext))).


%  The following step 3(a-x),
%  the intermediate comparison for step 3(a),
%  is not a step of the original.

path_algorithm_step_3_a_x( P, (Vi,Next)):-
   P =(X, Y, _),
   forall(
    (
     edge_left( (U,V), Vi)
    ),
    (
     dx( X, U, _, (Vi,Next), Dx),
     c( U, V, C),
     dx( V, Y, _, (Vi,Next), Dy),
     Weight = Dx + C + Dy,
     W is Weight,
     priority_queue( (U,V), _=W1),
     display_for_step_3_a_x(W,W1,(U,V),(Vi,Next))
    )
   ),
   display_for_step( (3,ax,(Vi,Next))).

path_algorithm_step_3_b( _P, (Vi,_Vn)):-
   forall(
    (
     edge_right( (U,V), Vi)
    ),
    forall(
     retract( priority_queue( (U,V), _)),
     true
    )
   ),
   display_for_step( (3,b,(Vi,_Vn))).

path_algorithm_step_3_c( P, E):-
   %P=(X, Y, Path),
   min( W,
    (
     priority_queue( (U,V), Weight=W)
    )
   ),
   assert(
     min_weight( P - E, (U,V), Weight=W)
   ),
   display_for_step( (3,c,E)).


%  display for the steps
% ----------------------------------------  %

display_for_step( Step):-
   algorithm_display_mode( off, Step).

display_for_step( 1):-
   algorithm_display_mode( on, step_1),
   nl,
   write(['step 1 complete']),
   nl.

display_for_step( 2):-
   nl,
   write(['step 2 complete']),
   nl,
   listing( edge_left/2),
   listing( edge_right/2).

display_for_step( 3):-
   algorithm_display_mode( on, step_3),
   nl,
   write(['step 3 complete']),
   nl.

display_for_step( (3,a, E)):-
   algorithm_display_mode( on, step_3(a)),
   write(['step 3 (a)', for(E), complete]),
   nl,
   listing( priority_queue/2).

display_for_step( (3,b, E)):-
   algorithm_display_mode( on, step_3(b)),
   write(['step 3 (b)', for(E), complete]),
   nl,
   listing( priority_queue/2).

display_for_step( (3,c, E)):-
   algorithm_display_mode( on, step_3(c)),
   write(['step 3 (c)', for(E), complete]),
   nl,
   listing( min_weight/3).


display_for_step( (3,ax,E)):-
   algorithm_display_mode( on, step_3(ax)),
   write(['comparison using dx/5',for(E), complete]),
   nl.

display_for_step_3_a_x(W,W1,(U,V),(Vi,Next)):-
   algorithm_display_mode( on, step_3(a,x)),
   (W \= W1 
    -> write(diff((U,V),(Vi,Next),d_1=W1,dx=W)),nl
    ; write(ok((U,V),(Vi,Next))),nl
   ).


%  demo
% ----------------------------------------  %
/*

?- [path].
%                    4        2        
%              [1]--->---[3]-->--- [t] 
%              /|      /  |      /     
%             / |2    /   |     /      
%          5 ^  v   9^   5|    ^       
%           /   |   /     v   / 3      
%          /    |  /      |  /         
%      [s]-->--[2]--->---[4]           
%           3         7                

% path compiled 0.05 sec, 0 bytes

Yes
?- [menu].

Yes
?- tell_goal( 'path.txt', path_algorithm(P)).

%%% omitting saved output below
%%% using tell_goal/2 in menu.pl 

P = (s, t, [3, 1, s]):2+ (4+ (5+0)) 

Yes
?-



% file output start time , [date(2005/10/11), time(10:41:22)]

%----------  start from here ------------%
[given the x-y shortest path:s-t:[3, 1, s]:2+ (4+ (5+0))]

:- dynamic d_temp/4.

d_temp(s, 1, [s], 5+0).
d_temp(s, 2, [s], 3+0).
d_temp(s, 3, [1, s], 4+ (5+0)).
d_temp(s, 4, [2, s], 7+ (3+0)).
d_temp(s, t, [3, 1, s], 2+ (4+ (5+0))).

[step 1 complete]

add:d_p(1, 2, [1], 2+0)
add:d_p(1, 4, [2, 1], 7+ (2+0))
add:d_p(1, 4, [3, 1], 5+ (4+ (5+0)- (5+0)))
add:d_p(2, 3, [2], 9+0)
add:d_p(2, t, [4, 2], 3+ (7+ (2+0)- (2+0)))
add:d_p(2, t, [4, 2], 3+ (7+ (3+0)- (3+0)))
add:d_p(3, 4, [3], 5+0)
add:d_p(4, t, [4], 3+0)
[step 2 complete]

:- dynamic edge_left/2.

edge_left((s, 2), s).
edge_left((s, 2), s).
edge_left((1, 2), 1).
edge_left((1, 2), 1).
edge_left((2, 4), s).
edge_left((2, 3), s).
edge_left((3, 4), 3).
edge_left((4, t), s).

:- dynamic edge_right/2.

edge_right((s, 2), t).
edge_right((s, 2), t).
edge_right((1, 2), t).
edge_right((1, 2), t).
edge_right((2, 4), t).
edge_right((2, 3), 3).
edge_right((3, 4), t).
edge_right((4, t), t).
[step 3 (a), for((s, 1)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((2, 3), 3+0+9+ (2+ (4+ (5+0))- (4+ (5+0)))=14).
priority_queue((4, t), 7+ (3+0)+3+0=13).
ok((s, 2), (s, 1))
ok((s, 2), (s, 1))
ok((2, 4), (s, 1))
ok((2, 3), (s, 1))
ok((4, t), (s, 1))
[comparison using dx/5, for((s, 1)), complete]
[step 3 (b), for((s, 1)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((2, 3), 3+0+9+ (2+ (4+ (5+0))- (4+ (5+0)))=14).
priority_queue((4, t), 7+ (3+0)+3+0=13).
[step 3 (c), for((s, 1)), complete]

:- dynamic min_weight/3.

min_weight((s, t, [3, 1, s])- (s, 1), (2, 4), 3+0+7+ (3+0)=13).
[step 3 (a), for((1, 3)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((2, 3), 3+0+9+ (2+ (4+ (5+0))- (4+ (5+0)))=14).
priority_queue((4, t), 7+ (3+0)+3+0=13).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
ok((1, 2), (1, 3))
ok((1, 2), (1, 3))
[comparison using dx/5, for((1, 3)), complete]
[step 3 (b), for((1, 3)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((2, 3), 3+0+9+ (2+ (4+ (5+0))- (4+ (5+0)))=14).
priority_queue((4, t), 7+ (3+0)+3+0=13).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
[step 3 (c), for((1, 3)), complete]

:- dynamic min_weight/3.

min_weight((s, t, [3, 1, s])- (s, 1), (2, 4), 3+0+7+ (3+0)=13).
min_weight((s, t, [3, 1, s])- (1, 3), (2, 4), 3+0+7+ (3+0)=13).
[step 3 (a), for((3, t)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((2, 3), 3+0+9+ (2+ (4+ (5+0))- (4+ (5+0)))=14).
priority_queue((4, t), 7+ (3+0)+3+0=13).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((3, 4), 4+ (5+0)+5+ (3+0)=17).
ok((3, 4), (3, t))
[comparison using dx/5, for((3, t)), complete]
[step 3 (b), for((3, t)), complete]

:- dynamic priority_queue/2.

priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((s, 2), 0+3+ (3+ (7+ (2+0)- (2+0)))=13).
priority_queue((2, 4), 3+0+7+ (3+0)=13).
priority_queue((4, t), 7+ (3+0)+3+0=13).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((1, 2), 5+0+2+ (3+ (7+ (2+0)- (2+0)))=17).
priority_queue((3, 4), 4+ (5+0)+5+ (3+0)=17).
[step 3 (c), for((3, t)), complete]

:- dynamic min_weight/3.

min_weight((s, t, [3, 1, s])- (s, 1), (2, 4), 3+0+7+ (3+0)=13).
min_weight((s, t, [3, 1, s])- (1, 3), (2, 4), 3+0+7+ (3+0)=13).
min_weight((s, t, [3, 1, s])- (3, t), (2, 4), 3+0+7+ (3+0)=13).

[step 3 complete]

%----------  end of data ------------%
% file output end time , [date(2005/10/11), time(10:41:23)]

*/

return to front page.