Services & ResourcesWolfram ForumsMathGroup Archive

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

A problem in Pi digits as Lattice space filling

• To: mathgroup at smc.vnet.net
• Subject: [mg93793] A problem in Pi digits as Lattice space filling
• From: Roger Bagula <rlbagula at sbcglobal.net>
• Date: Wed, 26 Nov 2008 05:11:39 -0500 (EST)

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

• Follow-Ups:
  • Re: A problem in Pi digits as Lattice space filling
    • From: Daniel Lichtblau <danl@wolfram.com>