Synergetics Coordinates

Author

Eric W. Weisstein
January 7, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/CoordinateGeometry/SynergeticsCoordinates.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SynergeticsCoordinates.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Some material follows Clifford J. Nelson
MathSource Item 600

Code

CartesianVertices[{a_,b_,c_}]:=
{{(b-c)/Sqrt[3],b+c},{(a+2b)/Sqrt[3],-a},{-(a+2c)/Sqrt[3],-a}}Sqrt[3]/2
Ctr[{a_,b_,c_}]:={(b-c)/Sqrt[3],(b+c-2a)/3}Sqrt[3]/2

SphereRing[d_Integer,n_Integer]:=Module[{a=Array[x,d]},
a/.{ToRules[Reduce[Plus@@a==0&&Plus@@Abs[a]==2n ,a,Integers]]}
]
SphereRing[d_Integer,l_List]:=SphereRing[d,#]&/@Range@@l

Nelson's Formula

StoP[x_List]:=Module[{wx=x,anser={}},Do[anser=Prepend[anser,-((wx[[i]] (Sqrt[Tri[i]]))/(i-1))];wx=Drop[wx,-1]+((wx[[i]])/(i-1)),{i,Length[x],2,-1}];anser]
Tri[n_Integer]:=(1/2) n (n-1)

Diagram

<<Graphics`Arrow`

With[{p={1,2,4}},
Show[Graphics[{
{Blue,Dashing[{.02}],
sides=Sides[Triangle[CartesianVertices[p]],2]},
{Blue,Line/@Table[10Through[{Cos,Sin}[Pi(2i/3+r)]],{i,3},{r,0,1}]
},
PerpendicularLine[Point[{0,0}],#]&/@sides/.Line[x_]:>Arrow[Sequence@@x,HeadWidth->.5,HeadLength->.04],
{Red,Thickness[.01],Triangle[CartesianVertices[p]]},
PointSize[.025],
{Blue,Point[{0,0}]},
{Red,Point[Ctr[p]]}
}],
AspectRatio->Automatic,PlotRange->{{-6,4.5},{-2.5,6.5}}]
]

Coordinates

SynergeticsVertices[l_List]:=Module[{n=Length[l]},
Table[l,{n}]-IdentityMatrix[n]Plus@@l
]

SynergeticsVertices[{a,b,c}]//MatrixForm//TraditionalForm

SynergeticsVertices[{a,b,c,d}]//MatrixForm//TraditionalForm

Cartesian

CartesianVertices[{1,1,1}]

CartesianVertices[{-1,-1,-1}]

StoP[{a,b,c}]

Edge Lengths

EdgeLengths[s_List]:=Sqrt[#.#]&/@Subtract@@@Partition[s,2,1,1]

Simplify[EdgeLengths[CartesianVertices[{a,b,c}]],(a|b|c)∈Reals]

Circles

SphereRing[3,1]

Show[GraphicsArray[Graphics[{
Red,
Circle[Ctr[#],1/2]&/@#
},AspectRatio->Automatic,Axes->True,Ticks->False]&/@{SphereRing[3,1],Flatten[SphereRing[3,{0,2}],1]}]]

Spheres

SphereRing[4,1]

SphereRing[4,2]

Show[GraphicsArray[Graphics3D[Sphere[StoP[#],1/2]&/@#,Boxed->False]&/@{SphereRing[4,1],Flatten[SphereRing[4,{0,2}],1]}
],GraphicsSpacing->-.2]