12
$\begingroup$

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?

|improve this question
$\endgroup$
  • $\begingroup$ Possible duplicate of xkcd-style graphs $\endgroup$ – Karsten 7. Oct 21 '15 at 9:12
  • $\begingroup$ The XKCD question is one possible answer, but what if I want strokes like these? Maybe too early for marking as duplicate? $\endgroup$ – Szabolcs Oct 21 '15 at 9:14
  • $\begingroup$ @Karsten 7, thanks for the link, but it is not exactly what I was looking for. Besides, does the xkcd-style function work with the Mathematica graph objects (nodes and edges)? $\endgroup$ – alezok Oct 21 '15 at 9:17
  • 1
    $\begingroup$ xkcdConvert seems to work with graphs, though it takes an atrociously long time and it's hard to say if that's the kind of result desired. $\endgroup$ – LLlAMnYP Oct 21 '15 at 11:49
  • 1
    $\begingroup$ You might be interested in this; the proposal there ought to be adaptable to drawing fancy edges. $\endgroup$ – J. M. will be back soon♦ Oct 21 '15 at 11:54
14
$\begingroup$

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.

|improve this answer
$\endgroup$
  • $\begingroup$ PS Use only directed edges in your graphs, unless you want a double-brush-stroke in each direction. $\endgroup$ – Kellen Myers Oct 21 '15 at 18:24
  • $\begingroup$ You can use EdgeShapeFunction for Graph. $\endgroup$ – Szabolcs Oct 21 '15 at 20:46
  • $\begingroup$ 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. $\endgroup$ – Kellen Myers Oct 22 '15 at 14:33
9
$\begingroup$

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:

|improve this answer
$\endgroup$
  • $\begingroup$ My browser cannot display that character :-( $\endgroup$ – Szabolcs Oct 29 '15 at 11:44
  • $\begingroup$ @Szabolcs They are mma's [Tr]character :) $\endgroup$ – Silvia Oct 29 '15 at 11:46
3
$\begingroup$

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.

|improve this answer
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Kellen Myers Oct 23 '15 at 4:56
  • 1
    $\begingroup$ 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]]. $\endgroup$ – J. M. will be back soon♦ Oct 23 '15 at 5:02
  • 2
    $\begingroup$ Doesn't changing Set to SetDelay for fBm make all lines shaped individually? $\endgroup$ – Karsten 7. Oct 23 '15 at 5:21
  • $\begingroup$ @Karsten, yes, that's another possible way to make it look more random. $\endgroup$ – J. M. will be back soon♦ Oct 23 '15 at 5:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.