Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Beta Cube - Wolfram Demonstrations Project

• To: mathgroup at smc.vnet.net
• Subject: [mg105148] Re: Beta Cube - Wolfram Demonstrations Project
• From: Roger Bagula <roger.bagula at gmail.com>
• Date: Sun, 22 Nov 2009 06:10:58 -0500 (EST)
• References: <he5voj$3or$1@smc.vnet.net>

On Nov 20, 3:49=C2 am, Roger Bagula <rlbag... at sbcglobal.net> wrote:
> They changed the page:http://demonstrations.wolfram.com/BetaCube/
>
>    * Contributed by: Michael Trott
>    * Suggested by: Stephen Wolfram
>    * Based on work by: Roger Bagula
>
> Respectfully, Roger L. Bagula
> 11759 Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://www=
.google.com/profiles/Roger.Bagula
> alternative email: roger.bag... at gmail.com

Here is a new 3d based on a Fermat -Euleian matrix approach I
developed this morning:
Clear[t, T, M, F]
(* Euerian numbers*)
t[n_, k_] = Sum[(-1)^j Binomial[n, j](k + 1 - j)^(n - 1), {j, 0, k}]
(* Fermat version of Eulerian numbers times their transpose*)
T[n_, k_] := If[n =E2=89=A5 k, t[n + 2, k], 0]*If[n <= k, 0, t[n + 2, k=
]]
(*multinomial like 3d  Cuboid*)
gr = Flatten[Table[If[Mod[T[x, y]*T[y, z], 2] == 1,
				{EdgeForm[], Cuboid[1.2{x,
    y, -z}]}, {}], {x, 0, 31}, {y, 0, 31}, {z, 0, 31}]];
gr = Show[Graphics3D[gr], Boxed -> False]
Show[gr, ViewPoint -> {-0.783, 0.759, 3.203}]


Here is the sequence I submitted based on this type of matrix:
%I A168242
%S A168242 1,1,1,1,3,1,1,29,21,1,1,1769,1872,265,1,1,615871,1227274,
%T A168242
405530,5975,1,1,1124878187,14488841796,8196098025,250869024,
%U A168242 194883,1,1,10146337387971,4127467195814962,2684293284374908
%V A168242
1,1,-1,1,-3,1,1,-29,21,-1,1,-1769,1872,-265,1,1,-615871,1227274,
%W A168242
-405530,5975,-1,1,-1124878187,14488841796,-8196098025,250869024,
%X A168242
-194883,1,1,-10146337387971,4127467195814962,-2684293284374908
%N A168242 Coefficient triangle sequence of characteristic polynomials
of a Fermat like matrix:M(n)=Eulerian nth matrix: F(n)=M(n).Transpose[M
(n)]]
%C A168242 Row Sums are:
%C A168242 {1, 0, -1, -8, -160, 211848,5418539727, 1568832578459224,
5586114023994799591396,
%C A168242 -416657044755533539390036118560,
-14128568453639379750002082917435886133265,
-6849588404991830798534151932598866046674668061916984...}.
%C A168242 Example matrix F(3);
%C A168242 {{3, 5, 1},
%C A168242 {5, 17, 4},
%C A168242 {1, 4, 1}}
%D A168242 L. Comtet, Advanced Combinatorics, Reidel, Holland, 1978,
page 172
%e A168242 {1},
%e A168242 {1, -1},
%e A168242 {1, -3, 1},
%e A168242 {1, -29, 21, -1},
%e A168242 {1, -1769, 1872, -265, 1},
%e A168242 {1, -615871, 1227274, -405530, 5975, -1},
%e A168242 {1, -1124878187, 14488841796, -8196098025, 250869024,
-194883, 1},
%e A168242 {1, -10146337387971, 4127467195814962, -2684293284374908,
136124480159052, -319484649614, 8897703, -1},
%e A168242 {1, -428247824076704947, 17914574195515702665641,
-13896536495233638792866, 1577809812703562226910,
-9306019885601872094, 778719385854493, -533785743, 1},
%e A168242 {1, -81122352002183205692001,
1013200645627301010738899491371, -2171326301305554075331374889621,
748623927505727977255573077308, -7156540983035789703544116336,
1305525584958241674283545, -3205618448985143519, 40926870693, -1},
%e A168242 {1, -66885549293275814462767924797,
700501791981375381769184102256200146631,
-28023249349569184787979186261051800365390,
13350702011670792795258543143392523163311,
-156586293448931879782269330892154553133,
63386232099122631948920609947972715, -438644853880761289559728814794,
21273733616165855220783, -3893960978593, 1},
%e A168242 {1, -234732980513118576078558469331193281,
5621271025686372941421637129418789177249005788203,
-13305553109795291932551487280535074672188567064406267,
6564379514567042192853283682636347534279562461093950,
-114178043014292921637849211194413456481495109216258,
141964308173916470071468540296775755854414852854,
-2083148469963100139599682004755602288051786,
278086488638019757478602360279335075, -214476940412956125417947983,
450564987828509, -1}
%t A168242 Clear[t, T, M, F];
%t A168242 t[n_, k_] = Sum[(-1)^j Binomial[n, j](k + 1 - j)^(n - 1),
{j, 0, k}];
%t A168242 T[n_, k_] := If[n &gt;= m, t[n + 2, k], 0];
%t A168242 M[n_] := Table[T[m, k], {k, 0, n}, {m, 0, n}];
%t A168242 F[n_] := M[n].Transpose[M[n]];
%t A168242 Join[{{1}}, Table[CoefficientList[CharacteristicPolynomial[F
[n], x], x], {n, 0, 10}]];
%t A168242 Flatten[%]
%K A168242 sign
%O A168242 0,5
%A A168242 Roger L. Bagula (rlbagulatftn(AT)yahoo.com), Nov 21 2009