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