Code that generates a mandala

Question

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

Answer 1

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[
     Line[{radius*r*{Cos[angle], Sin[angle]}, {radius*r, 0}}], {r, 0, 1, 1/n}];
   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@
 MapThread[
  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@
   ImageAdjust[
    Blend[Colorize[#, 
        ColorFunction -> 
         RandomChoice[{"BrightBands", "IslandColors", 
           "FruitPunchColors", "AvocadoColors", "Rainbow"}]] & /@ 
      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.

Answer 2

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}]]

Answer 3

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:

• "Comparison of dimension reduction algorithms over mandala images generation" (WordPress),
  (GitHub link), (Community link)

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:

Answer 4

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

Answer 5

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

• Chris Carlson, "Social Exploration of Design Spaces: A Proposal", (2016), Wolfram Technology Conference 2016. (link to notebook).

• The presentation movie at YouTube.

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

Answer 6

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]

Answer 7

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.