MathGroup Archive 2010

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

Search the Archive

Re: Re: Pi day

  • To: mathgroup at smc.vnet.net
  • Subject: [mg108370] Re: [mg108358] Re: [mg108300] Pi day
  • From: Mark McClure <mcmcclur at unca.edu>
  • Date: Mon, 15 Mar 2010 05:01:13 -0500 (EST)
  • References: <201003131255.HAA28381@smc.vnet.net>

On Mon, Mar 15, 2010 at 1:05 AM,  <danl at wolfram.com> wrote:
> In[380]:= best = closest[candidates, Pi]
> Out[380]= {429751836, 136794258}
>
> In[382]:= bestfrac = frac[best]
> Out[382]= 23875102/7599681
>
> In[386]:= N[bestfrac - Pi, 5]
> Out[386]= 1.0186*10^-10
>
> So we get within around 10^(-10) of our quarry.

I've got that beat by a bit:

N[Pi - 467895213/148935672]
8.49969*10^-11

In fact, this is provably the best possible.  My code is only slightly
more clever than brute force.  Of course, there are 9! = 362880 such
integers.  Sort them from highest to lowest, say
{a(1),a(2),...a(362880)}.  Then, on each sublist of the form
{a(k),a(k+1),...a(362880)}, find the fractions of the form a(k)/a(n)
and a(k)/a(n+1) that are just smaller and just larger than pi.  (This
can be done quickly using a binary search.)  Now, you've only got
around 600,000 fractions to check.  Here's the code that runs in a few
minutes.

findPiInterval[n_Integer, rest_List] := Module[{a, b, c, len},
   Which[
    n/First[rest] > Pi, {1},
    n/Last[rest] < Pi, {Length[rest]},
    True,
    list = rest;
    a = 1; b = len = Length[list];
    While[b - a > 1,
     c = Floor[(a + b)/2];
     If[n/list[[c]] < Pi, a = c, b = c]];
    {a, b}]];
findPiInterval[all_List] := findPiInterval[First[all], Rest[all]] + 1;

ints1 = Reverse[FromDigits /@ Permutations[Range[9]]];
len = Length[ints1];
ints = Prepend[ints1, 0];
Monitor[close = Table[{k, findPiInterval[
       ints = Rest[ints]]}, {k, 1, len - 1}], {k, len}]; // Timing
{235.83, Null}

close = Flatten[close /. {n_Integer, pos_List} :>
     ({ints1[[n]], #} & /@ ints1[[pos + n - 1]]), 1];
close = Append[#, #[[1]]/#[[2]]] & /@ close;
lo = Last[SortBy[Select[close, Last[#] < Pi &], Last]];
hi = First[SortBy[Select[close, Last[#] > Pi &], Last]];
{lo, hi}

{{467895213, 148935672, 51988357/16548408},
 {429751836, 136794258, 23875102/7599681}}

N[Pi - Last[lo]]
8.49969*10^-11

Mark McClure


  • References:
    • Pi day
      • From: Tom <tidetabletom@gmail.com>
  • Prev by Date: Re: Building a list of all words of length less than k in a given
  • Next by Date: Re: Pi day
  • Previous by thread: Re: Pi day
  • Next by thread: Re: Pi day