Any chance to come up with a solution that allows to have Graphs like the following with automatically drawn/scaled arrow?
Yes! Even without implementing your own Arrow
function. The trick is simple, start with taking your image and extract and binarize one version of your arrow. After this I crop the image to be of squared size and apply a very light Gaussian filter whose purpose is explained later:
img = Import["https://i.sstatic.net/cIYRI.jpg"];
arrowImg = ImageCrop[Binarize@ImageTake[img, {1, 400}, {-300, -1}]]
With[{d = Max[ImageDimensions[arrowImg]]},
arrowImg =
GaussianFilter[ImageCrop[arrowImg, {d, d} + 10, Padding -> White], 2]
]
Now the magic happens. Interpolate the image matrix to get a function $f(x,y)$ which is 0 inside the arrow and 1 everywhere else. Then we have this fine function called RegionPlot
in Mathematica.
func = ListInterpolation[
ImageData[arrowImg, "Real", DataReversed -> True], {{0, 1}, {0, 1}}];
arrowGraphics =
RegionPlot[func[y, x] < 1/2, {x, 0, 1}, {y, 0, 1},
PlotStyle -> Green, BoundaryStyle -> Directive[Thick, Black],
Frame -> False, AspectRatio -> Automatic, PlotPoints -> 40,
MaxRecursion -> 3]
Beside that we have a green arrow again the true magic happened behind the scenes. RegionPlot
creates Polygon
directives to show its result which can of course be scaled, translated, and rotated, without loosinglosing quality.
With[{a = First[arrowGraphics]},
Graphics[
{a, GeometricTransformation[
a, {RotationTransform[2/3 Pi], RotationTransform[4/3 Pi]}]}]]