# How can I construct a distance table?

I have a list of city names (of arbitrary length), f.e.

c = {"BAL", "NYC", "LAS", "AUS"};


and the distances between them :

d = {232, 318, 467, 285, 670, 530};


With

m = (Flatten /@ Transpose[{c, DiagonalMatrix@Table["x", {Length@c}]}])~Prepend~({""}~Join~c)


I get: Now, misusing Mathematica as a typewriter:

m[[2, 3]] = d[];
m[[2, 4]] = d[];
m[[2, 5]] = d[];
m[[3, 2]] = d[];
m[[3, 4]] = d[];
m[[3, 5]] = d[];
m[[4, 2]] = d[];
(* etc. *)


I get: 1st question: How can I automate this?

2nd question: How can I get a graph of these distances?

Thank you in advance for any help

• @YvesKlett - The correlation is 1->2, 1->3, 1->4, 2->3, 2->4 and 3->4 – eldo May 31 '14 at 14:28
• Reminds me of this: codereview.stackexchange.com/questions/5307/… – Szabolcs May 31 '14 at 14:30
• Also this: mathematica.stackexchange.com/q/7511/12 – Szabolcs May 31 '14 at 14:32
• Depending on the application, you might consider storing the coordinates of the cities instead and defining a metric (distance function) that takes two sets of coordinates and spits out the distance. i.e. if you're looking literally at the bird's eye distance between cities, you could store the latitude/longitude of the cities and use a function to calculate the distances from there and fill in the table. – Myridium May 31 '14 at 14:33
• The matrix you've entered manually does not match up with the city-distance correlation you've stated above. – Myridium May 31 '14 at 15:03

d = {232, 318, 467, 285, 670, 530};
c = {"BAL", "NYC", "LAS", "AUS"};


Assuming that the n(n-1)/2 elements in the distance list d correspond to the upper triangular part of the distance matrix for the given ordering of the cities, let

sA = SparseArray[Thread[Subsets[Range[Length@c], {2}] -> d], {Length@c, Length@c}];

sA // Normal // TableForm[#, TableHeadings -> {c, c}] & To get the full matrix just add sA and its transpose:

sA + sA\[Transpose] // Normal // TableForm[#, TableHeadings -> {c, c}] & Using WeightedAdjacencyGraph with coordinates based on multi-dimensional scaling:

I use a modification of the code from this Demonstration to get the vertex coordinates that respect the distances in our distance matrix:

