################################################
#
# Lara Pudwell
# May 2, 2006
# Experimental Math final project: solving riddles with Dijkstra's Algorithm
#
################################################

Help:=proc()
if nargs=0 then
print("dijkstra: a maple package that implements dijkstra's algorithm to solve riddles by Lara Pudwell.  This version May 2, 2006"):
print(`Available functions are: Dij(G,u,v), Dij2(G,u,v), neighs(G,u), inneighs(G,u), outneighs(G,u), CMSW(),CM(),FL()`):
print("try Help(function_name); to get more info about a particular function"):

elif nargs=1 and args[1]=Dij then
print("Dij(G,u,v): given an undirected weighted graph G=[V,E] and vertices u and v, uses Dijkstra's algorithm to compute the shortest length path from u to v"):
print("for example, try Dij([{a,b,c,d,e,f,g,h,i,j,k,l},{[a,b,3],[b,d,2],[d,g,3],[g,j,5],[j,l,5],[b,e,4],[e,g,1],[h,j,5],[a,e,9],[e,h,2],[h,l,9],[a,c,2],[c,e,6],[f,h,1],[h,k,6],[c,f,9],[f,i,2],[i,k,2],[k,l,3]}],a,l);"):

elif nargs=1 and args[1]=Dij2 then
print("Dij2(G,u,v): given an directed weighted graph G=[V,E] and vertices u and v, uses Dijkstra's algorithm to compute the shortest length alternating path from u to v"):
print("for example, try Dij2([{a,b,c,d},{[a,b,1],[c,b,2],[a,d,3],[c,d,1]}],a,c);"):

elif nargs=1 and args[1]=neighs then
print("neighs(G,u): given a graph G and a vertex u, finds all neighbors of u in G"):

elif nargs=1 and args[1]=inneighs then
print("inneighs(G,u): given a digraph G and a vertex u, finds all in-neighbors of u in G"):

elif nargs=1 and args[1]=outneighs then
print("outneighs(G,u): given a digraph G and a vertex u, finds all out-neighbors of u in G"):

elif nargs=1 and args[1]=CMSW then
print("CMSW(): solves the cabbage, man, sheep, wolf puzzle by calling Dij2 with an appropriate graph:"):
print("where N is where no one on the first side of the river, and all other vertex names represent all characters on the first bank, (e.g. CMS means cabbage, man, and sheep are on the first side, and wolf is on the second side)"):

elif nargs=1 and args[1]=CM then
print("CM(): solves the cannibal/missionary puzzle where everyone can row by calling Dij2 with an appropriate graph:"):
print("where N is where no one on the first side of the river, and all other vertex names represent all characters on the first bank, (e.g. c1m3b means 1 cannibal, 3 missionaries, and the boat are on the first side)"):

elif nargs=1 and args[1]=FL then
print("FL(): solves the flashlight puzzle by calling Dij2 with an appropriate graph"):
print("A is the person who can travel in 1 minute, B can travel in 2, C can travel in 4, and D can travel in 5 minutes, F is the flashlight"):
print("ABDF means that A,B,D, and the flashlight are at the start of the cave, D is at the end"):

fi:

end:

FL:=proc()
Dij2([{N,A,AF,B,BF,C,CF,D,DF,AB,ABF,AC,ACF,AD,ADF,BC,BCF,BD,BDF,CD,CDF,ABC,ABCF,ABD,ABDF,ACD,ACDF,BCD,BCDF,ABCDF},{[AF,N,1],[BF,N,2],[CF,N,4],[DF,N,5],[ABF,B,1],[ABF,N,2],[ABF,A,2],[ACF,C,1],[ACF,N,4],[ACF,A,4],[ADF,D,1],[ADF,N,5],[ADF,A,5],[BCF,C,2],[BCF,N,4],[BCF,B,4],[BDF,D,2],[BDF,N,5],[BDF,B,5],[CDF,D,4],[CDF,N,5],[CDF,C,5],[ABCF,BC,1],[ABCF,AC,2],[ABCF,AB,4],[ABCF,C,2],[ABCF,B,4],[ABCF,A,4],[ABDF,BD,1],[ABDF,AD,2],[ABDF,AB,5],[ABDF,D,2],[ABDF,B,5],[ABDF,A,5],[ACDF,CD,1],[ACDF,AD,4],[ACDF,AC,5],[ACDF,D,4],[ACDF,C,5],[ACDF,A,5],[BCDF,CD,2],[BCDF,BD,4],[BCDF,BC,5],[BCDF,D,4],[BCDF,C,5],[BCDF,B,5],[ABCDF,CD,2],[ABCDF,BD,4],[ABCDF,BC,5],[ABCDF,AD,4],[ABCDF,AC,5],[ABCDF,AB,2],[ABCDF,BCD,1],[ABCDF,ACD,2],[ABCDF,ABD,4],[ABCDF,ABC,5],[N,AF,1],[N,BF,2],[N,CF,4],[N,DF,5],[B,ABF,1],[N,ABF,2],[A,ABF,2],[C,ACF,1],[N,ACF,4],[A,ACF,4],[D,ADF,1],[N,ADF,5],[A,ADF,5],[C,BCF,2],[N,BCF,4],[B,BCF,4],[D,BDF,2],[N,BDF,5],[B,BDF,5],[D,CDF,4],[N,CDF,5],[C,CDF,5],[BC,ABCF,1],[AC,ABCF,2],[AB,ABCF,4],[C,ABCF,2],[B,ABCF,4],[A,ABCF,4],[BD,ABDF,1],[AD,ABDF,2],[AB,ABDF,5],[D,ABDF,2],[B,ABDF,5],[A,ABDF,5],[CD,ACDF,1],[AD,ACDF,4],[AC,ACDF,5],[D,ACDF,4],[C,ACDF,5],[A,ACDF,5],[CD,BCDF,2],[BD,BCDF,4],[BC,BCDF,5],[D,BCDF,4],[C,BCDF,5],[B,BCDF,5],[CD,ABCDF,2],[BD,ABCDF,4],[BC,ABCDF,5],[AD,ABCDF,4],[AC,BCDF,5],[AB,ABCDF,2],[BCD,ABCDF,1],[ACD,ABCDF,2],[ABD,ABCDF,4],[ABC,ABCDF,5]}],ABCDF,N);
end:

