In[1]:=

FFG3D[a_, c_, vv_, XX_, w_] := Graphics3D[{ RGBColor[1, 0, 0], PointSize[0.03], Point[{0, 0, 0 ... , Line[{vv[[i]], Simplify[w . XX[[a[[j]]]] . XX[[i]]]}]}, {i, Length[XX]}, {j, Length[a]} ] } ]

In[2]:=

LiveForm[g_] := NumberForm[InputForm[N[g]], 5] ; WriteLiveAnimationForm[filename_, g1_, opts_] ... ng[strm, ToString[ HoldForm[ShowAnimation][LiveForm[g1], LiveForm[opts]]]] ; Close[filename] ;)

In[4]:=

Color1 = {{0, 0.4, 1}, {0, 1, 0.25}, {1, 0.5, 0}, {1, 0, 1}} ; Color2 = {{1, 0, 0}, {1, 0.75, ... 0, 1}, {0.7, 0.4, 1}} ; Color4 = {{0, 0.5, 0.5}, {0.4, 0.9, 0.5}, {0.8, 0.8, 0.5}, {0, 1, 0.8}} ;

In[8]:=

In[9]:=

X1 = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}} ; X2 = {{-1, 0, 0}, {0, -1, 0}, {0, 0, 1}} ; X3 = {{-1, ... X24 = {{1/3, -2^(1/2)/3, 2/3^(1/2)}, {-2^(1/2)/3, 2/3, 1/3^(1/2)}, {-2/3^(1/2), -1/3^(1/2), 0}} ;

In[33]:=

In[34]:=

XX = {X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19, X20, X21, X22, X23, X24} ; w = {0, 1, 1} ; vv = Table[Simplify[w . XX[[i]]], {i, 24}] ;

In[37]:=

In[38]:=

T1 = FFG3D[{15, 20}, Color1, vv, XX, w] Show[T1, Axes -> True] WriteLiveAnimationForm["N:gap/Cayley/S4_Cayley1.g3d", T1,]

Out[38]=

-Graphics3D -

[Graphics:HTMLFiles/mathematica_11.gif]

Out[39]=

-Graphics3D -

In[41]:=

In[42]:=

T1 = FFG3D[{2, 3, 13}, Color2, vv, XX, w] Show[T1, Axes -> True] WriteLiveAnimationForm["N:gap/Cayley/S4_Cayley2.g3d", T1,]

Out[42]=

-Graphics3D -

[Graphics:HTMLFiles/mathematica_16.gif]

Out[43]=

-Graphics3D -

In[45]:=

T1 = FFG3D[{20, 10, 3}, Color4, vv, XX, w] Show[T1, Axes -> True] WriteLiveAnimationForm["N:gap/Cayley/S4_Cayley3.g3d", T1,]

Out[45]=

-Graphics3D -

[Graphics:HTMLFiles/mathematica_20.gif]

Out[46]=

-Graphics3D -

In[48]:=

T1s = Table[FFG3D[{i}, Color2, vv, XX, w], {i, 24}] ; Table[Show[T1s[[i]], Axes -> True], {i, 24}]

Converted by Mathematica  (January 15, 2004)