Compute the arithmetic functions for large integer in Mathematica faster? - wolfram-mathematica

Question

Let f be an arithmetic function and A={k1,k2,...,kn} are integers in increasing order.
Now I want to start with k1 and compare f(ki) with f(k1). If f(ki)>f(k1), put ki as k1.
Now start with ki, and compare f(kj) with f(ki), for j>i. If f(kj)>f(ki), put kj as ki, and repeat this procedure.
At the end we will have a sub sequence B={L1,...,Lm} of A by this property:
L1=k1
L2=ki
L3=kj
...
where
f(L(i+1))>f(L(i)), for any 1<=i<=m-1
For example, let f be the divisor function of integers.
I think there should be some way to do more efficient and faster than I did.
Do you know how to write a code for my purpose in Mathematica or Matlab.
Mathematica is preferable.
«««««««««««««««««««««««««««««««
I have written a code for this program with Mathematica, and it take some hours to compute f of ki's or the set B for large numbers.
Here I put some part of my code and this is just a sample and the question in my program could be more larger than these:
the space between g's are product. for example:
g[67757] g[353]=g[67757]*g[353]
««««««««««««««««««««««««««««««««««««
f[n_] := DivisorSigma[0, n];
g[n_] := Product[Prime[i], {i, 1, PrimePi[n]}];
k1 = g[67757] g[353] g[59] g[19] g[11] g[7] g[5]^2 6^3 2^7;
k2 = g[67757] g[353] g[59] g[19] g[11] g[7] g[5] 6^5 2^7;
k3 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5] 6^4 2^7;
k4 = g[67759] g[349] g[53] g[19] g[11] g[7] g[5] 6^5 2^6;
k5 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5] 6^4 2^8;
k6 = g[67759] g[349] g[53] g[19] g[11] g[7] g[5]^2 6^3 2^7;
k7 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5] 6^5 2^6;
k8 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5] 6^4 2^9;
k9 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5]^2 6^3 2^7;
k10 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5] 6^5 2^7;
k11 = g[67759] g[349] g[53] g[19] g[11] g[7] g[5]^2 6^4 2^6;
k12 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5]^2 6^3 2^8;
k13 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5]^2 6^4 2^6;
k14 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5]^2 6^3 2^9;
k15 = g[67757] g[359] g[53] g[19] g[11] g[7] g[5]^2 6^4 2^7;
k16 = g[67757] g[359] g[53] g[23] g[11] g[7] g[5] 6^4 2^8;
k17 = g[67757] g[359] g[59] g[19] g[11] g[7] g[5] 6^4 2^7;
k18 = g[67757] g[359] g[53] g[23] g[11] g[7] g[5] 6^4 2^9;
k19 = g[67759] g[353] g[53] g[19] g[11] g[7] g[5] 6^4 2^6;
k20 = g[67763] g[347] g[53] g[19] g[11] g[7] g[5] 6^4 2^7;
k = Table[k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14, k15, k16, k17, k18, k19, k20];
i = 1;
count = 0;
For[j = i, j <= 20, j++,
If[f[k[[j]]] - f[k[[i]]] > 0, i = j; Print["k",i];
count = count + 1]];
Print["count= ", count]
««««««««««««««««««««««««««««««««««««

Answer 1

