I would like to write a program in Mathematica to look for the integer $n$ such that the following definition holds for any $1 < m < n $

$$\frac{f(n)}{f(m)}>1+\frac{\log(n/m)}{\log(n) \log(\log(m))}$$

where $f(n)$ is for example number of divisors of $n$ (and also count the number of resulting sets).

I wrote the following code, but the problem is that when it finds the first j1 in the next step of the For, it looks for the value j2 for which

$$\frac{f(j_2)}{f(j_1)}>1+\frac{\log(j_2/j_1)}{\log(j_2) \log(\log( j_1))}$$

but I want it to find the j2 such that

$$\forall j,\ j_1 \le j < j_2 \implies \frac{f(j_2)}{f(j)}>1+\frac{\log(j_2/j)}{\log (j_2) \log(\log(j))}$$

Note: In the following example k[*] is a special and known sub sequence of integers.

i = 20;

count = 0;

list = {i};

For[j = i, j <= 100, j++,

    If[ f[k[j]]/f[k[i]] > 1 + Log[k[j]/k[i]]/(Log[k[j]] Log[Log[k[i]]]), i = j; 
        AppendTo[list, i];
        count = count + 1


Print["count= ", count]
  • $\begingroup$ Have you seen DivisorSigma[] already? $\endgroup$ – J. M.'s ennui May 25 '13 at 19:21
  • $\begingroup$ @ J. M.♦, yes, but my problem is: assume we start with k[20], then when we reach to the first k[j] such that not only f[k[j]]/f[k[20]]>(1+Log[k[j]/k[20]]/(Log[k[j]]Log[Log[k[20]]])), also f[k[j]]/f[k[i]]>(1+Log[k[j]/k[i]]/(Log[k[j]]Log[Log[k[i]]])), for all i such that 20<i<j. $\endgroup$ – asd May 25 '13 at 20:13
  • $\begingroup$ Could you give an example for f and k ? $\endgroup$ – b.gates.you.know.what May 28 '13 at 13:49
  • $\begingroup$ @b.gatessucks, for example f[n_]:=DivisorSigma[1,n]/n and k=Table[s[i],{i,20,100}] is a subsequence of superabundant or highly composite numbers $\endgroup$ – asd May 28 '13 at 13:56

try this for the original question (without the k..)

  Reap[ Do[If[ 
     And @@ Table[ 
        f[n]/f[m] > 1 + Log[n/m]/(Log[n] Log[Log[m]]) ,
                {m, 2, n - 1}] , Sow[n]] , {n, 3, 100}] ]

If you want to use explicit loops you need an outer n loop and inner m loop.

Last@Last@Reap[ Do[
        m = 2;
        While[m < n &&   f[n]/f[m] > 1 + Log[n/m]/(Log[n] Log[Log[m]]) , ++m] ;
        If[ m == n, Sow[n]];, {n, 3, 100}] ]

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.