ClearAll[mDS];
mDS[dm_] := Module[{dims = Dimensions[dm], em = - dm dm/2, ctr,
vsdvF = #[].Sqrt[#[]].Transpose[#[]] &},
ctr = IdentityMatrix[dims[]] - ConstantArray[1/dims[], dims];
N@Transpose[vsdvF@SingularValueDecomposition[ctr.em.ctr]][[All, ;; 2]]];

dm = sA + sA\[Transpose];
vcoords = mDS[dm];
scldcoords = Transpose[Rescale /@ Transpose@vcoords];
dm = (Normal[dm]) /. (0) -> Infinity;

options = {VertexShapeFunction -> "Square", VertexSize -> {16, 8},
VertexLabels -> Placed["Name", Center],
VertexStyle -> Hue[0.1, 0.5, 1.], AspectRatio->1,
VertexLabelStyle -> Directive[FontFamily -> "Arial", 16],
ImageSize -> 380, ImagePadding -> 20, DirectedEdges -> True,
EdgeStyle -> Directive[Thick, Blue, Arrowheads[{{.05, .75}}]]};

WeightedAdjacencyGraph[c, dm, options, VertexCoordinates -> scldcoords] ... and using actual coordinates from CityData:

 cities = {{"Baltimore", "Maryland", "UnitedStates"},
{"NewYork",  "NewYork", "UnitedStates"},
{"Austin", "Texas", "UnitedStates"}};
vcoords2 = Reverse@CityData[#, "Coordinates"] & /@ cities;
scldcoords2 = Transpose[Rescale /@ Transpose@vcoords2];

WeightedAdjacencyGraph[c, dm, options, VertexCoordinates -> scldcoords2] • cheerfully accepted. I will certainly have a close look at "SparseArray" which I didn't use so far. – eldo May 31 '14 at 20:16
• @eldo, thank you for the accept. – kglr May 31 '14 at 20:22

Since other methods are already taken:

c = {"BAL", "NYC", "LAS", "AUS"};
d = {232, 318, 467, 285, 670, 530};

n = Length@c;

max = Binomial[n, 2];

f1 = FoldList[Subtract, max, #] &;

m = MapThread[d[[# ;; #2]] &, f1 /@ Range[{2, 1}, n - {1, 2}]] // Reverse;
m + m\[Transpose] // MatrixForm


So much for terse coding, but hopefully it's reasonably efficient. :^)

• @ Mr.Wizard - Thank you very much. Your "Binomial" is very useful for me when I want to test whether the two initial lists "match". It also answers - quite unexpectedly - another of my beginner-questions: How to map an anonymous functions to another anonymous function ( f1, m) when slots are already "occupied". – eldo May 31 '14 at 20:42

Another way, showcasing InternalPartitionRagged:

upper = Join[
InternalPartitionRagged[d, Reverse@Range[Length[c] - 1]],
{ConstantArray[0, Length[c]]}
];
upper + Transpose@upper // TableForm


Not exactly sure as how the rule extends to other examples, but this replicates your matrix

c = {"BAL", "NYC", "LAS", "AUS"};
d = {232, 318, 467, 285, 670, 530};
e = Flatten@Table[d[[j]], {i, 1, Length@c}, {j, i, Length@d}];
k = 0; Table[
If[i == j || k >= 2 Length@c - 1, 0, k = k + 1; e[[k]]], {i,
Length@c}, {j, Length@c}]

(*{{0, 232, 318, 467}, {285, 0, 670, 530}, {318, 0, 0, 0}, {0, 0, 0, 0}}*)


Sorry I don't have time to answer this thoroughly, but observe:

d = {232, 318, 467, 285, 670, 530};

DistMatrix[d_, NumCities_] := Block[{i, l},
Return[(# + Transpose@#) &[
Append[
Normal@SparseArray[
Flatten[Table[
Table[{i, l + i}, {l, 1, NumCities - i}], {i, 1,
NumCities - 1}], 1] -> d]
, Table[0, {NumCities}]]]
];
];

DistMatrix[d,4]

{{0, 232, 318, 467}, {232, 0, 285, 670}, {318, 285, 0, 530}, {467, 670, 530, 0}}


This is the same as the desired matrix if you view it in TraditionalForm.

c = {"Baltimore", "New York", "Las Vegas", "Austin"};

n = Length[c];

pos = Flatten[
Table[{i, j}, {i, n - 1}, {j, i + 1, n}],
1];

d = ToExpression[
StringDrop[
WolframAlpha[
"distance between " <> #[] <>
" and " <> #[], {{"Result", 1},
"Plaintext"}], -6]] & /@
(c[[#]] & /@ pos)

{170.2, 2111, 1348, 2242, 1514, 1091}

m = Module[{mat, pts},
mat = ConstantArray[0, {n, n}];
ReplacePart[mat, Join[

• This throws several ToExpression::sntxi: Incomplete expression; more input is needed . messages here and mainly fills the table with \$Failed. – Yves Klett May 31 '14 at 21:58
• For some reason, on Win7 64bit and 9.01 the StringDrop part mangles the W|A output. A working alternative is: d = StringSplit[ StringDrop[ WolframAlpha[ "distance between " <> #[] <> " and " <> #[], {{"Result", 1}, "Plaintext"}], 0]][] & /@ (c[[#]] & /@ pos) – Yves Klett Jun 1 '14 at 11:56