DivisorSigma has to factor the numbers (it has no idea how they were constructed). You can speed this substantially by removing the gcd of the list. In detail:
Compute new list as old list / gcd.
Factor the gcd.
Use a function that, given a pair of integers in factored form, merges the factorization (so you have their product in factored form).
Then for any two elements in the reduced list, you compare by merging their factorizations each with that of the gcd, and invoking a function to compute the number of divisors when given the factored form. That last is simply the product of the exponents each increased by one.
In code:
kgcd = GCD ## k;
newk = k/kgcd;
gcdfacs = FactorInteger[kgcd];
sumDivisors[faclist_] := Times ## (1 + faclist[[All, 2]])
mergeFactorLists[fl1_, fl2_] :=
Flatten[GatherBy[Join[fl1, fl2], First] /.
{{p1_Integer,e1_Integer}, {p1_,e2_Integer}} -> {{p1,e1+e2}}, 1]
f2[v1_] := sumDivisors[mergeFactorLists[FactorInteger[v1], gcdfacs]]
Here is your example, with f2 applied to elements of newk.
Timing[i = 1;
count = 0;
For[j = i, j <= 20, j++,
If[f2[newk[[j]]] - f2[newk[[i]]] > 0, i = j; Print["k", i];
count = count + 1]];
Print["count= ", count]]
During evaluation of In[140]:= k2
During evaluation of In[140]:= k5
During evaluation of In[140]:= k7
During evaluation of In[140]:= k8
During evaluation of In[140]:= k9
During evaluation of In[140]:= k10
During evaluation of In[140]:= k12
During evaluation of In[140]:= k13
During evaluation of In[140]:= k14
During evaluation of In[140]:= k15
During evaluation of In[140]:= k16
During evaluation of In[140]:= k17
During evaluation of In[140]:= k18
During evaluation of In[140]:= count= 13
Out[140]= {0.539918, Null}
As others commented, you might instead want to do SortBy or perhaps
sortedk = k[[Ordering[newk, All, f2[#1] < f2[#2] &]]];
--update 2011-02-01--
Here are the various requested function, made to operate on integers represented as lists of their prime factors and corresponding powers. We use utility functions to "multiply" two or more such representations, so that they are easily constructed from the definition for g[] above.
logarithm[fl_] := fl[[All,2]] . Log[fl[[All,1]]]
divSigma[k_, fax_] := Times ##
((fax[[All, 1]]^(k*(fax[[All, 2]] + 1)) - 1)/(fax[[All, 1]]^k - 1))
mergeFactorLists[f1_,f2_,f3__] :=
mergeFactorLists[mergeFactorLists[f1,f2],f3]
mergeFactorLists[fl1_, fl2_] :=
Flatten[GatherBy[Join[fl1, fl2], First] /.
{{p1_Integer,e1_Integer}, {p1_,e2_Integer}} -> {{p1,e1+e2}}, 1]
eulerPhi[fl_] :=
Times ## ((fl[[All, 1]] - 1)*fl[[All, 1]]^(fl[[All, 2]] - 1))
I use factorlist in a manner similar to use of g[] above, but to obtain the factored lists rather than the integer itself. For ease of converting code, you might do as below.
g[n__] := factorList[n]
Then you would construct k1 et al as:
k1 = mergeFactorLists[g[67757], g[353], g[59], g[19], g[11], g[7],
g[5, 2], g[4, 3], g[2, 7]];
I remark that it might be better to use indexing e.g. k[1], k[2], etc. This way you can store the index instead of the number (whether represented as a factored list or fully expanded). This was a concern in either your comments or private email, I'm not sure.
Here is a short example to indicate that the functions might be working as advertised.
In[77]:= example =
mergeFactorLists[g[59], g[19], g[11], g[7], g[5, 2], g[4, 3], g[2, 7]]
Out[77]= {{2, 16}, {3, 9}, {5, 6}, {7, 4}, {11, 3}, {13, 2}, {17,
2}, {19, 2}, {23, 1}, {29, 1}, {31, 1}, {37, 1}, {41, 1}, {43,
1}, {47, 1}, {53, 1}, {59, 1}}
In[83]:= divSigma[2, example]
Out[83]= 8309625653259163198663074449058595410045270294408417958734031\
0136565010401600000000
In[92]:= eulerPhi[example]
Out[92]= 30117106786279162451552137484697600000000
In[95]:= examplenumber = Times ## Map[#[[1]]^#[[2]] &, example]
Out[95]= 225123336762006539948611826706656256000000
In[99]:= DivisorSigma[2, examplenumber]
Out[99]= 8309625653259163198663074449058595410045270294408417958734031\
0136565010401600000000
In[100]:= EulerPhi[examplenumber]
Out[100]= 30117106786279162451552137484697600000000
--end update--
Daniel Lichtblau
Wolfram Research

Answer 2

On my version of mathematica, most of the calculation time is spent applying the function f[n]. Even just f[k1] takes a few seconds.
In any case, what you want to do is use SortBy. This will take a list and a function as arguments. It applies the function to every member of the list and sorts them in order from least-to-greatest, so you'll need to swap the list around to greatest-to-least. Remember to use k = List[k1, k2, ... , k20] instead of k = Table[k1, k2, ... , k20] and you should be good.

Answer 3

Part of the reason why this is so slow is because you're using for's and if's in Mathematica. Neither are particularly fast.
Ordinarily it's recommended to try doing some list operation, as this is MUCH faster. I'm not sure how you could accomplish this off hand, but you may want to look into it.