# Message Boards

0
|
4010 Views
|
0 Replies
|
0 Total Likes
View groups...
Share
 I would like to find the pattern for the elements in the following set. I especially would like to see how to use Mathematica to arrive at it. But if you can't get Mathematica to do it -- and can do it some other way-- please post your solution. {a, a, b, c, a, a, d, a, e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, a, d, e, d, e, d, e, a, b, c, a, a, a, b}  Here it is again, formatted differently:  {a, a, b, c, a, a, d, a, e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, a, d, e, d, e, d, e, a, b, c, a, a, a, b}  a-e Actually have exact values, if that is helpful. Here they are with the exact values: {1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2])}  Here is the Mathematica notebook where they come from.(it is also attached, so you can edit and copy it.) A formula that produces (-s/d) which = an approximation to the MRB constant: expM[pre_] := Module[{a, k, bb, c, n, end, iprec, xvals, x, pc, cores = 4, tsize = 2^7, chunksize, start = 1, ll, ctab, pr = Floor[1.02 pre]}, chunksize = cores*tsize; n = Floor[1.32 pr]; end = Ceiling[n/chunksize]; d = N[(3 + Sqrt[8])^n, pr + 10]; d = Round[1/2 (d + 1/d)]; {b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0}; iprec = Ceiling[pr/27]; Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l; x = N[E^(Log[ll]/(ll)), iprec]; pc = iprec; While[pc < pr, pc = Min[3 pc, pr]; x = SetPrecision[x, pc]; y = x^ll - ll; x = x (1 - 2 y/((ll + 1) y + 2 ll ll));];(*N[Exp[Log[ll]/ll], pr]*)x, {l, 0, tsize - 1}], {j, 0, cores - 1}, Method -> "EvaluationsPerKernel" -> 1]]; ctab = Table[c = b - c; ll = start + l - 2; b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1)); c, {l, chunksize}]; s += ctab.(xvals - 1); start += chunksize; , {k, 0, end - 1}]; N[-s/d, pr]];  A small sample of high precision ss[10a]*ss[10a+20]/ss[10a+10]^2. (a=1,2,3...) In other words,(ss[10]/ss[20])/(ss(20]/ss[30]), ect These were looked up in Wolfram Alpha to get exact values.: nx = 11; a = 0; For[xx = 1, xx <= nx, a = a + 10; prec = a; MRBtest2 = expM[prec]; ss[a] = s; xx++]; Table[ ss[10 a]*ss[10 a + 20]/ss[10 a + 10]^2, {a, nx - 2}]  . Out[9]= {1.0000000, 1.00000000000000000, 33.9705627484771405856202647, \ 0.02943725152285941437973530948362305716, \ 1.000000000000000000000000000000000000000000000000, \ 1.0000000000000000000000000000000000000000000000000000000000, \ 5.8284271247461900976033774484193961571393437507538961463533594759815,\ 1.0000000000000000000000000000000000000000000000000000000000000000000\ 00000000000, \ 0.17157287525380990239662255158060384286065624924610385364664052401853\ 50430757859222992249}  A larger set of ss[10a]*ss[10a+20]/ss[10a+10]^2, (aa=10,20,30...). In other words,(ss[10]/ss[20])/(ss(20]/ss[30]), ect.: nx = 100; a = 0; For[xx = 1, xx <= nx, a = a + 10; prec = a; MRBtest2 = expM[prec]; ss[a] = s; xx++]; stuff = Table[ss[10 a]*ss[10 a + 20]/ss[10 a + 10]^2, {a, nx - 2}]; N[stuff, 2]  . Out[10]= {1.0, 1.0, 34., 0.029, 1.0, 1.0, 5.8, 1.0, 0.17, 5.8, 0.17, 1.0, 5.8, \ 1.0, 0.17, 1.0, 1.0, 34., 0.029, 1.0, 1.0, 5.8, 1.0, 0.17, 5.8, 0.17, \ 1.0, 5.8, 1.0, 0.17, 1.0, 1.0, 34., 0.029, 1.0, 1.0, 5.8, 1.0, 0.17, \ 1.0, 5.8, 0.17, 5.8, 1.0, 0.17, 1.0, 1.0, 34., 0.029, 1.0, 1.0, 5.8, \ 1.0, 0.17, 1.0, 5.8, 0.17, 5.8, 1.0, 0.17, 1.0, 1.0, 34., 0.029, 1.0, \ 1.0, 1.0, 34., 0.029, 1.0, 5.8, 0.17, 5.8, 1.0, 0.17, 1.0, 1.0, 34., \ 0.029, 1.0, 1.0, 1.0, 34., 0.029, 1.0, 5.8, 0.17, 5.8, 0.17, 5.8, \ 0.17, 1.0, 34., 0.029, 1.0, 1.0, 1.0, 34.}  1.0 -> 1, 34. -> b, etc. {a, a, b, c, a, a, d, a, e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, \ e, d, e, a, d, a, e, a, a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, \ a, b, c, a, a, d, a, e, a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, \ a, d, e, d, a, e, a, a, b, c, a, a, a, b, c, a, d, e, d, e, d, e, a, \ b, c, a, a, a, b}  a-e Replaced by exact values: \ Out[12]= {1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 1, 3 - 2 Sqrt[2], 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 3 + 2 Sqrt[2], 3 - 2 Sqrt[2], 1, (1 + Sqrt[2]), 17 - 12 Sqrt[2], 1, 1, 1, (1 + Sqrt[2])}  Attachments: