MathGroup Archive 2010

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

Search the Archive

Re: Pi day

  • To: mathgroup at smc.vnet.net
  • Subject: [mg108358] Re: [mg108300] Pi day
  • From: danl at wolfram.com
  • Date: Mon, 15 Mar 2010 00:05:34 -0500 (EST)
  • References: <201003131255.HAA28381@smc.vnet.net>

> Hello,  I am a high school math teacher and the following puzzle was
> posed by a few math teachers I am in contact with.
>
> Create a fraction whose numerator has the digits 1 - 9 (used once)
> and whose denominator has the digits 1 - 9  (used one) .
>
> Which fraction has a value closest to the value of pi?
>
> I've worked on some "brute force" checks and managed to check all
> possible fractions with 2,3,4,5 and 6 digits.   But after that, there
> are just too many possibilities.
>
> I don't have the programming ability to implement something elegant in
> Mathematica.
>
> Is there anyone who could suggest an approach to find the solution to
> this?
>
> Sincerely,
>
> Tom

Here is a method that is reasonably effective. It is a "greedy" approach
and I cannot offhand guarantee that is gives the best result (though I
believe it does).

The idea is to begin with all one digit (numerator,denominator) pairs.
Filter out the ones that cannot possibly be improved via further digits in
a way that will beat the best pairs. For the keepers, augment numerators
and denominators with all available single digits. Iterate this process
until we are out of digits. It is the pruning that keeps this from
becoming intractable as we progress over the digit pool. (Eventual
exhaustion of said pool also helps.)

In brief, the routines do as follows.

frac[] makes an integer pair into a rational.

closest[] takes a list of pairs and a target value, and finds the one
whose corresponding fraction is closest to that target.

intervalize[] takes a pair and creates the interval comprised of fractions
where first denominator, and then numerator, are increased by one. This
interval is a crude lower/upper bound on all values that can be attained
by adding allowable digits to the given numerator and denominator.

siftPairs[] takes pairs and a target. it first finds the pair that best
approximates the target. It then removes all others that cannot possibly
get within range via allowable augmentation to numerator and denominator.

successors[] takes a numerator/denominator pair and finds the set of allowed
pairs. These are defined as pairs with numerator and denominator one digit
longer, and neither one repeating digits.

With that intro, here is the code.

frac[{n_Integer, d_Integer}] := n/d

closest[pairs_, target_] :=
 pairs[[Ordering[Abs[Map[frac, pairs, 1] - target], 1]]][[1]]

intervalize[{num_Integer, den_Integer}] :=
 Interval[{num/(den + 1), (num + 1)/den}]

siftPairs[pairs_, target_] := Module[
  {interval, num, den},
  {num, den} = closest[pairs, target];
  interval = intervalize[{num, den}];
  Select[pairs, (IntervalIntersection[intervalize[#], interval] =!=
      Interval[]) &]
  ]

successors[{num_Integer, den_Integer}] := Module[
  {nd, dd, cnd, cdd, nums, dens},
  {nd, dd} = IntegerDigits[{num, den}];
  cnd = Complement[Range[9], nd];
  cdd = Complement[Range[9], dd];
  nums = Map[10*num + # &, cnd];
  dens = Map[10*den + # &, cdd];
  Flatten[Outer[List, nums, dens], 1]
  ]

We now form our initial pairs of one digit numerators and denominators. We
then nest our successorship function eight times (thus exhausting
available digits). In each step we sift to remove pairs that are not
contenders.

initpairs = Flatten[Outer[List, Range[9], Range[9]], 1];

In[377]:= Timing[
 candidates =
   Nest[Flatten[Map[successors, siftPairs[#, Pi]], 1] &, initpairs,
    8];]
Out[377]= {16.864, Null}

In[378]:= Length[candidates]
Out[378]= 2576

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.

It is instructive to print lengths of our pair lists at intermediate
steps. It goes over 70,000 before receding to the eventual 2600 or so.
Possibly a more aggressive sifter would so better (but would be more
trouble to code, or for that matter to figure out how to construct).

Given that we work from most significant digits downward, it seems
plausible that our eventual result will be optimal. But it is not obvious
to me that it is forced to be so. I need to give this more thought.

Daniel Lichtblau
Wolfram Research




  • References:
    • Pi day
      • From: Tom <tidetabletom@gmail.com>
  • Prev by Date: Re: Re: plotting many curves {best times}
  • Next by Date: Re: Re: Pi day
  • Previous by thread: Pi day
  • Next by thread: Re: Re: Pi day