Coneheads instead of Arrowheads

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, [email protected]]
 ]

Mathematica graphics


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}}]}]

enter image description here

We can use it as EdgeShapeFunction in Graph: 

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

enter image description here

Curved edges are also handled:

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

enter image description here

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]

enter image description here

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

enter image description here

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

enter image description here


"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"}]

enter image description here

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"}]

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

Related function "TaperedInverseArrow" reverses the direction:

SeedRandom[1]
RandomGraph[{20, 40}, 
 EdgeShapeFunction ->  GraphElementData[{"TaperedInverseArrow", "Width" -> .1}], 
 EdgeStyle -> Red, ImageSize -> Large]

enter image description here

Tags:

Graphics

Plotting

Graphs And Networks

Recent Posts