# The most worthless subway stations in New York, part ii

In the last post, I demonstrated loading a GIS shapefile for New York City into Mathematica, loading the official subway station entry data from the city and overlaying it onto the map.

Below is the code to prepare and display an interactive version of the tool that also identifies and displays the stations on each line closest to each other and most remote.

```preStationsForComp = Drop[stations, 1][[ All, {3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 26, 25}]]; preStationsForComp[[All, 13]] = preStationsForComp[[All, 13]]/1000000.; preStationsForComp[[All, 14]] = preStationsForComp[[All, 14]]/1000000.;```

``` stationsForComp = Union[Map[{#[[1]], #[[2]], #[[3]], #[[4]], #[[5]], #[[6]], #[[7]], #[[ 8]], #[[9]], #[[10]], #[[11]], #[[12]], {#[[13]], #[[14]]}} &, preStationsForComp], SameTest -> ((#1[[1]] == #2[[1]]) && (#1[[2]] == #2[[2]]) && (#1[[ 3]] == #2[[3]]) && (#1[[4]] == #2[[4]]) && (#1[[5]] == #2[[ 5]]) && (#1[[6]] == #2[[6]]) && (#1[[7]] == #2[[7]]) && (#1[[ 8]] == #2[[8]]) && (#1[[9]] == #2[[9]]) && (#1[[10]] == #2[[ 10]]) && (#1[[11]] == #2[[11]]) && (#1[[12]] == #2[[12]]) &)]; (* one randomly selected entrance per station/line *) entranceFromLine[line_] := Select[stationsForComp, (#[[2]] == line || #[[3]] == line || #[[4]] == line || #[[5]] == line || #[[6]] == line || #[[7]] == line || #[[8]] == line || #[[9]] == line || #[[10]] == line || #[[11]] == line || #[[12]] == line) &][[All, {1, 13}]] entranceFromSimplifiedData[line_, station_] := Select[stationsForComp, (#[[1]] == station && (#[[2]] == line || #[[3]] == line || #[[4]] == line || #[[5]] == line || #[[6]] == line || #[[7]] == line || #[[8]] == line || #[[9]] == line || #[[10]] == line || #[[11]] == line || #[[12]] == line)) &] ```

```Manipulate[ Module[{key, closestations, farstations, lineEntrances, nearstationPair, farstationPair, closestToPointer}, key = Select[index, #[[2]] == whichline &][[1]][[1]]; closestations = First[screenedVitalDistances[[key]][[2]]]; farstations = Last[screenedVitalDistances[[key]][[2]]]; nearstationPair = {entranceFromSimplifiedData[whichline, closestations[[1]][[1]]][[1]], entranceFromSimplifiedData[whichline, closestations[[1]][[2]]][[ 1]]}; farstationPair = {entranceFromSimplifiedData[whichline, farstations[[1]][[1]]][[1]], entranceFromSimplifiedData[whichline, farstations[[1]][[2]]][[1]]}; lineEntrances = entranceFromLine[whichline]; closestToPointer = First[SortBy[Map[{#, GeoDistance[#[[2]], p]} &, lineEntrances], Last]]; Column[{Show[bg, Graphics[{PointSize[Medium], Blue, Table[Tooltip[Point[lineEntrances[[i]][[2]]], lineEntrances[[i]][[1]]], {i, 1, Length[lineEntrances]}]}], Graphics[{PointSize[Large], Red, {Tooltip[Point[Last[farstationPair[[1]]]], First[farstationPair[[1]]]], Tooltip[Point[Last[farstationPair[[2]]]], First[farstationPair[[2]]]]}}], Graphics[{PointSize[Medium], Orange, {Tooltip[Point[Last[nearstationPair[[1]]]], First[nearstationPair[[1]]]], Tooltip[Point[Last[nearstationPair[[2]]]], First[nearstationPair[[2]]]]}}], Graphics[{PointSize[Large], Black, {Tooltip[Point[Last[closestToPointer[[1]]]], First[closestToPointer[[1]]]]}}], PlotRange -> {{-74.05(*w*), -73.69(*e*)}, {40.54(*s*), 40.92(*n*)}}, ImageSize -> 340, ImagePadding -> 2], Style[TableForm[{closestations, farstations, {closestToPointer[[1]][[1]], closestToPointer[[2]]}}, TableHeadings -> {{"closest pair", "farthest pair", "closest to pointer"}, {"stations", "distance (m)"}}], FontFamily -> "Times"]}, Center, 3]], {{whichline, "F", "which line?"}, index[[All, 2]]}, {{p, {-73.87, 40.73}}, Locator}] ```

In our next installment, what are the most distant stations in the whole system?