RosettaCodeData/Task/Arithmetic-derivative/Mathematica/arithmetic-derivative.math

33 lines
844 B
Plaintext

(* Arithmetic derivative *)
ClearAll[d, twoFactorsOf];
twoFactorsOf[n_Integer?Positive] := Module[{factors = FactorInteger[n, 2], p, factor},
If[Length[factors] == 1,
factor = Flatten@factors;
p = First@factor;
factors = {factor - {0, 1}, {p, 1}};
];
Return[Power@@@factors];
];
twoFactorsOf[n_Integer?Negative] := twoFactorsOf[-n] * {-1, -1};
d[0] = d[1] = 0;
d[p_Integer?PrimeQ] := 1;
d[n_Integer?Negative] := -d[-n];
d[mn_Integer] := Module[{m, n},
{m, n} = twoFactorsOf[m n];
Return[d[m] n + m d[n]];
];
SetAttributes[d, Listable];
(* Output *)
Partition[StringPadLeft[ToString /@ d[Range[-99, 100]], 5], UpTo[10]] // TableForm
StringJoin["d[10^", ToString@First[#], "]", If[First[#] <= 9, " ", " "], "/ 7",
" = ",
ToString@Last[#]] & /@ Table[{n, d[10^n]/7}, {n, 1, 20}] // TableForm