HighlightGraph with different styles

Question

I want to highlight two different directed paths on a graph with two different style. I am using the following two code snippets:

HighlightGraph[
 CompleteGraph[5], {PathGraph[{1, 2, 3}], PathGraph[{4, 5}]}, 
 GraphHighlightStyle -> {"Dashed", "Thick"}]

and

HighlightGraph[
 HighlightGraph[CompleteGraph[5], PathGraph[{4, 5}], 
  GraphHighlightStyle -> "Dashed"], PathGraph[{1, 2, 3}], 
 GraphHighlightStyle -> "Thick"]

But either of them results in the following plot:

It seems that highlighted paths use the same style (the last one applied to the graph) if we have more than one path. In addition, I want to make the highlighted paths directed, but If I add the option DirectedEdges->True to the path, it doesn't work.

Answer 1

To answer your first question, you can use Style to specify different styles, e.g.

HighlightGraph[CompleteGraph[5], 
 {Style[PathGraph[{1, 2, 3}], {Red, Dashed}], 
  Style[PathGraph[{4, 5}], {Thick, Orange}]}, 
 GraphHighlightStyle -> {"Dashed", "Thick"}]

As for your second question, I suspect there must be an easier way, but you could do something like this

arrow[path_, vertexf_String] := Flatten[{
   #1 \[UndirectedEdge] #2 -> (GraphElementData[vertexf]),
   #2 \[UndirectedEdge] #1 -> (GraphElementData[vertexf][Reverse[#1], ##2] &)} & @@@ 
     Partition[path, 2, 1]]

arrow[path_, vertexf_] := Flatten[{
   #1 \[UndirectedEdge] #2 -> vertexf,
   #2 \[UndirectedEdge] #1 -> (vertexf[Reverse[#1], ##2] &)} & @@@ Partition[path, 2, 1]]

HighlightGraph[CompleteGraph[5], 
  {Style[PathGraph[{1, 2, 3}], {Red, Dashed}], 
   Style[PathGraph[{4, 5}], {Thick, Orange}]}, 
  EdgeShapeFunction -> arrow[{1, 2, 3}, "Arrow"]]

In arrow, vertexf can be a named edge function as listed by GraphElementData["EdgeShapeFunction"] or a function. In the latter case, the first argument provided to the function will be a list of coordinates and the second one an edge.

Answer 2

To get both the edge directions (that is, all edges on a path pointing in the right direction) and styles right, we need to construct the EdgeShapeFunction taking into account somewhat peculiar treatment of the second argument (#2) when used inside HighlightGraph.

ClearAll[styledPaths];
Options[styledPaths] = Join[Options[Graph], {"arrowSize" -> .05, "setback" -> .1}];
styledPaths[grp_Graph, pathsandstyles : {{{__}, {__}} ..}, opts : OptionsPattern[styledPaths]] :=  Module[{check, pathverts = pathsandstyles[[All, 1]],
pathedges =  Flatten@(EdgeList[#] & /@ (PathGraph[First@#] & /@ 
     pathsandstyles)), grpedges = EdgeList[grp], pathgraphs},
 (* Check that paths are paths: no gaps and no edges that do not belong to parent graph  *)
check = Apply[And,
 Join[MemberQ[EdgeList[grp], # | Reverse[#]] & /@ 
        Flatten[UndirectedEdge[First@#, Last@#] & /@ 
          Transpose@{Most@#, Most@RotateLeft[#]} & /@ pathverts, 1], 
    (PathGraphQ[Graph[#]] & /@ (UndirectedEdge[First@#, Last@#] & /@ 
       Transpose@{Most@#, Most@RotateLeft[#]} & /@ pathverts))], {0}];
 Switch[check, False, "FAILED", _,
(* proceed to construct styled path graphs *)
pathgraphs = Style[PathGraph[First@#], Last@#] & /@ pathsandstyles;
(* find the correct orientation of highlighted edges by reversing #1 if necessary (that is,  if #2 is not a member of the parent graph's EdgeList) *)
edgeShapesF[edges_,  gg_] := (If[ MemberQ[edges, #2 | Reverse[#2]], 
    {Arrowheads[{{OptionValue["arrowSize"], 1}}], 
     Arrow[If[MemberQ[EdgeList[gg], #2], #1, Reverse[#1]], 
          OptionValue["setback"]]}, {Arrowheads[{{.0, 1}}], Arrow[#1, .1]}] &);
(* put all together *)
HighlightGraph[grp, pathgraphs, EdgeShapeFunction -> edgeShapesF[pathedges, grp], 
FilterRules[{opts}, Options[Graph]]]]]

Examples:

 g1 = CompleteGraph[5, VertexSize -> Small,  VertexLabels -> Placed["Name", Center], ImageSize -> 300];
 g2 = PetersenGraph[5, 2, VertexSize -> Medium,  VertexLabels -> Placed["Name", Center], GraphLayout -> Automatic, ImageSize -> 300];
 g3 = CycleGraph[20, GraphLayout -> "SpiralEmbedding", VertexSize -> 1,  VertexLabels -> Placed["Name", Center],  GraphLayout -> "SpiralEmbedding", ImageSize -> 300];
 g4 = PolyhedronData["Football", "SkeletonGraph"];
 sp1 = {{{1, 3, 5, 2, 4, 1}, {Thick, Orange}}};
 sp2 = {{{1, 6, 7, 2, 4, 9, 10, 5, 3, 8}, {Thick, Orange}}};
 sp3 = {{{6, 7, 8, 9, 10, 11, 12}, {Thick, Green}}};
 sp4 = {{{6, 31, 21, 33, 45, 46, 55}, {Thick, Red}}, {{3, 43, 25, 13, 14, 26, 44}, {Thick, Green}}};
 Grid[{{styledPaths[g1, sp1, ImageSize -> 400], styledPaths[g2, sp2, DirectedEdges -> True,  ImageSize -> 400]}, 
 {styledPaths[g3, sp3, ImageSize -> 400], styledPaths[g4, sp4, "arrowSize" -> .02, "setback" -> .05, ImageSize -> 400, VertexSize -> .5]}}]

Output:

Multiple paths:

testdata = {{{{5, 1, 4}, {Thick, Red}}, {{2, 3}, {Dashed, Thick, Orange}}}, 
 {{{5, 4, 1}, {Thick, Red}}, {{3, 2}, {Dashed, Thick, Orange}}},
 {{{1, 3, 2}, {Thick, Red}}, {{4, 2, 5}, {Dashed, Thick, Orange}}},
 {{{1, 3, 2}, {Thick, Red}}, {{4, 3, 5, 1}, {Dashed, Thick, Orange}}},
 {{{1, 3}, {Thick, Red}}, {{4, 3, 5}, {Dashed, Thick, Orange}}, 
    {{5,1, 2}, {Dotted, Thick, Purple}}},
 {{{3, 4}, {Thick, Red}}, {{4, 1, 5}, {Dashed, Thick, Orange}}, 
    {{1, 3, 5, 2}, {Dotted, Thick, Purple}}}};
 Grid[{Row[{"paths = ", #[[All, 1]]}] & /@ testdata[[;; 3]], 
  styledPaths[g1, #] & /@ testdata[[;; 3]],
  Row[{"paths = ", #[[All, 1]]}] & /@ testdata[[4 ;;]], 
  styledPaths[g1, #] & /@ testdata[[4 ;;]]}, 
 Dividers -> {All, {{True, False}}}, Spacings -> {3, 3}]

Output: