Coneheads instead of Arrowheads

Question

I was reading a paper by Holten and van Wijk called "A User Study on Visualizing Directed Edges in Graphs". They show a number of graphical alternatives to using arrowheads:

I find the final one (f), that replaces the arrowheads with coneheads, particularly appealing, and would like to try using them. It appears there is no built in conehead functionality, and I was wondering if there is an easy way to do this.
For arrowheads, it is easy:
Graphics[Arrow[{{1, 0}, {2, 1}}]]

My first thought was to replace the line with a cone:
Graphics3D[Cone[{{1, 0, 0}, {2, 1, 0}}, 0.05], Boxed -> False]

This works to some extent, but is a 3D command instead of 2D, and it was not obvious how to modify it to work with Graphics instead of Graphics3D. My second though was to use a Polygon:
conehead[{{a1_, b1_}, {a2_, b2_}}, r_] := 
          Graphics[Polygon[{{a1, b1}, {a2, b2 - r}, {a2, b2 + r}}]];
conehead[{{0, 0}, {1, 0.2}}, 0.02]

This also works to some extent, but has several problems: the end of the cone isn't at the right angle, it doesn't work for many a's and b's, and there is no shading from transparent to dark.
So my question is: is there a straightforward way to replace arrowheads with coneheads?

Lukas Lang · Accepted Answer

How about:

conehead[r_][{p1_, ___, p2_}, ___] := With[
  {n = Normalize[{{0, 1}, {-1, 0}}.(p2 - p1)]},
  Polygon[{p1 - r n, p1 + r n, p2}]
  ]
Graphics[conehead[0.02][{{0, 0}, {1, 0.5}}]]

Used in a graph:

RandomGraph[
 {20, 40},
 EdgeShapeFunction -> conehead[0.02],
 EdgeStyle -> Directive[Black, Opacity@0.5]
 ]

kglr · Answer

StreamStyle glyph "Pointer" can be made to look the same as the desired shape, so we can use

f[w_: .05][pts_,___] := Graphics`Glyphs`GlyphData["Pointer", GlyphWidth -> w, 
  GlyphControlFunction -> (1 - #&), PlotPoints -> 300][BezierCurve @ pts]

to generate the desired Graphics primitive:

Graphics[{Red,f[][{{1, 0}, {3, 1}}]}]

We can use it as EdgeShapeFunction in Graph:

SeedRandom[1]
RandomGraph[{20, 40}, EdgeShapeFunction -> f[], VertexSize -> .3, 
 EdgeStyle -> Directive[Opacity[.5], Black], ImageSize -> 500]

Curved edges are also handled:

SeedRandom[1]
RandomGraph[{20, 40}, EdgeShapeFunction -> f[.15], 
 GraphLayout -> "LayeredDigraphEmbedding", 
 VertexSize -> .3, EdgeStyle -> Directive[Opacity[.5], Black], ImageSize -> 500]

We can compose the pointer glyph with the built-in edge shape function "CurvedArc" to change straight lines into curved arcs:

ClearAll[f2]
f2[w_: .2, curve_: .5] := Graphics`Glyphs`GlyphData["Pointer", GlyphWidth -> w][
    GraphElementData[{"CurvedArc", "Curvature" -> curve}][##]] &;

Examples:

SeedRandom[1]
RandomGraph[{20, 40}, EdgeShapeFunction -> f2[], VertexSize -> .3, 
 EdgeStyle -> Directive[Opacity[.5], Black], ImageSize -> 500]

SeedRandom[1]
RandomGraph[{20, 40}, EdgeShapeFunction -> f2[.5], VertexSize -> .3, 
 EdgeStyle -> Directive[Opacity[.5], Black], ImageSize -> 500, 
 GraphLayout -> "LayeredDigraphEmbedding"]

Use EdgeShapeFunction -> f2[.5, 0] to keep the straight edges straight:

kglr · Answer

"TaperedArrow" and "TaperedInverseArrow"
It turns out there are two built-in edge shape functions ("TaperedArrow" and "TaperedInverseArrow") that give the desired result. They come with two options:
GraphElementData["TaperedArrow", "Options"]

{"Width" -> Automatic, "Gradient" -> True}

Examples:
Row[Labeled[Graphics[
     GraphElementData[{#, "Width" -> .1}][{{0, 0}, {3, 1}}, None], 
     ImageSize -> 300], #, Top] & /@
   {"TaperedArrow", "TaperedInverseArrow"}]

With curves "Gradient" option has no effect (we don't get varying opacity along the curve):
Row[Labeled[Graphics[
     GraphElementData[{#, "Width" -> .1}][{{0, 0}, {0, 
        0}, {2, -1}, {3, 1}, {3, 1}}, None], ImageSize -> 300], #, Top] & /@ 
   {"TaperedArrow", "TaperedInverseArrow"}]

SeedRandom[1]
RandomGraph[{20, 40}, EdgeShapeFunction -> "TaperedArrow", 
 EdgeStyle -> Red, ImageSize -> Large]

Use EdgeShapeFunction -> GraphElementData[{"TaperedArrow", "Width" -> .1}] to get

Use EdgeShapeFunction -> GraphElementData[{"TaperedArrow", "Width" -> .05, "Gradient" -> False}] to get

Related function "TaperedInverseArrow" reverses the direction:
SeedRandom[1]
RandomGraph[{20, 40}, 
 EdgeShapeFunction ->  GraphElementData[{"TaperedInverseArrow", "Width" -> .1}], 
 EdgeStyle -> Red, ImageSize -> Large]

Coneheads instead of Arrowheads

3 Answers

`"TaperedArrow"` and `"TaperedInverseArrow"`

Add your own answers!

Ask a Question