Re: Re: Pi day
- To: mathgroup at smc.vnet.net
- Subject: [mg108359] Re: [mg108340] Re: Pi day
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Mon, 15 Mar 2010 00:05:45 -0500 (EST)
- References: <hng20k$ro0$1@smc.vnet.net> <201003141014.FAA29782@smc.vnet.net>
- Reply-to: drmajorbob at yahoo.com
Very interesting problem! (But probably not one for high school students.)
Here are timings for the first part of Francesco's method:
Timing[digits = Permutations[{1, 2, 3, 4, 5, 6, 7, 8, 9}, {9}];]
Timing[factors = 10^# & /@ Range[8, 0, -1];
p1 = (#.factors) & /@ digits;]
{0.021722, Null}
{0.119972, Null}
I was surprised to find this was slower:
Timing[p2 = FromDigits /@ digits;]
p1 == p2
{0.777502, Null}
True
But this was faster than both, which did NOT surprise me:
Timing[
candidates = digits.(10^Range[8, 0, -1]);]
candidates == p1
{0.039861, Null}
True
The next step of Francesco's method was too slow for my patience level, so
I
tried something else. (And so, in the end, I spent MUCH more time than
simply using his method!)
(1) I sanity-checked the ordering of candidates:
pi = p2 = digits =.;
OrderedQ@candidates
True
(2) I determined the largest denominator (plus a little) that I'd need to
deal with:
Reduce[Pi b <= 987654321, Integers]
b \[Element] Integers && b <= 314380134
If a/b is close to Pi, and a <= 987654321, then optimal b is not much more
than the bound above.
But I need a bit of slack, so I find the smallest candidate larger than
the bound:
bUpper = Last@Select[candidates, Pi # < 987654321 &]
bNdxUpper = Position[candidates, bUpper][[1, 1]]
314298765
81480
I need to end on an element of the candidate list, even though it's too
large (I think) to be optimal.
(3) Similarly, I determined the smallest candidate numerator that I'd ever
need:
aLower = Last@Select[candidates, # < 123456789 Pi &]
aNdxLower = Position[candidates, aLower][[1, 1]]
n = Length@candidates
387695421
115080
362880
(4) I computed an InterpolationFunction that maps from candidate values of
(Pi * denominator) to their index in the candidate list:
Block[{c = Drop[candidates, aNdxLower - 1], r},
Print@First@c;
Print@Round[1/Pi First@c];
r = Range[aNdxLower, n];
cf = Interpolation[Thread[{c, r}], InterpolationOrder -> 1];
Print[cf /@ c == r]
]
387695421
123407285
True
The reason I needed aLower and aNdxLower was to make "cf" smaller than
using the entire candidate list in place of "c".
InterpolationOrder -> 1 is essential, since otherwise, cf isn't monotone.
(5) I formed a "numerator" function that tries the two nearest candidate
numerators (near to Pi b) and returns the best one, along with the
absolute error:
Clear[numerator]
numerator[b_] /; b <= bUpper :=
Module[{ndx = cf[Pi b], indices, a},
indices = Through[{Floor, Ceiling}@ndx];
a = First@
candidates[[indices[[Ordering[Abs[Pi - candidates[[indices]]/b],
1]]]]];
{Pi - a/b // N // Abs, a, b}
]
(6) Here it is, evaluated at the smallest and largest denominators I've
allowed:
numerator /@ {123456789, bUpper}
{{0.000498269, 387912456, 123456789}, {0.0000434772, 987412356,
314298765}}
(7) Compute all the relevant trials:
Timing[nums = Sort[numerator /@ Take[candidates, bNdxUpper]];]
{16.617, Null}
(8) Check out the best and worst approximations found:
Through[{First, Last}@nums]
{{1.01855*10^-10, 429751836, 136794258}, {0.106985, 412356789,
126934578}}
(9) I looked at about 22.5% of the legal denominators, and two numerators
for each.
bNdxUpper/n // N
0.224537
(10) It turned out that Ceiling was chosen every time.
I'm not sure why that is, or if it indicates I'm missing something.
Indeed, I could have missed something... but 429751836 / 136794258 is
closer than Patrick's 10-digit result.
Bobby
On Sun, 14 Mar 2010 05:14:44 -0500, DC <b.gatessucks at gmail.com> wrote:
> Not elegant and probably slow :
>
> digits = Permutations[{1, 2, 3, 4, 5, 6, 7, 8, 9}, {9}];
>
> factors = 10^# & /@ Range[8, 0, -1];
>
> possibilities = (#.factors) & /@ digits;
>
> output = Flatten[
> Outer[{#1, #2, Abs[#1/#2 - \[Pi]]} &, possibilities, possibilities,
> 1, 1], 1];
>
> SortBy[output, #[[3]] &] // First // N
> SortBy[output, #[[3]] &] // Last // N
>
>
> -Francesco
>
> On 03/13/2010 12:55 PM, Tom wrote:
>> 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
>>
>
--
DrMajorBob at yahoo.com
- References:
- Re: Pi day
- From: DC <b.gatessucks@gmail.com>
- Re: Pi day