11
$\begingroup$

Suppose I have a list that looks like the following (Town names and total distance to that town)

resupply = {
  {"Coleman", 0},
  {"Highwood House", 106},
  {"Canmore", 229},
  {"Exshaw", 245},
  {"Ghost Station", 288},
  {"MountainAire", 370},
  {"Nordegg", 552},
  {"Robb", 672},
  {"Hinton", 720}
  }

How would I process that list to give me something like

Coleman - Highwood House 106 km

Highwood House - Canmore 123 km

Canmore - Exshaw 16 km

and so on.

The output gives me the two towns being travelled between, and the distance between them.

$\endgroup$
6
  • $\begingroup$ Nice! Appreciate the quick response... that helps me a ton. $\endgroup$ Feb 8, 2017 at 14:29
  • $\begingroup$ If you only knew the most basic functions in Mathematica, you could still do this using a Table ... Table[ fun[ resupply[[i]], resupply[[i+1]] ], {i, 1, Length[resupply]-1}]. Partition is of course better. My point is that it is usually possible to construct a reasonable solution using only a small, core part of the language. $\endgroup$
    – Szabolcs
    Feb 8, 2017 at 14:36
  • 1
    $\begingroup$ Or how about MapThread[fun, {Most[resupply], Rest[resupply]}]? fun[{name1_, dist1_}, {name2_, dist2_}] := name1 <> " - " <> name2 <> " " <> ToString[dist2 - dist1] There are countless ways $\endgroup$
    – Szabolcs
    Feb 8, 2017 at 14:39
  • 1
    $\begingroup$ from the examples you give, it seems that all towns are linearly connected to a single road or railroad. So you treat it as a 1-dimensional map. Is that the idea? $\endgroup$
    – Wouter
    Feb 8, 2017 at 19:51
  • $\begingroup$ @Wouter maybe but not necessarily, the value may be count of km driven today so that e.g. Coleman - Canmore is 229 km but only through Highwood House. There maybe shorter direct path. Or not, depends of OP, I'm just providing alternative. $\endgroup$
    – Kuba
    Feb 9, 2017 at 12:06

6 Answers 6

22
$\begingroup$
StringTemplate["`1` - `3` <*#4-#2*> km"] @@@  Flatten /@ Partition[resupply, 2, 1]
{
 "Coleman - Highwood House 106 km", 
 "Highwood House - Canmore 123 km", 
 "Canmore - Exshaw 16 km", 
 "Exshaw - Ghost Station 43 km", 
 "Ghost Station - MountainAire 82 km", 
 "MountainAire - Nordegg 182 km", 
 "Nordegg - Robb 120 km", "Robb - Hinton 48 km"
}
$\endgroup$
1
  • 1
    $\begingroup$ saves one character: Partition[Flatten @ resupply, 4, 2] $\endgroup$
    – Mr.Wizard
    Feb 9, 2017 at 9:14
7
$\begingroup$
{place, dist} = Transpose[resupply];
With[{n = Length@resupply}, 
 TableForm[
  Partition[Abs[#1 - #2] & @@@ (dist[[#]] & /@ Tuples[Range[n], 2]), 
   n], TableHeadings -> {place, place}]]

enter image description here

Outer could have been used instead of Tuples.

Or:

pos = Subsets[Range[Length@resupply], {2}];
pairs = #1 <> "-" <> #2 & @@@ (place[[#]] & /@ pos);
d = Abs[#1 - #2] & @@@ (dist[[#]] & /@ pos);
Grid[Transpose[{pairs, d}], Alignment -> Left]

enter image description here

$\endgroup$
6
$\begingroup$

The Terse Way

{-#, #2 "km"} & @@@ Differences[resupply] // TraditionalForm

$\left( \begin{array}{cc} \text{Coleman}-\text{Highwood House} & 106 \text{ km} \\ \text{Highwood House}-\text{Canmore} & 123 \text{ km} \\ \text{Canmore}-\text{Exshaw} & 16 \text{ km} \\ \text{Exshaw}-\text{Ghost Station} & 43 \text{ km} \\ \text{Ghost Station}-\text{MountainAire} & 82 \text{ km} \\ \text{MountainAire}-\text{Nordegg} & 182 \text{ km} \\ \text{Nordegg}-\text{Robb} & 120 \text{ km} \\ \text{Robb}-\text{Hinton} & 48 \text{ km} \\ \end{array} \right)$

$\endgroup$
2
$\begingroup$

Using DistanceMatrix:

Formatting/Headings can be looked up from the answer by @ubpdqn.

(dm = DistanceMatrix[resupply[[All, 2]]]) // N // Grid

enter image description here

Usage:

a = Position[resupply, _?(StringContainsQ["Canmore"])][[1, 1]];
b = Position[resupply, _?(StringContainsQ["Coleman"])][[1, 1]];
dm[[a, b]]

229

$\endgroup$
1
$\begingroup$

Using the (still-undocumented-as-of-version-13.1.0) six-argument form of Partition:

table = Partition[resupply, 2, 1, {1, -1}, {}, 
   Apply[{HoldForm[# - #3], Quantity[#4 - #2, "km"]} &] @* Join];

Grid[table, Alignment -> {Left, Center}]

enter image description here

$\endgroup$
1
$\begingroup$
vweights = Rule @@@ resupply;

pg = PathGraph[resupply[[All, 1]],
  EdgeWeight -> Quantity[Differences[resupply[[All, 2]]], "km"],
  EdgeLabels -> Placed["EdgeWeight", {1/2 , {1/2, 3/2}}], 
  VertexWeight -> vweights, 
  VertexLabels -> 
    {v_ :> Placed[ {v, v /. vweights}, {Above, Below}, Rotate[#, 90 Degree] &]}
  ImageSize -> Large,
  BaseStyle -> 16]

enter image description here

pathlengths = Transpose[{EdgeList @ #, PropertyValue[#, EdgeWeight]}] & @ pg;

Grid[pathlengths, Alignment -> {Left, Center}]

enter image description here

If needed, replace UndirectedEdge with HoldForm @* Subtract

ReplaceAll[UndirectedEdge -> HoldForm @* Subtract] @ %

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.