CM:=proc()
Dij2([{c3m3b,c2m2b,c2m2,c1m1b,c1m1,c0m0,c3m0,c3m0b,c2m0b,c2m0,c1m0b,c1m0,c0m3b,c0m3,c1m3b,c1m3,c2m3b,c2m3},{[c3m3b,c2m2,0],[c3m3b,c1m3,0],[c3m3b,c2m3,0],[c2m2b,c1m1,0],[c2m2b,c2m0,0],[c1m1b,c1m0,0],[c1m1b,c0m0,0],[c3m0b,c2m0,0],[c3m0b,c1m0,0],[c2m0b,c1m0,0],[c2m0b,c0m0,0],[c1m0b,c0m0,0],[c1m3b,c0m3,0],[c1m3b,c1m1,0],[c2m3b,c0m3,0],[c2m3b,c2m2,0],[c2m3b,c1m3,0]}],c3m3b,c0m0)[2];
end:

CMSW:=proc()
Dij2([{N,C,M,S,W,CM,CS,CW,MS,MW,SW,CMS,CMW,CSW,MSW,CMSW},{[CMSW,CSW,0],[CMSW,SW,10],[CMSW,CW,0],[CMSW,CS,10],[MSW,SW,10],[MSW,W,0],[MSW,S,0],[CMW,CW,0],[CMW,W,0],[CMW,C,0],[CMS,CS,10],[CMS,S,0],[CMS,C,0],[MW,W,10],[MW,N,10],[MS,S,0],[MS,N,0],[CM,C,10],[CM,N,10],[M,N,10],[CSW,M,10],[SW,MSW,10],[SW,MCSW,10],[CW,CMW,0],[CW,CMSW,0],[CS,CMS,10],[CS,CMSW,10],[W,MW,0],[W,CMW,0],[W,CMS,0],[S,MS,0],[S,CMS,0],[S,MSW,0],[C,CM,0],[C,CMS,0],[C,CMW,0],[N,M,0],[N,CM,10],[N,MS,0],[N,MW,10]}],CMSW,N)[2];
end:


#Dij2(G,u,v): inputs an undirected weighted graph G and finds the lowest weight path
#from u to v using Dijkstra's algorithm
Dij2:=proc(G,u,v) local w,V,E,pv,tw,pw,i,cv,champ,rec,N,tv,prevV,Path1,V1,forw:
V:=G[1]:
E:=G[2]:

forw:=true:

#if we are asked to find a path that begins and ends
#in the same place, return weight=0, path=[u]
if u=v then return 0,[u]: fi:

#w is a table of the weights of all the edges
for i from 1 to nops(E) do
w[[E[i][1],E[i][2]]]:=E[i][3]:
od:

#pw is a table of "permanent weights"
#tw is a table of "temporary weights"
for i from 1 to nops(V) do
pw[V[i]]:=infinity:
tw[V[i]]:=infinity:
od:

pw[u]:=0:
tv:={}:
pv:={}:

V1:={u}:
for i from 1 to nops(V) do
if neighs(G,V[i])={} then pv:=pv union {V[i]}: fi:
od:

