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

enter image description here enter image description here

  • 1
    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. – Tyler Durden Feb 4 '17 at 23:19
  • 11
    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? – m_goldberg Feb 5 '17 at 4:40
  • 1
    related: How to generate a random snowflake – Kuba Feb 7 '17 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. – Anton Antonov Feb 7 '17 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[
     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]

enter image description here

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]

enter image description here

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

enter image description here

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

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

enter image description here

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]

enter image description here

Album

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

  • 1
    "The procedure, though, comes from a machine learning algorithm for generating mandalas, which I will describe in a different answer." - Looking forward to... – ercegovac Feb 5 '17 at 15:47
  • 1
    @ercegovac Thanks -- I will describe the procedure in the next few days. – Anton Antonov Feb 5 '17 at 16:44
  • 2
    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 – Yuriy S Feb 6 '17 at 17:17
  • @YuriyS Thank you for your kind words. I consider starting a more elaborated discussion on this in Community. – Anton Antonov Feb 7 '17 at 13:50
  • Anton, Only thing missing from this post are the nunchaku. :-) Gets the favourite from me. – Edmund Feb 7 '17 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}]]

enter image description here

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

enter image description here

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:

enter image description here

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

Here are colored mandalas produced with NNMF:

enter image description here

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

enter image description here

Look at the help for GraphData for many more examples.

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.

enter image description here enter image description here enter image description here

protected by xzczd Sep 25 at 5:47

Thank you for your interest in this question. Because it has attracted low-quality or spam answers that had to be removed, posting an answer now requires 10 reputation on this site (the association bonus does not count).

Would you like to answer one of these unanswered questions instead?

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