Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Re: Re: Recursive algorithm


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






  • Prev by Date: Re: Unexpected behavior of Floor and IntegerPart
  • Next by Date: Re: utterly confused by Lightweight Grid
  • Previous by thread: Re: Recursive algorithm
  • Next by thread: Re: Recursive algorithm