3
$\begingroup$

Is there any way to put two colors on one single graph edge?

For example, I want to highlight two cyclic paths (red and blue).

Red Circle and Blue Circle

But, if I put the two colorings into one image, it does not work as I want (left below). What I expect is in the right below.

Left:Current, Right:Expected

How can I realize this? I attach my current code (Mathematica 10.2).

<< Combinatorica`;
g = MakeGraph[
  Subsets[Range[3]], ((Intersection[#2, #1] == #1) && (#1 != #2)) &, VertexLabel -> True]
hdg = HasseDiagram[g]
sgX = ShowGraph[
  Highlight[hdg, {{{1, 2}, {2, 5}, {5, 3}, {3, 1}}, {{1, 4}, {4, 7}, {7, 3}, {3, 1}}}, 
    HighlightedEdgeColors -> {Red, Blue}, HighlightedEdgeStyle -> Thickness[0.008]], 
  VertexStyle -> PointSize[0.025], EdgeStyle -> Thin, 
  VertexNumber -> True, VertexNumberColor -> Gray]
$\endgroup$
1
$\begingroup$

I have a method to achieve what you want but the procedure is very dirty:

We will make two graphs and then Overlay them.

The first one is as shown below:-

 << Combinatorica`;
  g = MakeGraph[
  Subsets[Range[3]], ((Intersection[#2, #1] == #1) && (#1 != #2)) &, 
  VertexLabel -> True];
  hdg = HasseDiagram[g];
  sgX = ShowGraph[
  Highlight[
   hdg, {{{3, 1}}, {{1, 2}, {2, 5}, {5, 3}, {3, 1}}, {{1, 4}, {4, 
     7}, {7, 3}, {3, 1}}}, 
   HighlightedEdgeColors -> {Blue, Red, Blue}, 
   HighlightedEdgeStyle -> Thickness[0.008]], ImageSize -> 300, 
   VertexStyle -> PointSize[0.025], EdgeStyle -> Thin, 
   VertexNumber -> True, VertexNumberColor -> Gray]

enter image description here

The second graph needs to have only one red line so that we can overlay the first on top of the second. To make all other edge invisible I'm coloring them white. Rest of the elements (vertex,label) are also suppressed.

  g1 = MakeGraph[
   Subsets[Range[3]], ((Intersection[#2, #1] == #1) && (#1 != #2)) &, 
   VertexLabel -> False]

  hdg1 = HasseDiagram[g1];

 sgX1 = ShowGraph[
   Highlight[
     hdg1, {{{3, 1}}, {{6, 4}, {4, 7}, {7, 8}, {8, 6}}, {{2, 5}, {5, 
  8}, {8, 6}, {6, 2}}, {{1, 4}, {4, 7}, {7, 3}, {3, 1}}, {{1, 
  2}, {2, 5}, {5, 3}}}, 
 HighlightedEdgeColors -> {Red, White, White, White, White}, 
  HighlightedEdgeStyle -> Thickness[0.008]], ImageSize -> 300, 
  VertexStyle -> PointSize[0.005], EdgeStyle -> Thin, 
   VertexNumber -> False]

enter image description here

Now we are ready to overlay them. Before that we will need to set some parameters as shown below.

{w, h} = {350, 400};
pt = Scaled[{0.5, 0.5}];
{{l, r}, {b, t}} = {{80, 40}, {60, 10}};

Now we Overlay the first image on top of second and then you can move the first image freely to achieve the final position.

 res = Overlay[{sgX1, 
 Graphics[{}, AspectRatio -> (h + b + t)/(w + l + r), 
 ImageSize -> {w + l + r, h + b + t}, ImagePadding -> 10, 
 Epilog -> {Dynamic[Locator[Dynamic[pt], sgX]]}]}, All, 2]

Once you have placed them properly then you can freeze the image as follows:

  p2 = res /. Locator[x_, y_] :> Inset[y, x] /. Dynamic :> Identity

You may need to play around a little bit during the overlay process to get the two lines (red and blue) as close to each other as possible. Here is the final result

enter image description here


Note: In your code the command HighlightedEdgeStyle should be inside Highlight

$\endgroup$
1
$\begingroup$
trg = TransitiveReductionGraph[RelationGraph[UnsameQ@## && SubsetQ@##&, Subsets[Range@3]],
 VertexLabels -> "Name", EdgeShapeFunction->"Line"]

enter image description here

SetProperty[trg, {EdgeStyle -> {DirectedEdge[{1, 2} | {1}, _] :> Directive[Thick, Red], 
    DirectedEdge[{2, 3} | {3}, _] :> Directive[Thick, Blue]}, 
  EdgeShapeFunction -> {DirectedEdge[{2}, _] :> 
   ({Red, Thick, Translate[GraphElementData["Line"][##], {-.015, 0}], 
    Blue, Translate[GraphElementData["Line"][##], {.015, 0}]} &)}}]

enter image description here

Alternatively, you can have two curved lines for the edge {2} -> {}:

SetProperty[trg, {EdgeStyle -> {DirectedEdge[{1, 2} | {1}, _] :> Directive[Thick, Red], 
    DirectedEdge[{2, 3} | {3}, _] :> Directive[Thick, Blue]}, 
  EdgeShapeFunction -> {DirectedEdge[{2}, _] :> 
  ({Red, Thick, GraphElementData[{"CurvedArc", "Curvature"-> -1/4}][##], 
   Blue,  GraphElementData[{"CurvedArc", "Curvature"-> 1/4}][##]} &)}}]

enter image description here

$\endgroup$

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.