I have not worked a Euler Project problem in some time. Here’s problem 183:

Let N be a positive integer and let N be split into k equal parts, r = N/k, so that N = r + r + … + r.
Let P be the product of these parts, P = r × r × … × r = rk.

For example, if 11 is split into five equal parts, 11 = 2.2 + 2.2 + 2.2 + 2.2 + 2.2, then P = 2.25 = 51.53632.

Let M(N) = Pmax for a given value of N.

It turns out that the maximum for N = 11 is found by splitting eleven into four equal parts which leads to Pmax = (11/4)4; that is, M(11) = 14641/256 = 57.19140625, which is a terminating decimal.

However, for N = 8 the maximum is achieved by splitting it into three equal parts, so M(8) = 512/27, which is a non-terminating decimal.

Let D(N) = N if M(N) is a non-terminating decimal and D(N) = -N if M(N) is a terminating decimal.

For example, ΣD(N) for 5 ≤ N ≤ 100 is 2438.

Find ΣD(N) for 5 ≤ N ≤ 10000.

To compute M(n) you have to find the integer value k which maximizes (n/k)^k. The trick is to use calculus to find the real value x which maximizes (n/x)^x, and then test floor[x] and ceiling[x], the two nearest integers to x, to see which is correct. Differentiating (n/x)^x with respect to x, and solving for zero gives x = n/e, where e is the base of the natural log.

To compute D(n) requires one to decide whether a decimal expansion of a rational number terminates. The expansion terminates iff the prime factors of the denominator are a subset of {2, 5}. Combining these two observations into some Mathematica code gives

M[n_ ] := Module[{a, b, c},
    {a, b} = {Floor[n/E], Ceiling[n/E]};
    c = If[(n/a)^a < (n/b)^b, n/b, n/a];
    If[terminating @ c, -n, n]]

terminating[r_Rational] := dec @ Denominator @ r
terminating[n_Integer] := True

dec[n_] := Module[{x},
    x = n;
    While[EvenQ @ x, x = x/2];
    While[Mod[x, 5] == 0, x = x/5];
    1 == x]

Plus @@ (M /@ Range[5, 100])

I used M as my function name rather than D, because D is a reserved symbol in Mathematica.