Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

Re: A problem in Pi digits as Lattice space filling

  • To: mathgroup at smc.vnet.net
  • Subject: [mg93829] Re: A problem in Pi digits as Lattice space filling
  • From: dh <dh at metrohm.com>
  • Date: Wed, 26 Nov 2008 07:22:10 -0500 (EST)
  • References: <ggj7co$j2i$1@smc.vnet.net>


Hi Roger,

first some picky things. The digits in Pi are not normal, but uniformly 

distributed. Further you should have mentioned that you define the 

coordinate tuples by moving only one digit. Then, I can verify  the 

filling number for 1 dim. is 33, but for 2 dim. with 606 the duple {6,8} 

does not appear, you need 607 digits. For 3 dim. I need 8556, not 8554.

Finally, here is a way to do it rather fast. I give the example for 3 dim:

n=8556;

all=Flatten[Table[{i1,i2,i3},{i1,0,9},{i2,0,9},{i3,0,9}],2];

d=Union@Partition[RealDigits[\[Pi],10,n][[1]],3,1];

Complement[all,d]

You increase n until the answer is empty: {}. Of course this can be 

automated by wrapping a binary search around the code above, but I let 

this for you.

hope this helps, Daniel





Roger Bagula wrote:

> I need help with programs for  4th, 5th and 6th, etc.

> levels of lattice filling:

> 

> The idea that the Pi digits are normal

> implies that they will fill space on different levels

> in a lattice type way ( Hilbert/ Peano  space fill).

> 

> Question of space filling:

> Digit(n)-> how fast till all ten

> {Digit[n],Digit[n+1]} -> how fast to fill the square lattice 

> {0,0},{0,9},{9,0},{9,9}

> {Digit[n],Digit[n+1],Digit[n+2]} -> how fast to fill the cubic lattice 

> {0,0,0} to {9,9,9}

> I've answers for the first three with some really clunky programs.

> 33,606,8554,...

> my estimates for the 4th is: 60372 to 71947

> ((8554)2/(606*2)and half the log[]line result of 140000.)

> but it appears to  outside what my old Mac can do.

> I'd also like to graph the first occurrence to see how random the path 

> between

> the lattice / space fill points is.

> 

> The square:

> a = Table[Floor[Mod[N[Pi*10^n, 1000], 10]], {n, 0, 1000}];

> 

> Flatten[Table[

>         If[Length[Delete[Union[Flatten[Table[Table[If[a[[n]] == k && 

> a[[n + \

> 1]] - l ==

>     0, {l, k}, {}], {k, 0, 9}, {

>           l, 0, 9}], {n, 1, m}], 2]], 1]] == 100, m, {}], {m, 600, 610}]]

> {606, 607, 608, 609, 610}

> Table[Length[Delete[Union[Flatten[Table[Table[If[a[[n]] == k && a[[

>                   n + 1]] - l == 0, {l, k}, {}], {k, 0, 9}, {l,

>                 0, 9}], {n, 1, m}], 2]], 1]], {m, 600, 650}]

> {99, 99, 99,

>     99, 99, 99, 100,

>    100, 100, 100,

>     100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,

> 100, 100,

> 100, 100, 100,

>    100, 100, 100, 100, 100,

>       100, 100, 100,

>         100, 100, 100, 100, 100,

>             100, 100, 100, 100, 100, 100, 100, 100, 100}

> 

> Mathematica

> Clear[a, b, n]

> a = Table[Floor[Mod[N[Pi*10^n, 10000], 10]], {n, 0, 10000}];

> b = Table[{a[[n]], a[[n + 1]], a[[n + 2]]}, {n, 1, Length[a] - 2}];

> Flatten[Table[

>   If[Length[Union[Table[b[[n]], {

>       n, 1, m}]]] == 1000, m, {}], {m, 8550, 8600}]]

> {8554, 8555, 8556,

>        8557, 8558, 8559, 8560, 8561, 8562, 8563, 8564, 8565, 8566,

>   8567, 8568, 8569, 8570, 8571, 8572, 8573, 8574, 8575, 8576,

>             8577, 8578, 8579, 8580, 8581, 8582, 8583, 8584, 8585, 8586,

>   8587, 8588, 8589,

>     8590, 8591, 8592, 8593, 8594, 8595, 8596, 8597, 8598, 8599, 8600}

> The proof of the 33 is:

> Clear[a,b,n]

> a=Table[Floor[Mod[N[Pi*10^n,10000],10]],{n,0,10000}];

> Flatten[Table[If[Length[Union[Table[a[[n]],{n,1,

>         m}]]]==10,m,{}],{m,1,50}]]

> {33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50}

> 

> My own 4th level program that won't run on my older machine /older 

> version of Mathematica:

> Clear[a, b, n]

> a = Table[Floor[Mod[N[Pi*10^n, 100000], 10]], {n, 0, 100000}];

> b = Table[{a[[n]], a[[n + 1]], a[[n + 2]], a[[n + 3]]}, {n, 1, Length[a] 

> - 3}];

> Flatten[Table[If[ Length[Union[Table[b[[n]], {n, 1, m}]]] == 10000, m, 

> {}], {m, 1, 50}]]

> 

> Respectfully, Roger L. Bagula

> 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 

> :http://www.geocities.com/rlbagulatftn/Index.html

> alternative email: rlbagula at sbcglobal.net

> 




  • Prev by Date: Re: Solve and parametric nonlinear equations
  • Next by Date: Re: A problem in Pi digits as Lattice space filling
  • Previous by thread: Re: A problem in Pi digits as Lattice space filling
  • Next by thread: Re: Re: A problem in Pi digits as Lattice space filling