Academic Articles & Supplements

Mathematica Pearls: Shortest Path Algorithm

Donald Piele

Author

Donald Piele

Title

Mathematica Pearls: Shortest Path Algorithm

Description

Mathematica Pearls

Problems and Solutions Vol 8 No 2

by Don Piele

Welcome back to Mathematica Pearls, the column devoted to examining interesting Mathematica solutions to an assortment of simple and appealing problems.

In April I had the pleasure of visiting Antalya, a lovely city in southern Turkey, on the Mediterranean coast. The purpose of the trip was to review the planned venue of the next international computer programming Olympiad. This year, in October, it will be Turkey's turn to host the 11th annual International Olympiad in Informatics (IOI). This is a computer programming competition similar in structure to the well-established International Mathematics Olympiad (IMO) that began in 1959. At IOI the top four high school computer programmers from 70 different countries compete over two five-hours days by writing efficient computer programs in Pascal or C/C++ to solve six challenging problems. For example, knowing how to program the shortest path on a weighted graph using Dijkstra's algorithm is often the key to solving an IOI type problem.

I took a direct flight from Chicago to Istanbul with a connection to Antalya. The total time from take-off to landing was around 14 hours. Knowing that the deadline for this column would be coming up after I returned, I took a fully charged Compaq notebook computer along to help ease the boredom of the long flight by working on a new problem for this column.

The Dutch mathematician, E. Dijkstra, published his famous shortest path algorithm in 1959. I thought it might be fun to graphically illustrate this celebrated algorithm within Mathematica. Between two dinners, a snack, and a few hours of light sleep, this project filled out the remaining time nicely, and the battery, on power management, held out.

I began with an example of drawing a simple weighted graph by placing seven vertices on the circumference of a circle, drawing edges between certain vertices, and assigning a weight to each edge. The assignment of weights was held in the matrix weightedEdges. Here each row {i,j,k} means there is an edge from vertex i to vertex j with weight k.

In[]:=

n=7;weightedEdges={{1,2,5},{1,3,2},{1,5,7},{2,3,1},{2,4,5},{3,4,8},{3,5,10},{4,5,2},{4,6,10},{5,6,2},{2,6,6},{1,4,12},{6,7,5},{5,7,20}};

The weights and the edges were easily picked off from this matrix.

In[]:=

weights=weightedEdges/.{i_,j_,k_}:>kedges=weightedEdges/.{i_,j_,k_}:>{i,j}

Out[]=

{5,2,7,1,5,8,10,2,10,2,6,12,5,20}

Out[]=

{{1,2},{1,3},{1,5},{2,3},{2,4},{3,4},{3,5},{4,5},{4,6},{5,6},{2,6},{1,4},{6,7},{5,7}}

Now the weighted graph was drawn on the unit circle with the vertices numbered from 1 to 7 and the beginning and ending vertex colored green.

In[]:=

edgesG=MapLineCosπ

#[[1]]-1

,

#[[1]]

(-1)

Sinπ

#[[1]]-1

,Cosπ

#[[2]]-1

,

#[[2]]

(-1)

Sinπ

#[[2]]-1

&,edges;weightsPos=edgesG/.Line[a_]:>a/.{x_List,y_List}:>(x+y)/2;ShowGraphics{Thickness[.002],RGBColor[0,0,1],edgesG}, PointSize[.05],RGBColor[0,1,0],PointCosπ

,

(-1)

Sinπ

, PointSize[.05],RGBColor[1,1,1],TablePointCosπ

i-1

,

(-1)

Sinπ

i-1

,{i,2,n-1},PointSize[.06],RGBColor[0,1,0],PointCosπ

(n-1)

,

(-1)

Sinπ

(n-1)

,TableTextFontForm[i,{"Helvetica-Bold-Italic",10}],Cosπ

i-1

,

(-1)

Sinπ

i-1

,{i,n}, {Table[Text[weights[[i]],weightsPos[[i]],{1,0}],{i,Length[weights]}]},AspectRatio->Automatic,PlotRange->{{-1.2,1.2},{-1.2,1.2}}

Out[]=

⁃Graphics⁃

Using the given weightedEdges, an adjacency array adjM was filled out placing ∞ between edges that are not connected and remembering that the you can travel either way on an edge so the weight from vertex i to vertex j must be the same as the weight from vertex j to vertex i.

In[]:=

Clear[adjM];adjM[i_,j_]:=∞;adjM[i_,j_]:=adjM[j,i]/;i>j;adjM[i_,j_]:=0/;i==j; weightedEdges/.{i_,j_,k_}:>(adjM[i,j]=k);Array[adjM,{n,n}]//MatrixForm

Out[]=

0	5	2	12	7	∞	∞
5	0	1	5	∞	6	∞
2	1	0	8	10	∞	∞
12	5	8	0	2	10	∞
7	∞	10	2	0	2	20
∞	6	∞	10	2	0	5
∞	∞	∞	∞	20	5	0

Dijkstra's algorithm begins by assigning 0 to vertex 1 and ∞ to the remaining vertices. Each vertex was labeled accordingly.

