Draw Sri Yantra

Question

Challenge:

Draw Sri Yantra.

How to:

There are different ways to draw it. All include many steps. If you think you can draw it without following the linked steps scroll below for the elements you must have in your drawing.

Complete steps can be found here:

http://www.saralhindi.com/Shri_Yantra/makingsky14steps_eng.htm

(I didn't copied them here because it would become a very long question, here is archieve.org mirror in case the first link ever goes down)

The final picture should look like the picture below:

Must have:

Basically any method of drawing of your choosing would be a valid answer providing that you keep the most important elements

1. The number of triangles should the same number as in the above picture (43 smaller triangles resulted from the interlacing of the bigger 9 triangles)

2. This triple intersections are respected:

3. The tips of the upward triangles touch the bases of the 4 downward triangles and the tips of downward triangles should touch the bases of the 3 upward triangles as shown in the figure bellow.

   

4. The inner circle (bindu) is concentric with the outer circle.

5. The tips (vertices) of the bigger triangles should touch the outer circle:

6. The final image should have all the elements and should generally look like:

7. Color should be roughly the same as the above image for every element (including petals).

8. The shape of the petals should preferably look roughly like in the image bellow, but can also be just semicircles or simple arc section of circle:

9. There are no strict proportion restrictions to the circles or the size of the gates, but the most outer circle should have the diameter not less than 90% of the side of the outer square, the other elements would be respectively arranged relative to this proportions.

Programming languages and results

There are no restriction to the programming language nor the format of the result (it can be either a vector image, bitmap image, canvas etc) provided that the result is relatively clear and discernible (at least 800px X 800px)

Latter edit: There is no perfect method of drawing as this blog so well explores them: http://fotthewuk.livejournal.com/ Taking that into account minor faults will be tolerated.

At this point it as an interesting exercise to learn that it is very probable that there is no perfect solution, much like squaring of the circle.

Answer 1

Mathematica - 2836 2536 chars

It was a bit dizzying to figure out the combos of regions that make small triangles available for coloring.

The Frame

The frame objects are inequalities that describe as regions. E.g. the red and yellow scalloping are two regions of circles.

n1=8;n2=16;
w8=Round[.78 Table[{Cos[2\[Pi] k/n1],Sin[2\[Pi] k/n1]},{k,0,n1-1}],.01];
w16=Round[1 Table[{Cos[2\[Pi] k/n2],Sin[2\[Pi] k/n2]},{k,0,n2-1}],.01];
n=12;y1=.267;
x2=1/Sqrt[2];w=1.8;v=1.85;
pts={{-w,w},{-w/4,w},{-w/4,w+w/8},{-5w/8,w+w/8},{-5w/8,w+5w/24},{5w/8,w+5w/24},{5w/8,w+w/8},{w/4,w+w/8},{w/4,w},
{w,w},{w,w/4},{w+w/8,w/4},{w+w/8,5w/8},{w+5w/24,5w/8},{w+5w/24,-5w/8},{w+w/8,-5w/8},{w+w/8,-w/4},{w,-w/4},
{w,-w},
{w/4,-w},{w/4,-w-w/8},{(5 w)/8,-w-w/8},{(5 w)/8,-w-(5 w)/24},{-((5 w)/8),-w-(5 w)/24},{-((5 w)/8),-w-w/8},{-(w/4),-w-w/8},{-(w/4),-w},{-w,-w},

{-w,-w/4},{-w-w/8,-w/4},{-w-w/8,-5w/8},{-w-5w/24,-5w/8},{-w-5w/24,5w/8},{-w-w/8,5w/8},{-w-w/8,w/4},{-w,w/4}
};
  
frame=RegionPlot[{
(*MeshRegion[pts2,Polygon[Range[20]]],*) (*orange trim *)
MeshRegion[pts,Polygon[Range[Length[pts]]]], (*green box *)
ImplicitRegion[x^2+y^2<2.8,{x,y}], (*white, largest circle *)
ImplicitRegion[Or@@(((x-#)^2+(y-#2)^2<.1)&@@@w16),{x,y}], (*yellow scallops*)
ImplicitRegion[x^2+y^2<1,{x,y}],(*white circle *)
ImplicitRegion[x^2+y^2<1.4,{x,y}],(*white disk*)
ImplicitRegion[Or@@(((x-#)^2+(y-#2)^2<.15)&@@@w8),{x,y}],(*red scallops*)
ImplicitRegion[x^2+y^2<1,{x,y}] , (*white disk *)
ImplicitRegion[1.8 < x^2+y^2< 2.2,{x,y}] ,(*brown outer rim*)
ImplicitRegion[2.4 < x^2+y^2< 2.8,{x,y}](*yellow outer rim*)},
BoundaryStyle->Directive[Thickness[.005],Black],
AspectRatio->1,
Frame-> False,
PlotStyle->{(*Lighter@Orange,*)
Darker@Green,White,Yellow,White,White,
Red,White,Lighter@Brown,Yellow,Red,
White,White,White,White,White,
White,White,Red,Red,Darker@Blue,
Darker@Blue,Darker@Blue,Darker@Blue,Darker@Blue,Darker@Blue,
Red,Red,Darker@Blue,Red,Yellow,Red}];

Then there is a disk to hide some circles that were used to make the scalloping.

Graphics[{White,Disk[{0,0},.99]}]

---

The Innards

Some definitions of vertices and triangles. Each triangle, t1, t2,... is a distinct region. Logical operations (RegionUnion. RegionIntersection, and RegionDifference) on large triangles are used to define smaller, triangular cells as derived regions that can be individually colored.

p1={-Cos[ArcTan[.267]],y1};
p2={Cos[ArcTan[.267]],y1};
p3={-Cos[ArcTan[.267]],-y1};
p4={Cos[ArcTan[.267]],-y1};
p5={-x2,(x2+y1)/2};
p6={x2,(x2+y1)/2};
p7={-x2,-(x2+y1)/2};
p8={x2,-(x2+y1)/2};
p9={0.5,-x2};
p10={-0.5,-x2};
p11={0.5,-x2};
p12={-0.5,-x2};
p13={a=-.34,b=-.12};
p14={-a,b};
p15={0.5,x2};
p16={-0.5,x2};  
t1=MeshRegion[{{0,-1},p1,p2},Triangle[{1,2,3}]];
t2=MeshRegion[{{0,1},p3,p4},Triangle[{1,3,2}]];
t3=MeshRegion[{{0,-x2},p5,p6},Triangle[{1,3,2}]];
t4=MeshRegion[{{0,x2},p7,p8},Triangle[{1,3,2}]];
t5=MeshRegion[{{0,+y1},p9,p10},Triangle[{1,3,2}]];
t6=MeshRegion[{{0,p5[[2]]},p13,p14},Triangle[{1,3,2}]];
t7=MeshRegion[{{0,p13[[2]]},p15,p16},Triangle[{1,3,2}]];
t8=MeshRegion[{{0,p7[[2]]},{-.33,p1[[2]]-.12},{.33,p1[[2]]-.12}},Triangle[{1,3,2}]];
t9=MeshRegion[{{0,p3[[2]]},{z=-.23,0.063},{-z,.063}},Triangle[{1,3,2}]];

---

disk=Graphics[{White,Disk[{0,0},.99]}];


innards=RegionPlot[{
t1,t2,t3,t4,t5,t6,t7,t8,t9,(*White*)
RegionDifference[t1,RegionUnion[t5,t4,t2]],(*Blue*)
RegionDifference[t4,RegionUnion[t1,t3,t5]],(*red*)
RegionDifference[t3,RegionUnion[t7,t4,t2]], (*blue*)
RegionDifference[t2,RegionUnion[t1,t7,t3]], (*blue*)
RegionDifference[t5,t1],   (*blue*)
RegionDifference[t4,RegionUnion[t1,t7]], (*Blue *)
RegionDifference[t7,t2],(*Blue*)
RegionDifference[t3,RegionUnion[t1,t2]],(*Blue *)
RegionDifference[t8,t2],  (* blue *)
RegionDifference[t9,t5],  (* red *)
RegionDifference[t9,t6],  (* red *)
RegionIntersection[t4,RegionDifference[t6,t1]], (*blue*)
RegionIntersection[t6,RegionDifference[t5,t8]],  (* red *)
RegionIntersection[t7,t9], (*yellow*)
RegionDifference[RegionIntersection[t7,t8],t5], (*red *)
RegionDifference[RegionIntersection[t5,t6],RegionUnion[t7,t9]],(*red *)
ImplicitRegion[x^2+y^2<= .001,{x,y}],  (* smallest circle *) (* red *)
RegionDifference[RegionIntersection[t7,t1 ],t6], (*Red*)
RegionDifference[t8,RegionUnion[t5,t6]],
RegionDifference[t6,RegionUnion[t7,t8]],
RegionDifference[RegionIntersection[t2,t5],RegionUnion[t7,t8]],
RegionDifference[RegionIntersection[t7,t3],t4],
RegionDifference[RegionIntersection[t1,t3],RegionUnion[t5,t4]],
RegionDifference[RegionIntersection[t2,t4],RegionUnion[t7,t3]],
RegionDifference[RegionIntersection[t5,t4],t3]},
BoundaryStyle->Directive[Thickness[.005],Black],
AspectRatio->1,
PlotStyle->{
White,White,White,White,White,White,White,White,White,
Blue,Red,Red,Blue,Blue,Blue,Blue,Blue,Blue,
Red,Red,Blue,Red,Yellow,Red,Red,Red,Blue,Blue,Blue,Blue,Red,Red,Red,Red}]

---

Putting the parts together

Show[frame,disk,innards,Graphics[{Brown,Thickness[.02],Line[Append[pts,{-w,w}]]}];
Graphics[{RGBColor[0.92,0.8,0.],Thickness[.015],Line[Append[pts,{-w,w}]]}]]

---

Golfed

r=ImplicitRegion;m=MeshRegion;t=Triangle;d=RegionDifference;u=RegionUnion;i=RegionIntersection;(*s=ImplicitRegion*)

n1=8;n2=16;w8=.78 Table[{Cos[2\[Pi] k/n1],Sin[2\[Pi] k/n1]},{k,0,n1-1}];
w16=Table[{Cos[2\[Pi] k/n2],Sin[2\[Pi] k/n2]},{k,0,n2-1}];n=12;y1=.267;x2=1/Sqrt[2];w=1.8;v=1.85;
pts={{-w,w},{-w/4,w},{-w/4,w+w/8},{-5w/8,w+w/8},{-5w/8,w+5w/24},{5w/8,w+5w/24},{5w/8,w+w/8},{w/4,w+w/8},{w/4,w},
{w,w},{w,w/4},{w+w/8,w/4},{w+w/8,5w/8},{w+5w/24,5w/8},{w+5w/24,-5w/8},{w+w/8,-5w/8},{w+w/8,-w/4},{w,-w/4},
{w,-w},{w/4,-w},{w/4,-w-w/8},{(5 w)/8,-w-w/8},{(5 w)/8,-w-(5 w)/24},{-((5 w)/8),-w-(5 w)/24},{-((5 w)/8),-w-w/8},{-(w/4),-w-w/8},{-(w/4),-w},{-w,-w},
{-w,-w/4},{-w-w/8,-w/4},{-w-w/8,-5w/8},{-w-5w/24,-5w/8},{-w-5w/24,5w/8},{-w-w/8,5w/8},{-w-w/8,w/4},{-w,w/4}};

frame=RegionPlot[{
m[pts,Polygon[Range[Length[pts]]]], 
r[x^2+y^2<2.8,{x,y}], 
r[Or@@(((x-#)^2+(y-#2)^2<.1)&@@@w16),{x,y}], 
r[x^2+y^2<1,{x,y}],
r[x^2+y^2<1.4,{x,y}],
r[Or@@(((x-#)^2+(y-#2)^2<.15)&@@@w8),{x,y}],
r[x^2+y^2<1,{x,y}] , 
r[1.8 < x^2+y^2< 2.2,{x,y}] ,
r[2.4 < x^2+y^2< 2.8,{x,y}]},
BoundaryStyle->Directive[Thickness[.003],Black],
AspectRatio->1,
Frame-> False,
PlotStyle->{Darker@Green,White,Yellow,White,White,Red,White,Lighter@Brown,Yellow,Red}];

c=Cos[ArcTan[y1]];
p1={-c,y1};
p2={c,y1};
p3={-c,-y1};
p4={c,-y1};
p5={-x2,(x2+y1)/2};
p6={x2,(x2+y1)/2};
p7={-x2,-(x2+y1)/2};
p8={x2,-(x2+y1)/2};
p9={0.5,-x2};
p10={-0.5,-x2};
p11={0.5,-x2};
p12={-0.5,-x2};
p13={a=-.34,b=-.12};
p14={-a,b};
p15={0.5,x2};
p16={-0.5,x2};
t1=m[{{0,-1},p1,p2},t[{1,2,3}]];
t2=m[{{0,1},p3,p4},t[{1,3,2}]];
t3=m[{{0,-x2},p5,p6},t[{1,3,2}]];
t4=m[{{0,x2},p7,p8},t[{1,3,2}]];
t5=m[{{0,+y1},p9,p10},t[{1,3,2}]];
t6=m[{{0,p5[[2]]},p13,p14},t[{1,3,2}]];
t7=m[{{0,p13[[2]]},p15,p16},t[{1,3,2}]];
t8=m[{{0,p7[[2]]},{-.33,p1[[2]]-.12},{.33,p1[[2]]-.12}},t[{1,3,2}]];
t9=m[{{0,p3[[2]]},{z=-.23,0.063},{-z,.063}},t[{1,3,2}]];

innards=RegionPlot[{
d[t1,u[t5,t4,t2]],
d[t4,u[t1,t3,t5]],
d[t3,u[t7,t4,t2]], 
d[t2,u[t1,t7,t3]], 
d[t5,t1],   
d[t4,u[t1,t7]], 
d[t7,t2],
d[t3,u[t1,t2]],
d[t8,t2],  
d[t9,t5],  
d[t9,t6],  
i[t4,d[t6,t1]], 
i[t6,d[t5,t8]],  
i[t7,t9], 
d[i[t7,t8],t5], 
d[i[t5,t6],u[t7,t9]],
r[x^2+y^2<= .001,{x,y}],   
d[i[t7,t1 ],t6], 
d[t8,u[t5,t6]],
d[t6,u[t7,t8]],
d[i[t2,t5],u[t7,t8]],
d[i[t7,t3],t4],
d[i[t1,t3],u[t5,t4]],
d[i[t2,t4],u[t7,t3]],
d[i[t5,t4],t3]},
BoundaryStyle->Directive[Thickness[.003],Black],
Frame->False,
PlotStyle->{Blue,Red,Red,Blue,Blue,Blue,Blue,Blue,Blue,
Red,Red,Blue,Red,Yellow,Red,Red,Red,Blue,Blue,Blue,Blue,Red,Red,Red,Red}];

trim=Graphics[{RGBColor[0.92,0.8,0.],Thickness[.01],Line[Append[pts,{-w,w}]]}];
trim2=Graphics[{Brown,Thickness[.02],Line[Append[pts,{-w,w}]]}];
Show[frame,Graphics[{White,Disk[{0,0},.99]}],trim2,trim,innards]