Although calculation of mathematica codes could be slower than those written in C/C++, or even those in python, the prodigious and interesting if not funny functions do save coding time a lot.

Problem 1

Brute force solution at first thought:

1
2

Total@Select[Range[999], 3\[Divides]# || 5\[Divides]# &]
233168

What if the upper limit is extreme large, like \(10^{10}\), or \(10^{10^7}\)? Calculating one after another or even saving them using Range is impossible. Here comes the mathematical way:

1
2
3
4
5

top = 10^(10^7) - 1;
SumMultiplesOf[n_] := (p = Quotient[top, n]; n*p*(p + 1)/2);
SumMultiplesOf[m_, n_] := SumMultiplesOf[m] + SumMultiplesOf[n] - SumMultiplesOf[LCM[m, n]];
N[SumMultiplesOf[3, 5], 2] // AbsoluteTiming
{2.222280, 2.3*10^19999999}

Problem 2

1
2
3

n=NestWhile[# + 1 &, 1, Fibonacci@# <= 4*^6 &] - 1
Total@Select[Array[Fibonacci,n] ,  EvenQ]
4613732

Even numbers appear every 3rd positions in Fibonacci series:

1

Total@Table[Fibonacci@i, {i, 3, n, 3}]

Problem 3

1
2

Max[FactorInteger[600851475143][[All, 1]]]
6857

Problem 4

1
2

Catch@Scan[If[FromDigit@Reverse@IntegerDigits@# == #, Throw[#]] &, Reverse@Sort@Flatten@Table[i*j, {i, 999, 100, -1}, {j, i, 100, -1}]]
906609

Problem 5

1
2

LCM @@ Range[20]
232792560

Problem 6

Sum is clever to use equations like \(\sum_{i=1}^{n}{i}=\frac{n(n+1)}{2}\)

1
2

(Sum[i, {i, 100}])^2 - Sum[i^2, {i, 100}]
25164150

Problem 7

1
2

Prime[10001]
104743

Problem 8

1
2

Max[Times @@@ Partition[IntegerDigits[n], 13, 1]]
23514624000

Problem 9

1
2

a b c /. Solve[{a^2 + b^2 == c^2, a + b + c == 1000, c>a > b > 0}, {a, b, c}, Integers]
{31875000}

Problem 10

1
2

Sum[Prime[i], {i, PrimePi[2*^6]}]
142913828922

Problem 11

1
2

Max@Table[{Times@@@a, Times@@Diagonal@a, Times@@@Transpose@a, Times@@Diagonal@Reverse[a, 2]}, {a, Flatten[Partition[n, {4, 4}, 1], 1]}]
70600674

Problem 12

1
2

i = 1; NestWhile[(i++; # + i) &, 1, Length@Divisors@# <= 500 &]
76576500

Problem 13

1
2

FromDigits@Take[IntegerDigits@Total@nl, 10]
5537376230

Problem 14

Using memoized function:

1
2
3
4

f[1] = 1;
f[n_] := f[n] = If[EvenQ[n], f[n/2] + 1, f[3 n + 1] + 1];
Ordering[Table[f[i], {i, 1*^6}], -1]]//AbsoluteTiming
{27.099414, {837799}}

Using compiled function:

1
2
3
4
5
6
7

f=Compile[{ {top, _Integer} }, Module[{len, maxLen = 0, maxN = 0}, 
Do[len = 1;
     NestWhile[(len++; If[EvenQ@#, #~Quotient~2, 3 # + 1]) &, n, # != 1 &];
     If[len >  maxLen, {maxLen, maxN} = {len + Floor[Log[2, top/N[n]]],  n}], {n, 1, top, 2}];
    {maxLen, maxN}], CompilationTarget -> "C"];
f[10^6] // AbsoluteTiming
{5.010632, {525, 837799}}

Problem 15

memoized function way, comes along with heavy memory load and deeply-nested recursive calls.

1
2
3
4

f[0, n_] = f[m_, 0] = 1;
f[m_, n_] := f[m, n] = f[m - 1, n] + f[m, n - 1];
f[20, 20]
137846528820

In a m \(\times\) n grid, each path contains exactly n movements to the right ( R ) and m movements down (D). So here it is \({m+n \choose m}\)

1

Binomial[40, 20]

Problem 16

1
2

Total[IntegerDigits[2^1000]]
1366

Problem 17

inWords

1
2

StringReplace[StringJoin[inWords /@ Range[1000]],   " " -> ""] // StringLength
21124

Problem 18

1
2
3
4
5

d=Import["R:\\triangle.txt", "Table"];
f[Length[d], j_] := d[[Length[d], j]];
f[i_, j_] := f[i, j] = d[[i, j]] + Max[f[i + 1, j], f[i + 1, j + 1]];
f[1, 1]
1074

or using patterns to calculate bottom-up

1

d //. {x___, a_, b_} :> {x, a + Max /@ Partition[b, 2, 1]}

Problem 19

1
2

Count[DateRange[{1901, 1}, {2000, 12}, "Month"],d_ /; DayName@d == Sunday]
171

Problem 20

1
2

Total@IntegerDigits@Factorial@100
648