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.

Brute force solution at first thought:

1 2	[email protected][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, [email protected]# <= 4*^6 &] - 1
[email protected][Array[Fibonacci,n] ,  EvenQ]
4613732

Even numbers appear every 3rd positions in Fibonacci series:

1	[email protected][[email protected], {i, 3, n, 3}]

Problem 3

1
2

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

Problem 4

1 2	[email protected][If[[email protected]@[email protected]# == #, Throw[#]] &, [email protected]@[email protected][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

[email protected][{[email protected]@@a, [email protected]@[email protected], [email protected]@@[email protected], [email protected]@[email protected][a, 2]}, {a, Flatten[Partition[n, {4, 4}, 1], 1]}]
70600674

Problem 12

1 2	i = 1; NestWhile[(i++; # + i) &, 1, [email protected]@# <= 500 &] 76576500

Problem 13

1 2	[email protected][[email protected]@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[[email protected]#, #~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_ /; [email protected] == Sunday] 171

Problem 20

1 2	[email protected]@[email protected] 648

dive into project euler part 1 (1 Problem 2 Problem 3 Problem 4 Problem 5 Problem 6 Problem 7 Problem 8 Problem 9 Problem 10 Problem 11 Problem 12 Problem 13 Problem 14 Problem 15 Problem 16 Problem 17 Problem 18 Problem 19 Problem 20