Re: Re: Recursive algorithm
- To: mathgroup at smc.vnet.net
- Subject: [mg97890] Re: [mg97852] Re: [mg97835] Recursive algorithm
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Wed, 25 Mar 2009 05:41:19 -0500 (EST)
- References: <200903230903.EAA27090@smc.vnet.net> <200903241028.FAA19624@smc.vnet.net>
Daniel Lichtblau wrote:
> 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
>> [...]
Below is an improvement on what I last posted. No need to memoize
intermediate results, and it does not spawn (potentially huge) lists
that later require pruning. Also it has no explicit iterator, hence does
not run afoul of size limitations there.
spsubdiv[a_,b_] := spsubdiv[a,b,Infinity]
spsubdiv[2,1,_] = {{2}};
spsubdiv[r_Rational,1,_] /; Numerator[r]==Denominator[r]+1 := {{r}}
spsubdiv[_,1,_] = {};
spsubdiv[r_Rational|r_Integer, n_Integer /; n>1, k_] := Module[
{i, min=Max[Floor[1/(r-1)]+1,Floor[1/(k-1)]],
max=Floor[1/(r^(1/n)-1)]},
Flatten[Reap[For[i = min, i <= max, i++,
With[{j=1+1/i},
Sow[Map[Join[{j},#]&,spsubdiv[r/j,n-1,j]]]]
]][[-1,1,All]],1]]
If the goal is simply to count how many ways this can be done, we can
boost speed a bit as follows.
spsubCount[a_,b_] := spsubCount[a,b,Infinity]
spsubCount[2,1,_] = 1;
spsubCount[r_Rational,1,_] /; Numerator[r]==Denominator[r]+1 := 1
spsubCount[_,1,_] = 0;
spsubCount[r_Rational|r_Integer, n_Integer /; n>1, k_] := Module[
{tot=0, i, min=Max[Floor[1/(r-1)]+1,Floor[1/(k-1)]],
max=Floor[1/(r^(1/n)-1)]},
For[i = min, i <= max, i++,
tot += With[{j=1+1/i},spsubCount[r/j,n-1,j]]
];
tot
]
In[17]:= Timing[spsubCount[2,4]]
Out[17]= {0.007999, 43}
In[18]:= Timing[spsubCount[2,5]]
Out[18]= {0.065989, 876}
In[19]:= Timing[spsubCount[2,6]]
Out[19]= {15.3317, 49513}
The {2,7} case has been running overnight, and has yielded no result
thus far. But neither has it run out of memory.
Daniel Lichtblau
Wolfram Research
- References:
- Recursive algorithm
- From: athanase <aeoost@gmail.com>
- Re: Recursive algorithm
- From: Daniel Lichtblau <danl@wolfram.com>
- Recursive algorithm