# Code that generates a mandala

My little brother asked me to print original mandalas for coloring. I would like some idea on how to create them, but without color, so he can color them.

examples

• It would be better to do this in Adobe Illustrator. Illustrator has a function called "Array" that lets you arrange patterns around the perimeter of a circle. You first drawn your tile as a wedge, then make an array around the circle. If you can define your tile in Mathematica, then you can do the same thing in Mathematica by using the CirclePoints function. This will give you the coordinates of where to plot your tiles. Another function to look at is SectorChart. In Mathematica, it will be a more involved process than Illustrator. Feb 4, 2017 at 23:19
• People, there is no good reason to close this question as too broad. It has multiple up-voted answers. How can it be too broad? Feb 5, 2017 at 4:40
• – Kuba
Feb 7, 2017 at 14:40
• @Kuba Thanks for linking the snowflake making. I was wondering where to find similar work -- I was sure there are similar things already done in the Mathematica community. Feb 7, 2017 at 15:18

Here is one way to come up with "mandalas" -- we generate a segment and then by appropriate number of rotations we produce a "mandala".

Here is an example function of a random seed segment generation:

Clear[MakeSeedSegment]
MakeSeedSegment[radius_, angle_, n_Integer: 10, connectingFunc_: Polygon, keepGridPoints_: False] :=
Block[{t},
t = Table[
Join[If[TrueQ[keepGridPoints], t, {}], {GrayLevel[0.25],
connectingFunc@
RandomSample[Flatten[t /. Line[{x_, y_}] :> {x, y}, 1]]}]
];

seed = MakeSeedSegment[10, \[Pi]/12, 10];
Graphics[seed, Frame -> True]


This function makes symmetric a given seed segment:

Clear[MakeSymmetric]
MakeSymmetric[seed_] := {seed,
GeometricTransformation[seed, ReflectionTransform[{0, 1}]]};

seed = MakeSymmetric[seed];
Graphics[seed, Frame -> True]


Using a seed segment we can generate mandalas with different specification signatures:

Clear[MakeMandala]
MakeMandala[opts : OptionsPattern[]] :=
MakeMandala[
MakeSymmetric[
MakeSeedSegment[20, \[Pi]/12, 12,
RandomChoice[{Line, Polygon, BezierCurve,
FilledCurve[BezierCurve[#]] &}], False]], \[Pi]/6, opts];
MakeMandala[seed_, angle_?NumericQ, opts : OptionsPattern[]] :=
Graphics[GeometricTransformation[seed,
Table[RotationMatrix[a], {a, 0, 2 \[Pi] - angle, angle}]], opts];


This code randomly selects symmetricity and seed generation parameters (number of concentric circles, angles, connecting function):

n = 12;
Multicolumn@
If[#1,
MakeMandala[MakeSeedSegment[10, #2, #3], #2],
MakeMandala[MakeSymmetric[MakeSeedSegment[10, #2, #3, #4, False]],
2 #2]
] &, {RandomChoice[{False, True}, n],
RandomChoice[{\[Pi]/7, \[Pi]/8, \[Pi]/6}, n],
RandomInteger[{8, 14}, n],
RandomChoice[{Line, Polygon, BezierCurve, FilledCurve[BezierCurve[#]] &}, n]}]


Here is a more concise way to generate symmetric segment mandalas:

Multicolumn[Table[MakeMandala[], {30}], 5]


## Going further

At this point we can consider blending and/or coloring of generated mandalas.

One way to do mandalas blending is to convert a set of mandala graphics into images and do weighted blending of small image samples.

Using this approach I got better looking results using only Polygon and FilledCurve[BezierCurve[#]] & in MakeSeedSegment.

iSize = 400;

AbsoluteTiming[
mandalaImages =
Table[Image[
MakeMandala[
MakeSymmetric@
MakeSeedSegment[10, \[Pi]/12, 12,
RandomChoice[{Polygon,
FilledCurve[BezierCurve[#]] &}]], \[Pi]/6],
ImageSize -> {iSize, iSize}, ColorSpace -> "Grayscale"], {200}];
]

(* {20.5542, Null}

Multicolumn[Table[
RemoveBackground@
Blend[Colorize[#,
ColorFunction ->
RandomChoice[{"BrightBands", "IslandColors",
RandomChoice[mandalaImages, 4], RandomReal[1, 4]]], {30}], 5]


## Album

See this album with generated mandalas at different stages of the working on this question/answer.

• "The procedure, though, comes from a machine learning algorithm for generating mandalas, which I will describe in a different answer." - Looking forward to... Feb 5, 2017 at 15:47
• @ercegovac Thanks -- I will describe the procedure in the next few days. Feb 5, 2017 at 16:44
• This reminds me of how Mathematica was used to create 'alien' symbols for the movie Arrival. In any case, your results should probably go into a hall of fame of Mathematica denomstrations Feb 6, 2017 at 17:17
• @YuriyS Thank you for your kind words. I consider starting a more elaborated discussion on this in Community. Feb 7, 2017 at 13:50
• Anton, Only thing missing from this post are the nunchaku. :-) Gets the favourite from me. Feb 7, 2017 at 15:21

For this one I've defined three types of layer, a flower, a simple circle and a ring of small circles. You could add more for greater variety.

flower[n_, a_, r_] := Module[{b = RandomChoice[{-1/(2 n), 0}]},
Cases[ParametricPlot[
r (a + Cos[n t])/(a + 1) {Cos[t + b Sin[2 n t]], Sin[t + b Sin[2 n t]]}, {t, 0, 2 Pi}],
l_Line :> FilledCurve[l], -1]]

disk[_, _, r_] := Disk[{0, 0}, r]

spots[n_, a_, r_] := Translate[Disk[{0, 0}, r a/(4 n)], r CirclePoints[n]]

mandala[n_, m_] := Graphics[{EdgeForm[Black], White, Table[
RandomChoice[{3, 2, 1} -> {flower, disk, spots}][n,
RandomReal[{3, 5}], i]~Rotate~(Pi i/n), {i, m, 1, -1}]},
PlotRange -> All]

GraphicsGrid[Table[mandala[16, 20], {2}, {2}]]


• Much more faithful to the typical mandala look than the ones in my answer. (+1 of course.) Feb 5, 2017 at 19:34
• Interestingly, the colored versions of mandalas made with this algorithm make me think more of Viking or Native American art. Feb 7, 2017 at 13:49
• The challenge now is to get it down to 140 characters for WTC 2017 TAP. Feb 7, 2017 at 15:23

Completeley trial & error, but you can play around with it to your heart's content:

a = DeleteDuplicates[RotationMatrix[ # Pi/5].{Cos[Log@t] + t Sin[t],
Sin[Log@t] - t Cos[t] + 12} & /@ Range@12];
b = DeleteDuplicates[RotationMatrix[ # Pi/5].(2 {Cos[2 t], Sin[2 t] + 24}) & /@
Range@12];
c = DeleteDuplicates[RotationMatrix[ # Pi/5].(2 {Cos[2 t], Sin[2 t] + 2}) & /@ Range@12];
d = DeleteDuplicates[RotationMatrix[ # Pi/5].(.5 {Cos[2 t], Sin[2 t] + 48}) & /@
Range@12];
Quiet@Show[
With[{x =
ParametricPlot[a, {t, .0001, Sqrt@Pi*Pi},
PlotRange -> ({{-#, #}, {-#, #}} &@#), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[2 a, {t, .0001, Sqrt@Pi*Pi},
PlotRange -> ({{-#, #}, {-#, #}} & #), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[4 a, {t, .0001, Sqrt@Pi*Pi},
PlotRange -> ({{-#, #}, {-#, #}} & #), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[(# {Cos[2 t], Sin[2 t]} & /@ {9, 19, 36, 38, 68, 70}),
{t, 0, Pi}, PlotRange -> ({{-#, #}, {-#, #}} &@#),
Ticks -> None, AspectRatio -> Automatic,
PlotStyle -> {Red, Black}, Axes -> False,
PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[b, {t, 0, Pi},
PlotRange -> ({{-#, #}, {-#, #}} &@#), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[c, {t, 0, Pi},
PlotRange -> ({{-#, #}, {-#, #}} &@#), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x],
With[{x =
ParametricPlot[d, {t, 0, Pi},
PlotRange -> ({{-#, #}, {-#, #}} &@#), Ticks -> None,
AspectRatio -> Automatic, PlotStyle -> {Red, Black},
Axes -> False, PlotPoints -> 1000]}, x]

] &@80


The point of using machine learning algorithms for generation of mandala images mentioned in the comments of my previous answer is clarified in this blog post:

The article shows that with Non-Negative Matrix Factorization (NNMF) we can use mandalas made with the seed segment rotation algorithm to extract layer types and superimpose them to make colored mandalas. Using the same approach with Singular Value Decomposition (SVD) or Independent Component Analysis (ICA) does not produce good layers and the superimposition produces more "watered-down", less diverse mandalas.

Here are the bases produced with SVD, ICA, and NNMF:

Note the different look of the NNMF basis compared those of SVD and ICA.

Here are colored mandalas produced with NNMF:

The presentation of Chris Carlson (from WRI) at WTC-2016 discusses design spaces and the examples he gave are very relevant to this discussion.

If you download the presentation notebook you use the dynamic interface code to generate mandalas. Below are some examples.

It's not quite as good as if Mathematica had a "Mandala" command, but there are many named graphs that have quite intricate structures that might be fun to color. For example, those with the name "Cayley"

g = GraphData /@ GraphData["Cayley", ;; 10];


Some of my favorites:

{g[[5]], g[[15]], g[[21]], g[[22]]}


Look at the help for GraphData for many more examples.

Recently the function RandomMandala was added to the Wolfram Function Repository.

Here are multi-mandala mode examples run in a notebook with "ReverseColor" stylesheet:

SeedRandom[5798]
Multicolumn[
Table[ResourceFunction["RandomMandala"][
"Radius" -> RandomChoice[{Identity, Log, #^1.618 &, #^0.618 &, ArcCot, ArcSec}][Reverse@Range[8, 2, -2.]],
"RotationalSymmetryOrder" -> RandomChoice[{3, 4, 5, 6, 9, 12}],
"ConnectingFunction" -> FilledCurve@*BezierCurve,
ColorFunction -> "Rainbow", ImageSize -> Medium], 15], 5]


For coloring (as OP wants):

SeedRandom[22827]
Multicolumn[
Table[ResourceFunction["RandomMandala"][
"Radius" -> RandomChoice[{Identity, Log, #^1.618 &, #^0.618 &, ArcCot, ArcSec}][Reverse@Range[6, 2, -2.]],
"RotationalSymmetryOrder" -> RandomChoice[{3, 4, 5, 6, 9}],
"ConnectingFunction" -> BezierCurve, ColorFunction -> (Black &),
ImageSize -> Medium], 12], 4]