the hard way, the easy way and the accepted way...
- To: mathgroup at smc.vnet.net
- Subject: [mg76810] the hard way, the easy way and the accepted way...
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Mon, 28 May 2007 00:50:14 -0400 (EDT)
You have two maybe three choices in Life:
the hard way, the easy way and the accepted way...
Last night I solved a problem on indices:
I had ten wave functions/spherical harmonic ( from so5):
Binomial[10,3]
and I wanted to make 3d surfaces from them.
This code picks out the ten wave functions from an matrix:
a0 = Flatten[Table[Flatten[Table[If[n < m, M1[[n, m]], {}], {n, 1, m}],
1], {m, 1, 5}], 1];
Dimensions[a0]
This code finds the combinations:
b0 = Delete[Union[Flatten[Table[Flatten[Table[Union[
Table[If[n <
m && m < l, {n,
m, l}, {}], {n, 1, m}]], {m, 1, l}], 1], {l, 1, 10}],
1]], 1];
Length[b0]
This code makes three vectors of the wave functions:
c0 = Table[{a0[[b0[[n]][[1]]]], a0[[b0[[n]][[2]]]], a0[[b0[[n]][[3]]]]},
{n, 1, Length[b0]}];
It works, but it has to be the hard way to solve this problem!
I'd like a more systematic and understandable method!
This is the matematica code for the pictures: ( this gives a very big file!
WebMathematica timed out on the upload
so I can't give a link to the animation file)
Clear[M, M1, x, y, z, x1, y1, z1, x2, y2, z2, t, p, a, a0]
(* unit sphere base for harmonics*)
x = Cos[t]*Sin[p];
y = Sin[t]*Sin[p];
z = Cos[p];
(* SO(5) like matrix with three copies of {x, y, z}*)
M = {{0, x, -y, z, -x},
{-x, 0, z, -y, z},
{y, -z, 0, x, -y},
{-z, y, -x, 0, 1},
{x, -z, y, -1, 0}};
M1 = FullSimplify[M.M];
TableForm[M1]
a0 = Flatten[Table[Flatten[Table[If[
n < m, M1[[n, m]], {}], {n, 1, m}], 1], {m, 1, 5}], 1];
Dimensions[a0]
(* 120 3d surfaces generated by spherical harmonic polynomials in SO(5)*)
b0 = Delete[Union[Flatten[Table[Flatten[Table[Union[Table[If[n <
m && m < l, {n, m, l}, {}], {n, 1, m}]], {m, 1,
l}], 1], {l, 1, 10}], 1]], 1];
Length[b0]
c0 = Table[{a0[[b0[[n]][[1]]]], a0[[
b0[[n]][[2]]]], a0[[b0[[n]][[3]]]]}, {n, 1, Length[b0]}];
g = Table[ParametricPlot3D[c0[[n]],
{t, 0, Pi}, {p, 0, Pi},
Boxed -> False,
Axes -> False
], {n, 1, Length[c0]}]
selectgraphics3d[graphics3dobj_, bound_, opts___] :=
Show[Graphics3D[Select[graphics3dobj,
(Abs[#[[1, 1, 1]]] < bound && Abs[#[[1, 1, 2]]] < bound &&
Abs[#[[1, 1, 3]]] < bound && Abs[#[[1, 2, 1]]] < bound &&
Abs[#[[1, 2, 2]]] < bound && Abs[#[[1, 2, 3]]] < bound &&
Abs[#[[1, 3, 1]]] < bound && Abs[#[[1, 3, 2]]] < bound &&
Abs[#[[1, 3, 3]]] < bound && Abs[#[[1, 4, 1]]] < bound &&
Abs[#[[1, 4, 2]]] < bound && Abs[#[[1, 4, 2]]] < bound
) &]], opts]
dip[ins_][g_] := $DisplayFunction[Insert[g, ins, {1, 1}]]
Table[ selectgraphics3d[g[[n, 1]], 8,
Boxed -> False, ViewPoint -> {2.9, -1.4, 1.2},
DisplayFunction -> dip[EdgeForm[]], PlotRange -> All], {n, 1,
Length[g]}];
gr2 = Table[selectgraphics3d[g[[
n, 1]], 8,
Boxed -> False, ViewPoint -> {-1.938, -1.657, 2.225},
DisplayFunction -> dip[EdgeForm[]], PlotRange ->
All], {
n, 1, Length[g]}];