Find a sequence of integers which give max in each step

Question

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
    ]
];

list

Print["count= ", count]

Answer 1

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

Last@Last@
  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}] ]