The weights assigned to edges could have various meanings, but for our purposes, we will consider them as the distance between vertices. Notice that 0 is the length of the shortest path from 1 to itself. Let S be the set of vertices whose shortest path is known. We know that vertex 1 belongs to S since the shortest path from vertex 1 to vertex 1 is zero. S={1}, distance={0,∞,∞,∞,∞,∞,∞}.

Now the distance list was updated as follows: For each vertex connected by an edge to vertex 1, replace the distance to that vertex by the weight of the edge. Those vertices that are not connected directly to vertex 1 by an edge are left alone. This is coded as follows:

If [distance[[1]]+adjM[1,v]<distance[[v]], distance[[v]]=distance[[1]]+adjM[1 ,v] ];

This leads to a new distance list as shown below. Now pick the vertex with the shortest distance to vertex 1 and add it to the set S of vertices whose shortest distance from vertex 1 is known. Vertex 3 has the shortest distance of 2. So S={1,3} and distance = {0,5,2,12,7,∞,∞}

Now, from vertex 3 we ask the same question over again. Is it shorter to travel from vertex 1 to all the other vertices going through vertex 3 or is there a shorter route already computed that does not go through vertex 3. The following code does extactly this.

If [distance[[3]]+adjM[3,v]<distance[[v]], distance[[v]]=distance[[3]]+adjM[3 ,v] ];

Again pick the vertex, not already in S, that has the shortest distance to vertex 1. This is vertex 2 which now has the shortest distance of 3.
S={1,3,2}, distance = {0,3,2,10,7,∞,∞}.

Continue updating the distance list in this way until all vertices have been added to S. The resulting distance list displays the shorest path to each vertex:
distance= {0,3,2,8,7,9,14} and S = {0,3,2,5,4,6,7}

Once all the vertices have been added to S, there is no shorter distance to each vertex. So we know the length of the shortest path from vertex 1 to all other vertices, but we dont' have a specific path, yet. That will be the your programming challenge for this issue.

Shortest Path Problem

Write a program that will take a weighted graph defined on n vertices and display a shortest path between vertex 1 and vertex n. Shown above is a path of shortest length from vertex 1 to vertex 7 for the weighted graph described above. Test your program with:

n=21;weightedEdges={{1,2,2},{1,3,4},{1,4,1},{2,3,3},{2,5,1},{3,5,2},{4,6,5},{4,7,4},{5,8,3},{6,7,3},{6,8,3},{6,9,2},{6,10,4},{7,11,2},{8,12,1},{8,15,8},{9,12,3},{9,14,2},{10,11,6},{10,13,3},{10,14,6},{11,13,4},{11,18,2},{12,15,6},{12,14,3},{13,14,5},{13,17,2},{13,18,1},{14,15,4},{14,16,2},{15,19,6},{15,16,2},{16,17,1},{16,20,1},{17,20,3},{17,18,8},{18,20,5},{19,21,2},{20,21,8}};

Pearl Harvest I

In the last column, three problems were presented. Here is the solution to one of them.

