Changing size of some arrows or stretching lines in EdgeShapeFunction

Question

I have some data as

data = {{230.375`, 224.625`}, {152.5`, 200.`}, {223.5`, 192.`}, {166.5`, 173.21428571428572`},{264.375`,170.625`}, {229.`, 161.5`}, {235.`, 141.5`}, {260.625`,128.625`}, {98.83333333333333`,127.61111111111111`}, {247.5`,124.`}, {109.16666666666667`, 101.61111111111111`},{44.5`,86.5`}, {209.`, 72.5`}, {151.375`, 66.625`}, {172.5`, 66.5`}}

My plot is

NearestNeighborGraph[data, 1, VertexSize -> Large, 
DirectedEdges -> True, 
EdgeShapeFunction -> GraphElementData["Arrow", "ArrowSize" -> 0.04]]

which looks:

How can I change the size of arrows for the two pairs of points in the right hand side of picture (also one in the bottom) where their arrows are too close? Or, can we stretch the lines connecting these pairs?

Answer 1

Update 2: Using EdgeStyle

NearestNeighborGraph[data, 1, VertexSize -> Large, 
 DirectedEdges -> True, 
 EdgeStyle -> 
   {e_ :> Arrowheads[{{If[EuclideanDistance @@ List @@ e < 28, .02, .04], .75}}]}]

Update: "need all arrows, with the exceptions of the ones which are too close, to have the same size"

1. Identify the $k$ shortest edges and set the arrow size smaller for them:

nng = NearestNeighborGraph[data, 1, VertexSize -> Large, 
   DirectedEdges -> True, 
   EdgeShapeFunction -> 
    GraphElementData["Arrow", "ArrowSize" -> .04], ImageSize -> 300];

shortest[k_] := TakeSmallestBy[EdgeList[nng], EuclideanDistance@@List@@ # &, k]; 

Row[{nng, 
  SetProperty[nng, {EdgeStyle -> Red, 
    EdgeShapeFunction -> {Alternatives @@ shortest[6] -> 
       GraphElementData["Arrow", "ArrowSize" -> .02]}}]}, Spacer[10]]

2. Make the arrow sizes small/large for edge a -> b based on whether the EuclideanDistance between a and b is smaller/larger than a threshold:

threshold = 28.

SetProperty[nng, 
 EdgeShapeFunction -> {e_ :> GraphElementData["Arrow", 
   "ArrowSize" -> If[EuclideanDistance @@ List @@ e < threshold, .02, .04]]}]

Original answer:

NearestNeighborGraph[data, 1, VertexSize -> Large, 
 DirectedEdges -> True, 
 EdgeShapeFunction -> (GraphElementData["Arrow", 
      "ArrowSize" -> ArcLength[Line @ #]/1000][##] &)]

Use "ArrowSize" -> Min[.04, ArcLength[Line@#]/1000] to get