#cv is the current vertex
#N is its set of unlabelled neighbors
#pv is the set of vertices with "permanent" labels
cv:=u:
if forw then N:=outneighs(G,cv) minus pv:
else N:=inneighs(G,cv) minus pv: 
fi:


while pv<>V do
for i from 1 to nops(N) do
if forw and pw[cv]+w[[cv,N[i]]] < tw[N[i]] and N[i]<>u then prevV[N[i]]:=cv: fi:
if not forw and pw[cv]+w[[N[i],cv]] < tw[N[i]] and N[i]<>u then prevV[N[i]]:=cv: fi:
if forw then tw[N[i]]:=min(tw[N[i]],pw[cv]+w[[cv,N[i]]]):
else tw[N[i]]:=min(tw[N[i]],pw[cv]+w[[N[i],cv]]): fi:
tv:=tv union {N[i]}:
od:

if tv={} then ERROR(`bad input`): fi:
rec:=tw[tv[1]]:
champ:=tv[1]:
for i from 2 to nops(tv) do
if tw[tv[i]]<rec then champ:=tv[i]: rec:=tw[tv[i]]: fi:
od:

pw[champ]:=rec:
tv:=tv minus {champ}:
pv:=pv union {champ}:
cv:=champ:
forw:=not forw:
if forw then N:=outneighs(G,cv) minus pv:
else N:=inneighs(G,cv) minus pv: 
fi:

od:

#now that all vertices have been labelled with the min weight
#from u to that vertex, retrieve the min weight path from u to v
Path1:=[v]:
cv:=v:
while cv<>u do
cv:=prevV[cv]:
Path1:=[cv,op(Path1)]:
od:

pw[v], Path1:
end:


#Dij(G,u,v): inputs an undirected weighted graph G and finds the lowest weight path
#from u to v using Dijkstra's algorithm
Dij:=proc(G,u,v) local w,V,E,pv,tw,pw,i,cv,champ,rec,N,tv,prevV,Path1,V1:
V:=G[1]:
E:=G[2]:

#if we are asked to find a path that begins and ends
#in the same place, return weight=0, path=[u]
if u=v then return 0,[u]: fi:

#w is a table of the weights of all the edges
for i from 1 to nops(E) do
w[{E[i][1],E[i][2]}]:=E[i][3]:
od:

#pw is a table of "permanent weights"
#tw is a table of "temporary weights"
for i from 1 to nops(V) do
pw[V[i]]:=infinity:
tw[V[i]]:=infinity:
od:

pw[u]:=0:
tv:={}:
pv:={}:

V1:={u}:
for i from 1 to nops(V) do
if neighs(G,V[i])={} then pv:=pv union {V[i]}: fi:
od:

#cv is the current vertex
#N is its set of unlabelled neighbors
#pv is the set of vertices with "permanent" labels
cv:=u:
N:=neighs(G,cv) minus pv:

while pv<>V do

for i from 1 to nops(N) do
if pw[cv]+w[{cv,N[i]}] < tw[N[i]] and N[i]<>u then prevV[N[i]]:=cv: fi:
tw[N[i]]:=min(tw[N[i]],pw[cv]+w[{cv,N[i]}]):
tv:=tv union {N[i]}:
od:

rec:=tw[tv[1]]:
champ:=tv[1]:
for i from 2 to nops(tv) do
if tw[tv[i]]<rec then champ:=tv[i]: rec:=tw[tv[i]]: fi:
od:

pw[champ]:=rec:
tv:=tv minus {champ}:
pv:=pv union {champ}:
cv:=champ:
N:=neighs(G,cv) minus pv:
od:

#now that all vertices have been labelled with the min weight
#from u to that vertex, retrieve the min weight path from u to v
Path1:=[v]:
cv:=v:
while cv<>u do
cv:=prevV[cv]:
Path1:=[cv,op(Path1)]:
od:

pw[v], Path1:
end:

#neighs(G,u): is the set of neighbors of u in graph G
neighs:=proc(G,u) local N,E,i:
E:=G[2]:
N:={}:

for i from 1 to nops(E) do
if u=E[i][1] then N:=N union {E[i][2]}: fi:
if u=E[i][2] then N:=N union {E[i][1]}: fi:
od:

N:
end:


#neighs(G,u): is the set of out-neighbors of u in digraph G
outneighs:=proc(G,u) local N,E,i:
E:=G[2]:
N:={}:

for i from 1 to nops(E) do
if u=E[i][1] then N:=N union {E[i][2]}: fi:
od:

N:
end:


#inneighs(G,u): is the set of in-neighbors of u in digraph G
inneighs:=proc(G,u) local N,E,i:
E:=G[2]:
N:={}:

for i from 1 to nops(E) do
if u=E[i][2] then N:=N union {E[i][1]}: fi:
od:

N:
end: