3
$\begingroup$

Below is code for mapping the connectivity of US counties. It comes from the Mathematica reference on "Connectivity of US Counties". I've highlighted 3 shortest paths shown in red. However, when I combine all 3 shortest paths into the single US map, the one running from California to Massachusetts is now very faded when I use the Show All command. Any advice on how to make these 3 shortest paths, when plotted together on a single map of the US counties, be displayed more brightly or even show thicker red line segments along those 3 paths?

Many thanks!!

Length[counties = 
   Flatten[EntityClass["AdministrativeDivision", 
      "ContinentalUSStates"]["Subdivisions"]]];
AppendTo[counties, 
  Entity["AdministrativeDivision", {"DistrictOfColumbia", 
    "DistrictOfColumbia", "UnitedStates"}]];
bordering = EntityValue[counties, "BorderingCounties"];
Length[missingpos = Position[bordering, _Missing]];
counties = Delete[counties, missingpos];
bordering = Delete[bordering, missingpos];
Length[edges = 
   DeleteDuplicates[
    Sort /@ Flatten[
      MapThread[
       Thread[UndirectedEdge[##]] &, {counties, bordering}]]]];
Graph[counties, edges];
pos = GeoPosition[EntityValue[counties, "Position"]];
proj = {"LambertAzimuthal", 
   "Centering" -> 
    Entity["City", {"Topeka", "Kansas", "UnitedStates"}]};
projpos = First@GeoGridPosition[pos, proj];
graph = Graph[counties, edges, VertexCoordinates -> projpos, 
   EdgeStyle -> Lighter[Lighter[Lighter[Blue]]]];
Length[path11 = 
   FindShortestPath[graph, 
    Entity[
     "AdministrativeDivision", {"LosAngelesCounty", "California", 
      "UnitedStates"}], 
    Entity["AdministrativeDivision", {"SuffolkCounty", 
      "Massachusetts", "UnitedStates"}]]];
Length[path22 = 
   FindShortestPath[graph, 
    Entity["AdministrativeDivision", {"LosAngelesCounty", 
      "California", "UnitedStates"}], 
    Entity["AdministrativeDivision", {"IndianRiverCounty", "Florida", 
      "UnitedStates"}]]];
{HighlightGraph[graph, PathGraph[path11]], 
 HighlightGraph[graph, PathGraph[path22]]}
Length[path33 = 
   FindShortestPath[graph, 
    Entity["AdministrativeDivision", {"ClatsopCounty", "Oregon", 
      "UnitedStates"}], 
    Entity["AdministrativeDivision", {"IndianRiverCounty", "Florida", 
      "UnitedStates"}]]];
{HighlightGraph[graph, PathGraph[path11]], 
 HighlightGraph[graph, PathGraph[path22]], 
 HighlightGraph[graph, PathGraph[path33]]}

enter image description here

enter image description here

$\endgroup$
5
$\begingroup$

Highlight all of them at once.

HighlightGraph[graph, PathGraph /@ {path11, path22, path33}]

Mathematica graphics

You can also make them be the same color.

HighlightGraph[graph, Style[PathGraph[#], Red] & /@ {path11, path22, path33}]

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Domen: Once again, much appreciated ... regards ... prg $\endgroup$
    – PRG
    Oct 17 at 0:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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