Re: Recursive algorithm
- To: mathgroup at smc.vnet.net
- Subject: [mg97852] Re: [mg97835] Recursive algorithm
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Tue, 24 Mar 2009 05:28:33 -0500 (EST)
- References: <200903230903.EAA27090@smc.vnet.net>
athanase wrote:
> hello all,
>
> i am having headaches trying to produce this recursive
> algorithm in mathematica:
>
> the algorithm devides a reduced fraction r where r > 1 into n steps
> in the form (k+1)/k
>
> 1) try the largest step (k+1)/k (say s) that will fit in r;
> 2) find out how to divide r/s into n-1 steps;
> 3) try the next biggest step, etc;
> 4) until the first step is small enough that n of them are smaller
> than r, then you are done.
>
>
> so for r=8 and n=3
>
> the result is
>
> (2/1,2/1,2/1)
>
> and for r=7/5, n=2
>
> the result is
>
> (4/3,21/20),(6/5,7/6)
>
>
> i have found this algorithm written in another system but attempt to
> translate it fails for n>2
>
> below is the code;
>
> sincere thanks for considering this problem,
>
> athanase
>
>
> spsubdiv := proc(r:rational,n:integer)
> local i,j,l,s;
> if n=1
> then
> if numer(r)=denom(r)+1
> then [r]
> else ( NULL )
> fi;
> else
> s := NULL;
> for i from floor(1/(r-1))+1 while (1+1/i)^n >= r do
> l := [spsubdiv( r/(1+1/i), n-1 )];
> for j to nops(l) do
> if op(1,op(j,l)) <= (1+1/i)
> then s := s, [(1+1/i),op(op(j,l))];
> fi
> od;
> od;
> s;
> fi;
> end:
One way (probably among many possibilities):
spsubdiv[2,1] = {fractionSequence[2]};
spsubdiv[r_Rational,1] /; Numerator[r]==Denominator[r]+1 :=
{fractionSequence[r]}
spsubdiv[_,1] = {};
spsubdiv[r_Rational|r_Integer, n_Integer /; n>1] :=
Union[Map[Sort,Flatten[Table[With[{j=1+1/i},
Map[Join[fractionSequence[j],#]&,spsubdiv[r/j,n-1]]]
,{i,Floor[1/(r-1)]+1,Floor[1/(r^(1/n)-1)]}]]]]
Examples:
In[64]:= InputForm[spsubdiv[8,3]]
Out[64]//InputForm= {fractionSequence[2, 2, 2]}
In[65]:= InputForm[spsubdiv[7/5,2]]
Out[65]//InputForm= {fractionSequence[4/3, 21/20],
fractionSequence[6/5, 7/6]}
In[66]:= InputForm[spsubdiv[7/5,3]]
Out[66]//InputForm=
{fractionSequence[441/440, 22/21, 4/3], fractionSequence[231/230, 23/22,
4/3], fractionSequence[161/160, 24/23, 4/3],
fractionSequence[126/125, 25/24, 4/3], fractionSequence[126/125, 10/9,
5/4],
fractionSequence[105/104, 26/25, 4/3], fractionSequence[91/90, 27/26,
4/3],
fractionSequence[81/80, 28/27, 4/3], fractionSequence[63/62, 31/30, 4/3],
fractionSequence[56/55, 33/32, 4/3], fractionSequence[56/55, 11/10, 5/4],
fractionSequence[51/50, 35/34, 4/3], fractionSequence[49/48, 36/35, 4/3],
fractionSequence[49/48, 8/7, 6/5], fractionSequence[42/41, 41/40, 4/3],
fractionSequence[36/35, 7/6, 7/6], fractionSequence[28/27, 9/8, 6/5],
fractionSequence[26/25, 14/13, 5/4], fractionSequence[21/20, 16/15, 5/4],
fractionSequence[21/20, 10/9, 6/5], fractionSequence[21/20, 8/7, 7/6],
fractionSequence[16/15, 9/8, 7/6], fractionSequence[14/13, 13/12, 6/5],
fractionSequence[12/11, 11/10, 7/6]}
As per comments at URL below, if you do large examples and speed becomes
an issue, you might want to memoize values using the construct
spsubdiv[r_Rational|r_Integer, n_Integer /; n>1] :=
spsubdiv[r,n] = ...
https://home.comcast.net/~dcanright/super/app.htm
This makes around a factor of three speed difference for
In[77]:= Timing[Length[spsubdiv[2,6]]]
Out[77]= {54.0718, 49513}
That is, with the alteration
spsubdiv[r_Rational|r_Integer, n_Integer /; n>1] :=
spsubdiv[r,n] =
Union[Map[Sort,Flatten[Table[With[{j=1+1/i},
Map[Join[fractionSequence[j],#]&,spsubdiv[r/j,n-1]]]
,{i,Floor[1/(r-1)]+1,Floor[1/(r^(1/n)-1)]}]]]]
this instead is around 18 seconds.
I will point out that this version of the code will not handle
spsubdiv[2,7] because iterators become too large.
Daniel Lichtblau
Wolfram Research
- Follow-Ups:
- Re: Re: Recursive algorithm
- From: Daniel Lichtblau <danl@wolfram.com>
- Re: Re: Recursive algorithm
- References:
- Recursive algorithm
- From: athanase <aeoost@gmail.com>
- Recursive algorithm