Zero Sum ('89)

Create the function zeroSum[n_] that finds all solutions to the expression: 1 @ 2 @ 3 @......@n == 0 where n is a single digit and each occurance of @ can be either a (+) or (-) or () which means to concatenate the digits.One solution for n = 7, 1 - 23 - 45 + 67

Solution
by Eric Rimbey (erimbey@wolfram.com)

This solution by Eric is a good example of how clean a solution can be if constructed functionally. I will attempt to deconstruct his solution to see what makes it tick. Since there are only three possibilities for a character between each of the digits, the maximum number of expressions that will need to be examined when n=9 is

6561. So a brute force approach will easily work. Begin by defining,

chars={"+","-",""}digitsequence=ToString/@Range[9]

{+,-,}

{1,2,3,4,5,6,7,8,9}

Form all the character sequences.

charsequences=Distribute[Join[Table[chars,{8}],{""}],List];Short[charsequences,6]

{{+,+,+,+,+,+,+,+,},{+,+,+,+,+,+,+,-,},{+,+,+,+,+,+,+,,},{+,+,+,+,+,+,-,+,},{+,+,+,+,+,+,-,-,},{+,+,+,+,+,+,-,,},{+,+,+,+,+,+,,+,},{+,+,+,+,+,+,,-,},6546,{,,,,,,+,,},{,,,,,,-,+,},{,,,,,,-,-,},{,,,,,,-,,},{,,,,,,,+,},{,,,,,,,-,},{,,,,,,,,}}

{{+,+,+,+,+,+,+,+,},{+,+,+,+,+,+,+,-,},{+,+,+,+,+,+,+,,},{+,+,+,+,+,+,-,+,},6554,{,,,,,,,+,},{,,,,,,,-,},{,,,,,,,,}}

Place the characters between the digits and form the possible strings.

digitchar=Flatten[Transpose[{digitsequence,#}]]&/@charsequences;

Short[digitchar,6]

{{1,+,2,+,3,+,4,+,5,+,6,+,7,},{1,+,2,+,3,+,4,+,5,+,6,-,7,},{1,+,2,+,3,+,4,+,5,+,6,,7,},{1,+,2,+,3,+,4,+,5,-,6,+,7,},722,{1,,2,,3,,4,,5,,6,+,7,},{1,,2,,3,,4,,5,,6,-,7,},{1,,2,,3,,4,,5,,6,,7,}}

possible=StringJoin/@digitchar;Short[possible,4]

{1+2+3+4+5+6+7,1+2+3+4+5+6-7,1+2+3+4+5+67,1+2+3+4+5-6+7,1+2+3+4+5-6-7,1+2+3+4+5-67,1+2+3+4+56+7,1+2+3+4+56-7,1+2+3+4+567,1+2+3+4-5+6+7,709,1234-567,12345+6+7,12345+6-7,12345+67,12345-6+7,12345-6-7,12345-67,123456+7,123456-7,1234567}

Now select out the expressions that sum to zero.

solutions=Select[possible,ToExpression[#]==0&]

{1+2-3+4-5-6+7,1+2-3-4+5+6-7,1-2+3+4-5+6-7,1-2-3-4-5+6+7,1-23+4+5+6+7,1-23-45+67}

Put it together and you have Eric's solution.

ZeroSum[k_Integer?(0<#<10&)]:= Module[chars={"+","-",""}, digitsequence,charsequences, digitsequence=ToString/@Range[k]; charsequences= Distribute[Join[Table[chars,{k-1}],{""}],List]; Select[StringJoin/@Flatten[Transpose[{digitsequence,#}]]&/@ charsequences,ToExpression[#]==0&]]

ZeroSum[9]//Timing

{2.58Second,{1+2-34-56+78+9,1-2-34+5+6+7+8+9,1-23-4-56-7+89,12+3+4-5-6-7+8-9,12+3-4+5-6+7-8-9,12+3-45+6+7+8+9,12+34-56-7+8+9,12-3+4+5+6-7-8-9,12-3+4+56-78+9,12-3-4-5+6-7-8+9,12-3-4-5-6+7+8-9}}

He also put it together into a oneliner, which is much slower.

ZeroSum[k_Integer?(0<#<10&)]:= Select[StringJoin/@Flatten[Transpose[{ToString/@Range[k],#}]]&/@ Distribute[Join[Table[{"+","-",""},{k-1}],{""}],List],ToExpression[#]==0&]

ZeroSum[9]//Timing

{15.88Second,{1+2-34-56+78+9,1-2-34+5+6+7+8+9,1-23-4-56-7+89,12+3+4-5-6-7+8-9,12+3-4+5-6+7-8-9,12+3-45+6+7+8+9,12+34-56-7+8+9,12-3+4+5+6-7-8-9,12-3+4+56-78+9,12-3-4-5+6-7-8+9,12-3-4-5-6+7+8-9}}

The problem was also solved by Joseph Post <jpost@panix.com>.

Send in the pearls!

Have you got a Mathematica Pearl buried in your files? I invite you to share them in this column and add them to our string. Send them along to don@piele.com

About The Editor

Don Piele has been interested in creating programming problems since he began the International Computer Problem Solving Contest in the pages of Creative Computing in 1981. In 1992, he organized the USA Computing Olympiad (USACO), which selects the top four American high school computer programmers to represent the USA at the annual International Olympiad in Informatics (IOI). He also writes a column, "Cowculations," in Quantum Magazine , devoted to computer algorithms using Mathematica. The web address for the USACO is: www.usaco.org

Don Piele
Mathematics Department
University of Wisconsin-Parkside
Kenosha, WI 53141
don@piele.com

Cite this as: Donald Piele, "Mathematica Pearls: Shortest Path Algorithm" from the Notebook Archive (2019), https://notebookarchive.org/2018-10-10psisp

0	5	2	12	7	∞	∞
5	0	1	5	∞	6	∞
2	1	0	8	10	∞	∞
12	5	8	0	2	10	∞
7	∞	10	2	0	2	20
∞	6	∞	10	2	0	5
∞	∞	∞	∞	20	5	0

0	5	2	12	7	∞	∞
5	0	1	5	∞	6	∞
2	1	0	8	10	∞	∞
12	5	8	0	2	10	∞
7	∞	10	2	0	2	20
∞	6	∞	10	2	0	5
∞	∞	∞	∞	20	5	0

Mathematica Pearls

Shortest Path Problem

Pearl Harvest I

Zero Sum ('89)

Solution by Eric Rimbey (erimbey@wolfram.com)

Send in the pearls!

About The Editor

Don PieleMathematics DepartmentUniversity of Wisconsin-ParksideKenosha, WI 53141don@piele.com​

Solution
by Eric Rimbey (erimbey@wolfram.com)

Don Piele
Mathematics Department
University of Wisconsin-Parkside
Kenosha, WI 53141
don@piele.com

0	5	2	12	7	∞	∞
5	0	1	5	∞	6	∞
2	1	0	8	10	∞	∞
12	5	8	0	2	10	∞
7	∞	10	2	0	2	20
∞	6	∞	10	2	0	5
∞	∞	∞	∞	20	5	0