|
MATHEMATICA
|
UnitaryDivisors[n_Integer?Positive] := Select[Divisors[n], GCD[ #, n/# ] == 1 \ &];
UnitaryDivisorSum[n_Integer?Positive] := Plus @@ UnitaryDivisors[n];
f[ k_] := Nest[UnitaryDivisorSum, k, 2] - k;
g[ k_] := Nest[UnitaryDivisorSum, f[k], 2] - f[k];
m = 10^7;
data1 = Select[Range[m], g[ # ] == # &];
data2 = Nest[UnitaryDivisorSum, #, 2] - # & /@ data1;
data3 = Table[{data1[[k]], data2[[k]]}, {k, 1, Length[data1]}];
data4 = DeleteCases[Table[If[Nest[UnitaryDivisorSum, First[data3[[k]]], 2] == Nest[UnitaryDivisorSum, Last[data3[[k]]], 2] \ && ! First[data3[[k]]] >= Last[data3[[k]]], data3[[k]], 0], {k, 1, Length[data3]}], 0];
data5 = Table[Length[Select[data4, First[ # ] < 10^k \ &]], {k, 1, 7}]
|