12

I would like to draw a graph with Mathematica in such a way that it looks like a handmade drawing or painting. To be more precise, is there a way to set a custom edge style such that it looks made with writing ink or with a brush stroke?

If this is not possible in Mathematica, are you aware of any software that can be used to obtain such an effect? If so, what is the best format in which to export my graph?

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
alezok
  • 235
  • 1
  • 8

3 Answers3

14

You ought to use EdgeRenderingFunction to achieve this.

First, import a graphic for a brushstroke:

BRUSH = Import[NotebookDirectory[] <> "brush.png"]

Then use the EdgeRenderingFunction option in GraphPlot to obtain the image.

GraphPlot[Graph[{1 -> 2, 2 -> 3, 3 -> 1}],
 EdgeRenderingFunction -> ({Inset[BRUSH, Mean[#1], Automatic, 1.7, #[[2]] - #[[1]]]} &),
 VertexRenderingFunction -> None
]

The value 1.7 was something I tweaked based on my image. I recommend using a well-cropped image with a transparent background.

I used the image:

brush-stroke

to obtain the following graph:

triangle

You can make this more complex by trying to use multiple different images as brushstrokes, manually specifying your vertex coordinates, etc.

Kellen Myers
  • 2,701
  • 15
  • 18
  • PS Use only directed edges in your graphs, unless you want a double-brush-stroke in each direction. – Kellen Myers Oct 21 '15 at 18:24
  • You can use EdgeShapeFunction for Graph. – Szabolcs Oct 21 '15 at 20:46
  • That's odd, when I tried to find the corresponding option for Graph, I didn't see it, but indeed, Szabolcs is correct. That option for Graph works just as well (seems to be equivalent or nearly equivalent) and bypasses GraphPlot. – Kellen Myers Oct 22 '15 at 14:33
10

Use Kellen Myers's method but with randomly generated brush-style strokes:

Clear[baseStroke]
baseStroke :=
    Graphics[{
               Black,
               FilledCurve@
                   BSplineCurve[{{2,0},{1,0},{0,-0.2},{-0.1,0},{0,0.2},{1,.1}},
                                SplineClosed -> True]
             }, PlotRange -> {{-.3, 2}, {-.5, .5}}] // 
                        ExportString[#, "PDF"] & // ImportString[#, "PDF"][[1]] & // 
                Inactive[Graphics] @@ # & //
            Module[{fc = Cases[#, _FilledCurve, ∞][[1]], 
                        pr = Cases[#, (PlotRange -> range_) :> range, ∞][[1]],
                            destpr, pts, shapeshifter, 
                        shapeshiftFactor = RandomReal[{1, 2}] {.1, .09}},
                    destpr = 
                        MapAt[# - Mean[#] &, 
                            MapAt[#/Max@# &, pr, 2], 2];
                    pts = fc[[2, 1]];
                    pts = 
                        MapThread[Rescale, {pts, pr, destpr}];
                    shapeshifter = 
                        1 + shapeshiftFactor # & /@ RandomReal[{-1, 1}, {Length@pts, 2}];
                    pts = shapeshifter pts;
                    # /. {
                            _FilledCurve :> ReplacePart[fc, {{2, 1}} -> pts],
                            (PlotRange -> _) :> (PlotRange -> destpr)
                            }
                    ] & // Activate

GraphPlot[Graph[{1 -> 2, 2 -> 3, 3 -> 1}], 
    EdgeRenderingFunction -> ({Inset[baseStroke, Mean[#1], Automatic, 
                        1.7, #[[2]] - #[[1]]]} &), VertexRenderingFunction -> None]

GraphPlot with simulated brush stroke

Reference:

Community
  • 1
Silvia
  • 27,556
  • 3
  • 84
  • 164
4

Just like in this answer, perturbation with one-dimensional Perlin noise can be used to draw fuzzy-looking lines. Here is one way of going about it:

fBm = With[{permutations =
            Apply[Join, ConstantArray[RandomSample[Range[0, 255]], 2]]}, 
           Compile[{{x, _Real}}, 
                   Module[{xf = Floor[x], xi, xa, u, i, j},
                          xi = Mod[xf, 32] + 1; xa = x - xf;
                          u = xa*xa*xa*(10. + xa*(xa*6. - 15.));
                          i = permutations[[permutations[[xi]] + 1]];
                          j = permutations[[permutations[[xi + 1]] + 1]];
                          (2 Boole[OddQ[i]] - 1)*xa*(1. - u) +
                          (2 Boole[OddQ[j]] - 1)*(xa - 1.)*u], 
                   RuntimeAttributes -> {Listable}]];

handdrawn[p1_, p2_, fr_, sh_, divisor_, n_] := With[{cs = Normalize[p2 - p1]}, 
          BSplineCurve[Table[(1 - t) p1 + t p2 +
                             {0, fBm[fr (10 t + sh)]/ divisor}.{cs, Cross[cs]},
                             {t, 0, 1, 1/n}]]]

The handdrawn[] edge function can then be used like so:

PetersenGraph[5, 2, 
              EdgeShapeFunction -> Function[{pts, e},
                                            handdrawn[pts[[1]], pts[[2]],
                                                      20, 1/10, 30, 51]],
              EdgeStyle -> Directive[AbsoluteThickness[3], ColorData[61, 8]], 
              VertexStyle -> ColorData[61, 8]]

fuzzy Petersen graph

The only caveat of handdrawn[] is that tweaking the last four parameters is usually needed to arrive at a satisfactory-looking fuzzy line.

Community
  • 1
J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
  • Is every edge here the same shape (stretched to fit the length between each pair of vertices accordingly)? Or is each one randomized in its own way? I'm trying to discern visually whether this ends up giving you copies of the same random edge shape or different random perturbations on each edge. – Kellen Myers Oct 23 '15 at 04:56
  • 1
    In the version presented here, yes. Additional randomization could be provided by something like EdgeShapeFunction -> Function[{pts, e}, handdrawn[pts[[1]], pts[[2]], RandomReal[{20, 30}], RandomReal[{-1, 1}/5], 30, 51]]. – J. M.'s missing motivation Oct 23 '15 at 05:02
  • 2
    Doesn't changing Set to SetDelay for fBm make all lines shaped individually? – Karsten7 Oct 23 '15 at 05:21
  • @Karsten, yes, that's another possible way to make it look more random. – J. M.'s missing motivation Oct 23 '15 at 05:24