## Feb 14, 2013

### The Secret Formula for Love

#### Mathematica code:

(* a xkcd-style graph converter from http://mathematica.stackexchange.com/questions/11350/xkcd-style-graphs
by Simon Woods *)

xkcdStyle = {FontFamily -> "Comic Sans MS", 16};

xkcdLabel[{str_, {x1_, y1_}, {xo_, yo_}}] :=
Module[{x2, y2}, x2 = x1 + xo; y2 = y1 + yo;
{Inset[
Style[str, xkcdStyle], {x2, y2}, {1.2 Sign[x1 - x2],
Sign[y1 - y2] Boole[x1 == x2]}], Thick,
BezierCurve[{{0.9 x1 + 0.1 x2, 0.9 y1 + 0.1 y2}, {x1, y2}, {x2,
y2}}]}];

xkcdRules = {EdgeForm[ef : Except[None]] :>
EdgeForm[Flatten@{ef, Thick, Black}],
Style[x_, st_] :> Style[x, xkcdStyle],
Pane[s_String] :>
Pane[Style[s, xkcdStyle]], {h_Hue, l_Line} :> {Thickness[0.02],
White, l, Thick, h, l},
Grid[{{g_Graphics, s_String}}] :> Grid[{{g, Style[s, xkcdStyle]}}],
Rule[PlotLabel, lab_] :> Rule[PlotLabel, Style[lab, xkcdStyle]]};

xkcdShow[p_] :=
Show[p, AxesStyle -> Thick, LabelStyle -> xkcdStyle] /. xkcdRules

xkcdShow[Labeled[p_, rest__]] :=
Labeled[Show[p, AxesStyle -> Thick, LabelStyle -> xkcdStyle],
rest] /. xkcdRules

(* Mathematica Version 8.0+ *)
xkcdDistort[p_] :=
Module[{r, ix, iy, rand},
{ix, iy} =
Table[RandomImage[{-1, 1}, ImageDimensions@r]~ImageConvolve~
GaussianMatrix[10], {2}];
ImageTransformation[
r, # + 15 {ImageValue[ix, #], ImageValue[iy, #]} &,
DataRange -> Full], -5]];

(* for Mathematica version < 7 *)
xkcdDistort[p_] :=
Module[{r, id, ix, iy, samplepoints, funcs, channels},
id = Reverse@ImageDimensions[r];
{ix, iy} = Table[ListInterpolation[ImageData[
Image@RandomReal[{-1, 1}, id]~ImageConvolve~GaussianMatrix[10]]], {2}];
samplepoints = Table[{x + 15 ix[x, y], y + 15 iy[x, y]}, {x, id[[1]]}, {y, id[[2]]}];
funcs = ListInterpolation[ImageData@#] & /@ ColorSeparate[r];
channels = Apply[#, samplepoints, {2}] & /@ funcs;

xkcdConvert[x_] := xkcdDistort[xkcdShow[x]]

(* the heart plot *)

xkcdConvert[
ContourPlot[x^2 + (y - (x^2)^(1/3))^2 == 1, {x, -1, 1}, {y, -1, 2},
ContourStyle -> {Red, Thick}, ContourShading -> Red,
AspectRatio -> 1, ImageSize -> 400, Axes -> True, Frame -> False,
AxesLabel -> Map[Text@Style[#, 20, Italic] &, {"x", "y"}],
AxesStyle -> FontSize -> 15,
Epilog -> {Inset[
Style[x^2 + (y - (x^2)^(1/3))^2 == 1, Medium, Italic],
Offset[{0, 0}], Scaled[{-0.1, -5.5}], 1],
Inset[Style["xkcd-style graph", xkcdStyle, FontSize -> 12 ],
Scaled[{0.15, 0.05}], Automatic]},
PlotLabel ->
Style["The Secret Formula for Love", xkcdStyle,
FontSize -> 24]]]