(*
   The first 50 Project Euler problems in Mathematica.

   See http://projecteuler.net/

   Run this from the command line: 
      $ math -script euler.m 

   Also, see my Project Euler page for implementations in other
   programming languages: 
   http://hakank.org/project_euler/


   TODO: Problems that takes more than 1s:
   - Problem 14: ~7s
   - Problem 23: ~12s
   - Problem 27: ~20s
   - Problem 32: ~4s
   - Problem 35; ~5s
   - Problem 36: ~2s
   - Problem 37: ~2s
   - Problem 39: ~13s
   . Problem 43: ~25s
   - Problem 44: ~10s



   Created by Hakan Kjellerstrand (hakank@gmail.com)
   See my Mathematica page: http://hakank.org/mathematica/

*)

(* The solutions for the first 50 problems *)
solutions := <|
  1->233168,
  2->4613732,
  3->6857,
  4->906609,
  5->232792560,
  6->25164150,
  7->104743,
  8->40824,
  9->31875000,
  10->142913828922,
  11->70600674,
  12->76576500,
  13->5537376230,
  14->837799,
  15->137846528820,
  16->1366,
  17->21124,
  18->1074,
  19->171,
  20->648,
  21->31626,
  22->871198282,
  23->4179871,
  24->2783915460,
  25->4782,
  26->983,
  27->-59231,
  28->669171001,
  29->9183,
  30->443839,
  31->73682,
  32->45228,
  33->100,
  34->40730,
  35->55,
  36->872187,
  37->748317,
  38->932718654,
  39->840,
  40->210,
  41->7652413,
  42->162,
  43->16695334890,
  44->5482660,
  45->1533776805,
  46->5777,
  47->134043,
  48->9110846700,
  49->296962999629,
  50->997651
|>;


(*
  Run a program and check the solution.

  Returns {answer, time, correctQ)
*)
  
(* Some globals to be printed after the run *)
numCorrect = 0;
numFailed = 0;
times = Association[];  
totalTime = 0;
failed = Association[];
checkSolution[program_] := Module[{problem, solution, time, answer, isCorrect,retString, timeStr},
  Print["\nRunning ", program];     
  problem = StringCases[ToString@program, NumberString] // First;
  solution = ToString@solutions[FromDigits[problem]];
  {time, answer} = AbsoluteTiming[ToExpression[program][]];
  totalTime += time;    
  timeStr = StringJoin[If[time > #, "!", ""] & /@ {1, 2, 5, 10, 20}, ""];
  isCorrect = StringMatchQ[ToString@answer, solution];
  retString = If[isCorrect,"OK","should be " ~~ solution];
  If[isCorrect,
     numCorrect++,
     numFailed++;failed[problem] = {"answer:", answer, "should be:", solution}];
  times[problem] = {time,answer,retString,timeStr};  
  Print[times[problem]]
]


  
(*
  Problem 1
  """
  If we list all the natural numbers below 10 that are multiples of 3 or 5, 
  we get 3, 5, 6 and 9. The sum of these multiples is 23.
  Find the sum of all the multiples of 3 or 5 below 1000.
  """

*)

(* 0.000924s *)
euler1[] := Total@Select[Range[999],Mod[#,3]==0||Mod[#,5]==0&]

(* 0.000911s *)
euler1b[]:= Total@Select[Range[999],#~Mod~3==0||#~Mod~5==0&]

(* 0.000971s  *)
euler1c[]:= Total@(Select[r = Range[999], #~Mod~3 == 0 &] 
                   ~ Union ~ 
                   Select[r, #~Mod~5 == 0 &])

(* 0.001154s *)
euler1d[] := GatherBy[Range[999],Mod[#,3]>0&&Mod[#,5]>0&][[2]]//Total;

(* shorter
  0.00002s *)
euler1e[] := Union[Range[3,999,3],Range[5,999,5]]//Total;

(* variant
 0.000013s *)
euler1f[] := Total@(Range[3,999,3]~Union~Range[5,999,5]);

checkSolution[euler1f];


(*

  Problem 2
  """
  Each new term in the Fibonacci sequence is generated by adding the 
  previous two terms. By starting with 1 and 2, the first 10 terms will be:

  1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...

  Find the sum of all the even-valued terms in the sequence which do not 
  exceed four million.
  """

*)

(* 0.000492s *)
euler2[] := Total@ Select[Fibonacci[#] &@Range[100], # < 4000000 && Mod[#, 2] == 0 &]
checkSolution[euler2];
  
(*
  Problem 3
  """
  The prime factors of 13195 are 5, 7, 13 and 29.
  What is the largest prime factor of the number 600851475143 ?
  """

*)

(* 0.000871s *)
euler3[] := First@Last@FactorInteger[600851475143]
checkSolution[euler3];

(*
  Problem 4
  """
  A palindromic number reads the same both ways. The largest palindrome made 
  from the product of two 2-digit numbers is 9009 = 91 × 99.

  Find the largest palindrome made from the product of two 3-digit numbers.
  """


*)

(* 0.407968s *)
palindromicQ[n_Integer,base_:10] := (x = IntegerDigits[n,base]) == Reverse[x];  
euler4[] := Block[{},
              Select[Table[i*j, {i, 100, 999}, {j, i, 999}] // Flatten // DeleteDuplicates, palindromicQ] // Max
            ];

(* Without the help function *)
(* 0.360599s *)
euler4b[] := Block[{x},Select[Table[i*j, {i, 100, 999}, {j, i, 999}] // Flatten // 
             DeleteDuplicates, (x = IntegerDigits[#]) == Reverse[x] &] // Max
             ]
checkSolution[euler4b];
  
(*
  Problem 5
  """
  2520 is the smallest number that can be divided by each of the numbers 
  from 1 to 10 without any remainder.

  What is the smallest number that is evenly divisible by all of the numbers 
  from 1 to 20?
  """

*)
(* 0.000023s *)
euler5[] := Fold[LCM[#1,#2]&,Range[20]]
checkSolution[euler5];

(*

  Problem 6
  """
  The sum of the squares of the first ten natural numbers is,
  1^(2) + 2^(2) + ... + 10^(2) = 385

  The square of the sum of the first ten natural numbers is,
  (1 + 2 + ... + 10)^(2) = 55^(2) = 3025

  Hence the difference between the sum of the squares of the first ten 
  natural numbers and the square of the sum is 3025 − 385 = 2640.

  Find the difference between the sum of the squares of the first one 
  hundred natural numbers and the square of the sum.
   """

*)
(* 0.00012s *)
euler6[] := Block[{r},Total@(r=Range[100])^2-Total@(#^2&/@ r)]

(* shorter
  0.000023s *)
euler6b[] := Block[{r=Range[100]},Total[r]^2-Total[r^2]];

checkSolution[euler6b];

(*

  Problem 7
  """
  By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see 
  that the 6^(th) prime is 13.

  What is the 10001^(st) prime number?
  """

*)
(* 0.000121s *)
euler7[] := Prime[10001]
checkSolution[euler7];  

(*
  Problem 8:
  """
  Find the greatest product of five consecutive digits in the 
  1000-digit number.
  ...
  """



*)

euler8a[] := Block[{a = {},i,c = Characters[
   n = "731671765313306249192251196744265747423553491949349698352031277\
4506326239578318016984801869478851843858615607891129494954595017379583\
3195285320880551112540698747158523863050715693290963295227443043557668\
9664895044524452316173185640309871112172238311362229893423380308135336\
2766142828064444866452387493035890729629049156044077239071381051585930\
7960866701724271218839987979087922749219016997208880937766572733300105\
3367881220235421809751254540594752243525849077116705560136048395864467\
0632441572215539753697817977846174064955149290862569321978468622482839\
7224137565705605749026140797296865241453510047482166370484403199890008\
8952434506585412275886668811642717147992444292823086346567481391912316\
2824586178664583591245665294765456828489128831426076900422421902267105\
5626321111109370544217506941658960408071984038509624554443629812309878\
7992724428490918884580156166097919133875499200524063689912560717606058\
8611646710940507754100225698315520005593572972571636269561882670428252\
483600823257530420752963450"]},
         For[i = 1, i <= Length[c] - 4, i++,
           AppendTo[a, FromDigits[#] & /@ c[[i;;i+4]]]
         ];
         Map[Fold[Times, #] &, a] // Max
       ]

(* Neater using Partition *)
(* 0.000774s *)
euler8[] := Block[{c = Characters[
   n = "731671765313306249192251196744265747423553491949349698352031277\
4506326239578318016984801869478851843858615607891129494954595017379583\
3195285320880551112540698747158523863050715693290963295227443043557668\
9664895044524452316173185640309871112172238311362229893423380308135336\
2766142828064444866452387493035890729629049156044077239071381051585930\
7960866701724271218839987979087922749219016997208880937766572733300105\
3367881220235421809751254540594752243525849077116705560136048395864467\
0632441572215539753697817977846174064955149290862569321978468622482839\
7224137565705605749026140797296865241453510047482166370484403199890008\
8952434506585412275886668811642717147992444292823086346567481391912316\
2824586178664583591245665294765456828489128831426076900422421902267105\
5626321111109370544217506941658960408071984038509624554443629812309878\
7992724428490918884580156166097919133875499200524063689912560717606058\
8611646710940507754100225698315520005593572972571636269561882670428252\
483600823257530420752963450"]},
       Map[Times @@#&, Partition[FromDigits[#] & /@ c,5,1]]//Max
       ]

checkSolution[euler8];


  
(*
  Problem 9
  """
  A Pythagorean triplet is a set of three natural numbers, a  b  c, for which,
  a^2 + b^2 = c^2

  For example, 3^2 + 4^2 = 9 + 16 = 25 = 5^2.

  There exists exactly one Pythagorean triplet for which a + b + c = 1000.
  Find the product abc.
  """



*)
(* 0.00429s *)
isPythQ[a_, b_, c_] := a^2 + b^2 == c^2;
euler9[] := Block[{n = 1000,c = b = 0},
               For[c = 1, c <= Ceiling[n - c/2], c++,   
                For[b = c, b >= Round[n - c/2] - c, b--,
                  If[n - b - c > 0 && isPythQ[n - b - c, b, c], 
                    (* Return[{n - b - c, b, c, (n - b - c)*b*c}] *)
                    Return[(n - b - c)*b*c]
                  ]
                ]
              ]
   ];
checkSolution[euler9];

(*

  Problem 10
  """ 
  The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
  
  Find the sum of all the primes below two million.
  """

*)
(* 0.808956s *)
euler10[] := Total@Select[Range[2000000], PrimeQ[#]&]
checkSolution[euler10];

  
(*
  Problem 11
  """
  In the 2020 grid below, four numbers along a diagonal line have 
  been marked in red.

  ...

  The product of these numbers is 26 x 63 x 78 x 14 = 1788696.

  What is the greatest product of four adjacent numbers in any direction 
  (up, down, left, right, or diagonally) in the 20 x 20 grid?
  """


*)
(* 0.001664s *)
runningProd[lis_] := Fold[Times,lis];
euler11[] := Block[{m,len,m1,m2,m3,m4},
                m= {{08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08},
                   {49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00},
                   {81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,03,49,13,36,65},
                   {52,70,95,23,04,60,11,42,69,24,68,56,01,32,56,71,37,02,36,91},
                   {22,31,16,71,51,67,63,89,41,92,36,54,22,40,40,28,66,33,13,80},
                   {24,47,32,60,99,03,45,02,44,75,33,53,78,36,84,20,35,17,12,50},
                   {32,98,81,28,64,23,67,10,26,38,40,67,59,54,70,66,18,38,64,70},
                   {67,26,20,68,02,62,12,20,95,63,94,39,63,08,40,91,66,49,94,21},
                   {24,55,58,05,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72},
                   {21,36,23,09,75,00,76,44,20,45,35,14,00,61,33,97,34,31,33,95},
                   {78,17,53,28,22,75,31,67,15,94,03,80,04,62,16,14,09,53,56,92},
                   {16,39,05,42,96,35,31,47,55,58,88,24,00,17,54,24,36,29,85,57},
                   {86,56,00,48,35,71,89,07,05,44,44,37,44,60,21,58,51,54,17,58},
                   {19,80,81,68,05,94,47,69,28,73,92,13,86,52,17,77,04,89,55,40},
                   {04,52,08,83,97,35,99,16,07,97,57,32,16,26,26,79,33,27,98,66},
                   {88,36,68,87,57,62,20,72,03,46,33,67,46,55,12,32,63,93,53,69},
                   {04,42,16,73,38,25,39,11,24,94,72,18,08,46,29,32,40,62,76,36},
                   {20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,04,36,16},
                   {20,73,35,29,78,31,90,01,74,31,49,71,48,86,81,16,23,57,05,54},
                   {01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48}};
                   len = Length[m];
                   m1 = Flatten[Map[runningProd,Partition[#,4,1]] & /@ m]//Max;
                   m2 = Flatten[Map[runningProd,Partition[#,4,1]] & /@ Transpose@m]//Max;
                   m3 = Map[runningProd,Partition[Diagonal[m,#],4,1]] & /@ Range[-len,len]//Flatten//Max;
                   m4 = Map[runningProd,Partition[Diagonal[Reverse@m,#],4,1]] & /@ Range[-len,len]//Flatten//Max;
                   Max[{m1,m2,m3,m4}]
             ];
checkSolution[euler10];
  
(*
  Problem 12
  """
  The sequence of triangle numbers is generated by adding the natural numbers. 
  So the 7th triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. 
  The first ten terms would be:

  1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

  Let us list the factors of the first seven triangle numbers:

       1: 1
       3: 1,3
       6: 1,2,3,6
      10: 1,2,5,10
      15: 1,3,5,15
      21: 1,3,7,21
      28: 1,2,4,7,14,28

  We can see that the 7th triangle number, 28, is the first triangle number 
  to have over five divisors.

  Which is the first triangle number to have over five-hundred divisors?")
  """


*)
triangleNumber[n_Integer] := Fold[Plus, Range[n]]
(* slow: 4s *)
(*
euler12[] := Block[{i=1,t=0},
          While[Length[Divisors[t = triangleNumber[i]]] <= 500, i++];
          {"t:",t, " i: ", i}
          ]
euler12[]
*)

(* Simpler and much faster *)
(* 0.082526s *)
euler12b[] := Block[{t = 0,i = 1},
           While[Length[Divisors[t = t + i]] <= 500, i++];
           t
           ]

(* 0.082626s *)
(* Slightly different version, putting i++ inside the body *)
euler12c[] := Block[{t = 0,i = 0},
           While[Length[Divisors[t = t + i++]] <= 500];
           t
           ]
checkSolution[euler12c];


(*

  Problem 13
  """ 
  Work out the first ten digits of the sum of the following 
  one-hundred 50-digit numbers.
    37107287533902102798797998220837590246510135740250
    ....
    20849603980134001723930671666823555245252804609722
    53503534226472524250874054075591789781264330331690")
  """

*)
(* 0.053596s *)
euler13[] := StringTake[
              IntegerString[
                Total@(FromDigits[#] & /@ 
                  StringSplit[
                        Import["euler_project_problem13_string.txt"]])], 10]
checkSolution[euler13];

(*
  Problem 14
  """
  The following iterative sequence is defined for the set of positive integers:

  n n/2 (n is even)
  n 3n + 1 (n is odd)

  Using the rule above and starting with 13, we generate the following 
  sequence:
  13 40 20 10 5 16 8 4 2 1

  It can be seen that this sequence (starting at 13 and finishing at 1) 
  contains 
  10 terms. Although it has not been proved yet (Collatz Problem), it is 
  thought that all starting numbers finish at 1.

  Which starting number, under one million, produces the longest chain?

  NOTE: Once the chain starts the terms are allowed to go above one million.)
  """


*)

(* 
   Memoization is done by the construct: Collatz[n_] :=  Collatz[n] = ....  
   Though it takes a lot of memory...
*)

(*
collatz[n_] := collatz[n] = If[Mod[n, 2] == 0, n / 2, 3 n + 1];
(* collatzLength[n_] := collatzLength[n] = Length[NestWhileList[collatz[#] &, n, # != 1 &]]; *)
collatzLength[n_] := Length[NestWhileList[collatz[#] &, n, # != 1 &]];

(* alternative versions, using FixedPointList for the length. *)
collatz2[1] := 1 (* base case, the stopping criteria *)
collatz2[n_] := collatz2[n] = If[Mod[n, 2] == 0, n / 2, 3 n + 1];
collatzLength2[n_] := Length[FixedPointList[collatz2 , n]] - 1
collatzLength3[n_] := Length[Most@NestWhileList[collatz, n, Unequal, All]]
collatzList[n_] := Most@NestWhileList[If[Mod[#, 2] == 0, #/2, 3 # + 1] &, n, Unequal, All]

euler14Slow[] := Block[{maxlen, maxn, len, i},
          Print["This will take some time ..."]
          maxlen = 0;maxn = 0; len = 0;
          For[i = 2, i < 1000000, i++, 
               len = collatzLength[i];
               If[len > maxlen, maxlen = len; maxn = i]
          ];
          (* {maxlen, maxn} *)
          maxn           
        ];
*)

(* with caching it's faster, but still slow... *)
collatzLength[1] = 1;
collatzLength[2] = 2;
collatzLength[n_] := collatzLength[n] = 1+If[Mod[n, 2] == 0, 
                                             collatzLength[n/2], 
                                             collatzLength[3 n + 1]];


(* 27s *)
(* euler14[] := Sort[{#, collatzLength[#]} & /@ Range[10^6], #1[[2]] > #2[[2]] &][[1]]  *)

(* 7.985297s
   Not surprisingly, the calculation of the lengths takes most of the time: ~7.8s
   The MaximalBy take about 0.15s
 *)
euler14[] := MaximalBy[{#, collatzLength[#]} & /@ Range[10^6], #[[2]]&]//First//First ;
checkSolution[euler14];
  
(* Remove the cached values: *)
Clear[collatzLength];



(*
  Problem 15
  """
  Starting in the top left corner of a 2×2 grid, there are 6 routes 
  (without backtracking) to the bottom right corner.
  
  How many routes are there through a 20×20 grid?
  """


*)
(* 0.000062s *)
euler15[] := (Times@@Range[21, 40])/(Times@@Range[2, 20])
checkSolution[euler15];

  
(*

  Problem 16
  """
  2^15 = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.
  
  What is the sum of the digits of the number 2^1000?
  """

*)
(* 0.000026s *)
euler16[] := Total@IntegerDigits[2^1000]
checkSolution[euler16];

(*

 Problem 17:
 """
  If the numbers 1 to 5 are written out in words: one, two, three, four, five, 
  then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
  
  If all the numbers from 1 to 1000 (one thousand) inclusive were written out in 
  words, how many letters would be used?
  
  NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) 
  contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of 
  "and" when writing out numbers is in compliance with British usage.
  """

*)

(* This is borrowed from 
http://mathematica.stackexchange.com/questions/1065/how-to-express-an-integer-number-in-english-words *)
(* 0.080483s *)
inWords[n_] := 
  Module[{r, 
    numNames = {"", " one", " two", " three", " four", " five", 
      " six", " seven", " eight", " nine"}, 
    teenNames = {" ten", " eleven", " twelve", " thirteen", 
      " fourteen", " fifteen", " sixteen", " seventeen", " eighteen", 
      " nineteen"}, 
    tensNames = {"", " ten", " twenty", " thirty", " forty", " fifty",
       " sixty", " seventy", " eighty", " ninety"}, 
    decimals = {"", " thousand", " million", " billion", " trillion", 
      " quadrillion", " quintillion", " sextillion", " septillion", 
      " octillion", " nonillion", " decillion", " undecillion", 
      " duodecillion", " tredecillion", " quattuordecillion", 
      " quindecillion", " sexdecillion", " septendecillion", 
      " octodecillion", " Novemdecillion", " Vigintillion", 
      " 66illion", " 69illion"}}, 
   r = If[# != 0, 
        numNames[[# + 1]] <> " hundred" <> 
         If[#2 != 0 || #3 != 0, " and", ""], ""] <> 
       Switch[#2, 0, numNames[[#3 + 1]], 1, teenNames[[#3 + 1]], _, 
        tensNames[[#2 + 1]] <> numNames[[#3 + 1]]] & @@@ (PadLeft[
         FromDigits /@ Characters@StringReverse@#, 3] & /@ 
       StringCases[StringReverse@IntegerString@n, 
        RegularExpression["\\d{1,3}"]]);
   StringJoin@
    Reverse@MapThread[
      If[# != "", StringJoin[##], ""] &, {r, 
       Take[decimals, Length@r]}]];

euler17[] := StringJoin[Map[inWords[#] &, Range[1000]], ""] // 
             StringReplace[#, RegularExpression[" |-"] -> ""] & // StringSplit[#, ""] & // Length
  
(* Nope: IntegerName[999] give "nine hundred ninety‐nine" not "nine hundred and ninety‐nine" *)
(*
euler17b[] := StringReplace[StringJoin[IntegerName[Range[1000],"Words"],""],{"\[Hyphen]"->""," "->""}]//Characters// Length
  *)
  
checkSolution[euler17];

(*

 """
  By starting at the top of the triangle below and moving to adjacent 
  numbers on the row below, the maximum total from top to bottom is 23.

  3
  7 4
  2 4 6
  8 5 9 3

  That is, 3 + 7 + 4 + 9 = 23.

  Find the maximum total from top to bottom of the triangle below:

   75
   95 64
   17 47 82
   18 35 87 10
   20 04 82 47 65
   19 01 23 75 03 34
   88 02 77 73 07 63 67
   99 65 04 28 06 16 70 92
   41 41 26 56 83 40 80 70 33
   41 48 72 33 47 32 37 16 94 29
   53 71 44 65 25 43 91 52 97 51 14
   70 11 33 28 77 73 17 78 39 68 17 57
   91 71 52 38 17 14 91 43 58 50 27 29 48
   63 66 04 68 89 53 67 30 73 16 69 87 40 31
   04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

  NOTE: As there are only 16384 routes, it is possible to solve this problem 
  by trying every route. However, Problem 67, is the same challenge with a 
  triangle containing one-hundred rows; it cannot be solved by brute force, 
  and requires a clever method! ;o)
  """

*)

(* Using dynamic programming *)
(* 0.000388s *)
euler18[] := Block[{t},t = FromDigits[#] & /@ StringSplit[#] & /@ 
                 StringSplit[
                 "75\n95 64\n17 47 82\n18 35 87 10\n20 04 82 47 65\n19 01 23 75 03 \
                 34\n88 02 77 73 07 63 67\n99 65 04 28 06 16 70 92\n41 41 26 56 83 40 \
                 80 70 33\n41 48 72 33 47 32 37 16 94 29\n53 71 44 65 25 43 91 52 97 \
                 51 14\n70 11 33 28 77 73 17 78 39 68 17 57\n91 71 52 38 17 14 91 43 \
                 58 50 27 29 48\n63 66 04 68 89 53 67 30 73 16 69 87 40 31\n04 62 98 \
                 27 23 09 70 98 73 93 38 53 60 04 23", "\n"];
                 For[i = Length[t] - 1, i >= 0, i--,
                    For[j = 1, j <= i, j++,
                   t[[i, j]] = t[[i, j]] + Max[t[[i + 1, j]], t[[i + 1, j + 1]]]
                 ]
                ];
               t[[1, 1]]
             ]
checkSolution[euler18];

(*

  Problem 19:
  """
  You are given the following information, but you may prefer 
  to do some research for yourself.

  * 1 Jan 1900 was a Monday.
  * Thirty days has September,
    April, June and November.
    All the rest have thirty-one,
    Saving February alone,
    Which has twenty-eight, rain or shine.
    And on leap years, twenty-nine.
  * A leap year occurs on any year evenly divisible by 4, but not 
    on a century unless it is divisible by 400.
  
  How many Sundays fell on the first of the month during the 
  twentieth century (1 Jan 1901 to 31 Dec 2000)?
  """

*)
(* 0.71313 *)
euler19[] := Block[{},
        Select[DateRange[DateList[{1901, 1, 1}], 
         DateList[{2000, 12, 31}], {1, "Month"}], 
         DateString[#, "DayName"] == "Sunday" &] // Length
         ]
checkSolution[euler19];

(*
  Problem 20
  """
  n! means n (n 1) ... 3 2 1

  Find the sum of the digits in the number 100!")
  """


*)
(* 0.000046s *)
euler20[] := Total@IntegerDigits[100!]
checkSolution[euler20];

(*

  Problem 21
  """
  Let d(n) be defined as the sum of proper divisors of n (numbers less 
  than n which divide evenly into n).
  If d(a) = b and d(b) = a, where a /= b, then a and b are an amicable 
  pair and each of a and b are called amicable numbers.
  
  For example, the proper divisors of 220 are 
  1, 2, 4, 5, 10, 11, 20, 22, 44, 55 and 110; therefore d(220) = 284. 
  The proper divisors of 284 are 1, 2, 4, 71 and 142; so d(284) = 220.
  
  Evaluate the sum of all the amicable numbers under 10000.
  """

*)
(* 0.096746s *)
divisorSum[n_] := Total@Most@Divisors@n;
amicableQ[n_] := Block[{m=divisorSum[n]}, n != m && divisorSum[m] == n];
euler21[] := Select[Range[2,9999],amicableQ]//Total;
checkSolution[euler21];


  
(*

  Problem 22:
  """
  Using names.txt (right click and 'Save Link/Target As...'), a 46K 
  text file containing over five-thousand first names, begin by sorting 
  it into alphabetical order. Then working out the alphabetical value 
  for each name, multiply this value by its alphabetical position in the 
  list to obtain a name score.

  For example, when the list is sorted into alphabetical order, COLIN, 
  which is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in 
  the list. So, COLIN would obtain a score of 938 53 = 49714.

  What is the total of all the name scores in the file?")
  """

*)
(* 0.020629s *)
euler22[] := Block[{names},
          names=Sort@StringSplit[
             (* StringReplace[Import["http://projecteuler.net/project/names.txt"],  *)
             StringReplace[Import["euler22_names.txt"], 
             "\"" -> ""], ","];
          Total@MapIndexed[Last[#2]*Total[(ToCharacterCode[#1] - 64)] &, names]
          ];
checkSolution[euler22];

(*
  Problem 23:
  """
  A perfect number is a number for which the sum of its proper divisors 
  is exactly equal to the number. For example, the sum of the proper divisors 
  of 28 would be 1 + 2 + 4 + 7 + 14 = 28, which means that 28 is a perfect number.

  A number n is called deficient if the sum of its proper divisors is less than 
  n and it is called abundant if this sum exceeds n.

  As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest number 
  that can be written as the sum of two abundant numbers is 24. By mathematical 
  analysis, it can be shown that all integers greater than 28123 can be written 
  as the sum of two abundant numbers. However, this upper limit cannot be reduced 
  any further by analysis even though it is known that the greatest number that 
  cannot be expressed as the sum of two abundant numbers is less than this limit.

  Find the sum of all the positive integers which cannot be written as the sum of 
  two abundant numbers.
  """ 

*)
(* slow: 11.713443,s *)
euler23[] := Block[{limit=20161,arr=Table[1,20161],abundant,abLen,i,j,abi,abj,pos},
               For[i = 2, i <= limit,i++,
                  For[j=i*2, j <= limit, j+=i, arr[[j]] += i ]
               ];
             abundant = Select[Range[12,limit], arr[[#]] > #&];
             abLen = Length[abundant];
             For[i = 1, i <= abLen, i++,
                abi=abundant[[i]];
                For[j = i, j <= abLen, j++,
                  abj=abundant[[j]];
                  If[abi+abj < limit, 
                     arr[[ abi+abj ]] = 0,
                     Break[]
                    ]
                ]
             ];
             Select[Range[limit],arr[[#]] != 0 &]//Total
             ];
checkSolution[euler23];

(*
  Problem 24:
  """
  A permutation is an ordered arrangement of objects. For example, 3124 is one 
  possible permutation of the digits 1, 2, 3 and 4. If all of the permutations are 
  listed numerically or alphabetically, we call it lexicographic order. The 
  lexicographic permutations of 0, 1 and 2 are:
   
      012   021   102   120   201   210
  
  What is the millionth lexicographic permutation of the digits 
  0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?
  """ 


*)
(* 0.120952s *)
euler24[] := FromDigits[Permutations[Range[0,9]][[10^6]]]
checkSolution[euler24];

(*
  Problem 25:
  """
  The Fibonacci sequence is defined by the recurrence relation:

     Fn = Fn1 + Fn2, where F1 = 1 and F2 = 1.
  
  Hence the first 12 terms will be:

     F1 = 1
     F2 = 1
     F3 = 2
     F4 = 3
     F5 = 5
     F6 = 8
     F7 = 13
     F8 = 21
     F9 = 34
     F10 = 55
     F11 = 89
     F12 = 144

  The 12th term, F12, is the first term to contain three digits.

  What is the first term in the Fibonacci sequence to contain 1000 digits?")
  """


*)
(* 0.058845s *)
euler25[] := Block[{i = 1,f = 1},
          While[Length[IntegerDigits[f]]<1000,f=Fibonacci[i++]];
          i - 1
          ];
checkSolution[euler25];

(*

  Problem 26:
  """
  A unit fraction contains 1 in the numerator. The decimal representation of the 
  unit fractions with denominators 2 to 10 are given:

      1/2	= 	0.5
      1/3	= 	0.(3)
      1/4	= 	0.25
      1/5	= 	0.2
      1/6	= 	0.1(6)
      1/7	= 	0.(142857)
      1/8	= 	0.125
      1/9	= 	0.(1)
      1/10	= 	0.1

  Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be 
  seen that 1/7 has a 6-digit recurring cycle.

  Find the value of d < 1000 for which 1/d contains the longest recurring cycle in 
  its decimal fraction part.
  """ 


*)
(* 0.01251s *)
euler26[] := Block[{m,l},
          m = Max[l = Map[Length[Flatten@First@RealDigits[1/#]] &, Range[1000]]];
          Position[l, m][[1, 1]]
          ];
checkSolution[euler26];

(*
  Problem 27:
  """
  Euler published the remarkable quadratic formula:

  n^2 + n + 41

  It turns out that the formula will produce 40 primes for the consecutive values 
  n = 0 to 39. However, when n = 40, 402 + 40 + 41 = 40(40 + 1) + 41 is divisible by 
  41, and certainly when n = 41, 41^2 + 41 + 41 is clearly divisible by 41.

  Using computers, the incredible formula  n^2 − 79n + 1601 was discovered, which 
  produces 80 primes for the consecutive values n = 0 to 79. The product of the 
  coefficients, −79 and 1601, is −126479.

  Considering quadratics of the form:

      n^2 + an + b, where |a| < 1000 and |b| < 1000

      where |n| is the modulus/absolute value of n
      e.g. |11| = 11 and |−4| = 4

  Find the product of the coefficients, a and b, for the quadratic 
  expression that produces the maximum number of primes for consecutive 
  values of n, starting with n = 0.
  
  """ 


*)
(* 20.330908s, it's faster without caching the primes *)
(* primeQCached[N_] := primeQCached[N] = PrimeQ[N]; *)
p27[A_,B_] := p27[A,B] = Block[{N1,PP},
                  N1 = 0;
                  PP = N1^2 + A*N1 + B;
                  While[PP > 1 && PrimeQ[PP],
                        N1++;
                        PP = N1^2 + A*N1 + B;
                       ];
                  N1
                  ];
euler27[] := Block[{T = 999,BestLen = 0,BestA = 0,BestB = 0, A, B},
          For[A = -T, A <= T, A++,
             For[B = -T, B <= T, B++,
               Len = p27[A,B];
               If[Len > BestLen,
                  BestLen = Len;
                  BestA = A;
                  BestB = B]
             ]
          ];
          BestA*BestB
         ];

checkSolution[euler27];
Clear[primeQCached];


(*
  Problem 28
  """
  Starting with the number 1 and moving to the right in a clockwise 
  direction a 5 by 5 spiral is formed as follows:
  
     21 22 23 24 25
     20  7  8  9 10
     19  6  1  2 11
     18  5  4  3 12
     17 16 15 14 13

  It can be verified that the sum of the numbers on the diagonals is 101.
  
  What is the sum of the numbers on the diagonals in a 1001 by 1001 spiral formed in the same way?
  """


*)
(* 0.000147s *)
euler28[] := 1+Total@Map[4 #^2 - 6 # + 6 &, Range[3, 1001, 2]]
checkSolution[euler28];

(*
  Problem 29:
  """
  Consider all integer combinations of a^b for 2 <= a <= 5 and 2 <= b <= 5:

      2^2=4, 2^3=8, 2^4=16, 2^5=32
      3^2=9, 3^3=27, 3^4=81, 3^5=243
      4^2=16, 4^3=64, 4^4=256, 4^5=1024
      5^2=25, 5^3=125, 5^4=625, 5^5=3125

  If they are then placed in numerical order, with any repeats removed, we get the 
  following sequence of 15 distinct terms:

  4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125

  How many distinct terms are in the sequence generated by a^b for 
  2 <= a <= 100 and 2 <= b <= 100?
  """ 


*)
(* 0.033534s *)
euler29[] := Length@Union@Flatten@Table[a^b, {a, 2, 100}, {b, 2, 100}]
checkSolution[euler29];

(*
  Problem 30  
  """
  Surprisingly there are only three numbers that can be written 
  as the sum of fourth powers of their digits:

     1634 = 1^(4) + 6^(4) + 3^(4) + 4^(4)
     8208 = 8^(4) + 2^(4) + 0^(4) + 8^(4)
     9474 = 9^(4) + 4^(4) + 7^(4) + 4^(4)

  As 1 = 1^(4) is not a sum it is not included.

  The sum of these numbers is 1634 + 8208 + 9474 = 19316.

  Find the sum of all the numbers that can be written as the sum of 
  fifth powers of their digits.
  """


*)

(* 1.688892s *)
euler30[] := Total@Select[Range[10, 6 9^5], Total[Map[#1^5 &, IntegerDigits[#]]] ==  # &]

(* shorter and faster: 0.585599s *)
euler30b[] := Total@Select[Range[10, 6 9^5], Total[IntegerDigits[#]^5] == # &]
checkSolution[euler30b];

(*

  Problem 31
  """
  In England the currency is made up of pound, £, and pence, p, and 
  there are eight coins in general circulation:

     1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p).

  It is possible to make £2 in the following way:

     1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p

  How many different ways can £2 be made using any number of coins?
  """

*)

coins[_, _, 8] := 1;
coins[pcoins_, money_, m_] :=
 Module[{ssum, i},  
      ssum = 0;    
      For[i = m, i <= 8, i++,
        t = money - pcoins[[i]];
        ssum += 
    If[t == 0, 1, 0] + If[t > 0, coins[pcoins, t, i], 0] ;
      ]; 
       ssum
  ];
(* 0.628307s *)
euler31[] := coins[{200, 100, 50, 20, 10, 5, 2, 1}, 200, 1]

(* Solve the Diophantine equation *)
(* 0.247564s *)
euler31b[] := FrobeniusSolve[{200,100,50,20,10,5,2,1},200]//Length

checkSolution[euler31b];
  
(*
  Problem 32
  """
  We shall say that an n-digit number is pandigital if it makes use of 
  all the digits 1 to n exactly once; for example, the 5-digit number, 
  15234, is 1 through 5 pandigital.

  The product 7254 is unusual, as the identity, 39 × 186 = 7254, 
  containing multiplicand, multiplier, and product is 1 through 9 
  pandigital.

  Find the sum of all products whose multiplicand/multiplier/product 
  identity can be written as a 1 through 9 pandigital.
  HINT: Some products can be obtained in more than one way so be sure 
  to only include it once in your sum.
  """

*)

(* Translation of euler32d/0 in euler32.pi . Slow: 10.374325s *)
test32a[p_, pos_] := Module[{
   p1 = FromDigits[p[[1 ;; pos]]],
   p2 = FromDigits[p[[pos + 1 ;; 5]]],
   p3 = FromDigits[p[[6 ;; 9]]] 
   },
   If[p1*p2 == p3, map[p3] = 1];
  ];
euler32a := Module[{ps = Permutations@Range@9, map = Association[]},
  Table[ test32a[#, pos], {pos, 1, 4}] & /@ ps;
  Total@Keys@map
  ]

(* 3.795803s *)
euler32b[] := Module[{map, prod, l, sum = 0},
  map = Association[];
  Do[
   prod = a*b;
   l = IntegerDigits[{a, b, prod}] // Flatten;
   If[Length[l] == 9 && CountDistinct[l] == 9 
     && Not[MemberQ[l, 0]] && Not[KeyExistsQ[map, prod]] , 
    map[prod] = 1; sum += prod]
   ,
   {a, 2, 98}, {b, a + 1, 9876}];
  sum
  ]

(* 4.0s *)
euler32c[] := Module[{map, a, b, prod, sum = 0},
  map = Association[];
  For[a = 2,
         a <= 98,
         a++,
   For[b = a + 1,
    b <= 9876,
    b++,
    prod = a*b;
    l = IntegerDigits[{a, b, prod}] // Flatten;
    If[Length[l] == 9 && Not[MemberQ[l, 0]] && CountDistinct[l] == 9 && 
      Not[KeyExistsQ[map, prod]], 
     map[prod] = 1; sum += prod];
    
    ]];
  sum
  ]

(* 4.2s *)
euler32d[] := Module[{map, l, sum = 0},
  map = Association[];
  Table[{prod = a*b;
    l = IntegerDigits[{a, b, prod}] // Flatten;
    If[Length[l] == 9 && Not[MemberQ[l, 0]] && CountDistinct[l] == 9 && 
      Not[KeyExistsQ[map, prod]], 
     map[prod] = 1; sum += prod];
    },  {a, 2, 98}, {b, a + 1, 9876}];
  sum
  ]

(* 5.552017s *)
check32e[{a_, b_, prod_}] := 
 Module[{ds = IntegerDigits[{a, b, prod}] // Flatten},
  Length[ds] == 9 && CountDistinct[ds] == 9 && Min[ds] == 1
  ]
euler32e[] := Module[{t, a, b, prod},
  t = Flatten[Table[{a, b, prod = a*b},  {a, 2, 98}, {b, a + 1, 9876}], 1];
  Select[t, check32e][[All, 3]] // DeleteDuplicates // Total
]
checkSolution[euler32b];

(*
  Problem 33:
  """
  The fraction 49/98 is a curious fraction, as an inexperienced mathematician in 
  attempting to simplify it may incorrectly believe that 49/98 = 4/8, which is correct, 
  is obtained by cancelling the 9s.

  We shall consider fractions like, 30/50 = 3/5, to be trivial examples.

  There are exactly four non-trivial examples of this type of fraction, less than 
  one in value, and containing two digits in the numerator and denominator.

  If the product of these four fractions is given in its lowest common terms, find 
  the value of the denominator.
  """
*)
(* 0.00022s *)
euler33[] := Module[{t},
  t = Table[{y, z, x = 9.0*y*z/(10*y - z), s = y/z, 
      If[ x < 10.0 && 1.0*Floor[x] == x*1.0 && y/z < 1.0, True, False]},
     {y,1,9}, {z,y,9}] // Flatten[#, 1] &;
  1/(Times @@ Select[t, #[[5]] &][[All, 4]])
  ]
checkSolution[euler33];

(*
  Problem 34
  """
  145 is a curious number, as 1! + 4! + 5! = 1 + 24 + 120 = 145.
  
  Find the sum of all numbers which are equal to the sum of the 
  factorial of their digits.

  Note: as 1! = 1 and 2! = 2 are not sums they are not included.
  """


*)
(* 0.42299s *)
euler34[] := Total@Select[Range[10, 100000], Total@Map[#! &, IntegerDigits[#]] == # &]

(* shorter and slightly faster *)
(* 0.327988s *)
euler34b[] := Total@Select[Range[10, 100000], Total[IntegerDigits[#]!] == # &]
checkSolution[euler34b];
  
(*
  Problem 35
  """
  The number, 197, is called a circular prime because all rotations 
  of the digits: 197, 971, and 719, are themselves prime.

  There are thirteen such primes below 100: 
  2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, and 97.

  How many circular primes are there below one million?
  """
*)
(* 4.775333s *)
circularPrime[n_] := Module[{t, list, len},
  If[PrimeQ[n] ,
   list = IntegerDigits[n];
   len = Length[list];
   t = FromDigits[RotateLeft[list, #]] & /@ Range[len - 1];
   AllTrue[t, PrimeQ],
   False]
  ];
euler35[] := Module[{},
   CountsBy[Range@1000000, circularPrime][True]
   ];
checkSolution[euler35];


  
(*

  Problem 36
  """
  The decimal number, 585 = 1001001001_(2) (binary), is palindromic 
  in both bases.
  
  Find the sum of all numbers, less than one million, which are palindromic 
  in base 10 and base 2.

  (Please note that the palindromic number, in either base, may not 
   include leading zeros.)
  """

*)
(* 1.730402s *)
euler36[] := Total@Select[Range[999999], palindromicQ[#] && palindromicQ[#, 2] &]
checkSolution[euler36];

(*

  Problem 37:
  """
  The number 3797 has an interesting property. Being prime itself, it is possible to 
  continuously remove digits from left to right, and remain prime at each stage: 
  3797, 797, 97, and 7. Similarly we can work from right to left: 3797, 379, 37, and 3.

  Find the sum of the only eleven primes that are both truncatable from left to right 
  and right to left.

  NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes.

  """
*)
(* 2.13698s *)
truncabablePrime[n_] := Module[{t, list, len},
  list := IntegerDigits[n];
  len := Length[list];
  t = Flatten[{FromDigits@list[[1 ;; #]] & /@ Range[len - 1],
     FromDigits@list[[# ;; len]] & /@ Range[len]}];
  AllTrue[t, PrimeQ]
  ]
euler37[] := Module[{c,p,sum},
  c = 0;
  p = 11;
  sum = 0;
  While[c < 11,
    If[PrimeQ[p] && truncabablePrime[p], c++; sum += p];
    p += 2
  ];
  sum
];
checkSolution[euler37];

  
(*
  Problem 38
  """
  Take the number 192 and multiply it by each of 1, 2, and 3:

      192 × 1 = 192
      192 × 2 = 384
      192 × 3 = 576

  By concatenating each product we get the 1 to 9 pandigital, 
  192384576. We will call 192384576 the concatenated product of 192 
  and (1,2,3)

  The same can be achieved by starting with 9 and multiplying by 
  1, 2, 3, 4, and 5, giving the pandigital, 918273645, which is the 
  concatenated product of 9 and (1,2,3,4,5).

  What is the largest 1 to 9 pandigital 9-digit number that can be 
  formed as the concatenated product of an integer with 
  (1,2, ... , n) where n > 1?
  """

*)
(* 0.122371s *)
pandigital1to9[list_List] := Module[{},
   Length[list] == 9 && CountDistinct[list] == 9 && Min[list] == 1
   ];
check38[n_] := Module[{i = 2, s = IntegerDigits[n]},
  While[Length[s] < 9,
   s = Append[s, IntegerDigits[n*i]] // Flatten;
   i++
   ];
  If[Length[s] == 9 && pandigital1to9[s], FromDigits@s, False]
  ]
euler38[] := Module[{},
   Select[Table[check38[n] , {n, 9876, 9, -1}], IntegerQ] // Max
   ];
checkSolution[euler38];

  
(*

  Problem 39
  """
  If p is the perimeter of a right angle triangle with integral length sides, 
  {a,b,c}, there are exactly three solutions for p = 120.
   
  {20,48,52}, {24,45,51}, {30,40,50}
   
  For which value of p <= 1000, is the number of solutions maximised?
  """

*)

(* Very slow 20.014s *)
solve39[p_] := Module[{},
  Reduce[{a^2 + b^2 == c^2, a + b + c == p, a > 0, b > 0, c > 0, 
     a <= b <= c}, Integers] // Length
];
euler39[] := Module[{},
  MaximalBy[Table[{p, solve39[p]}, {p, 1, 1000}], Last]
  ]

(* A little faster: 12.987129s *)
check39b[{x_, y_}, squares_] := Module[{z, c},
  z = x + y;
  c = Round[Sqrt[x] + Sqrt[y] + Sqrt[z]];
  If[c <= 1000 && KeyExistsQ[squares, z],
                     c, Null]
];
euler39b[] := Module[{ns, squares, keys, t, t2, c},
  ns = Range[1000];
  squares = Association@Table[n^2 -> 1, {n, ns}];
  keys = Keys[squares];
  t = Select[
    Flatten[Table[{n1, n2}, {n1, keys}, {n2, keys}], 
     1], #[[1]] < #[[2]] &];
  t2 = DeleteCases[Table[check39b[n, squares], {n, t}], Null];
  c = Counts[t2];
  MaximalBy[c, Value]//Keys//First
];
checkSolution[euler39b];

(*
  Problem 40:
  """
  An irrational decimal fraction is created by concatenating the positive integers:
   
  0.123456789101112131415161718192021...
   
  It can be seen that the 12th digit of the fractional part is 1.

  If dn represents the nth digit of the fractional part, find the 
  value of the following expression.
  
  d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000
  """


*)
(* 0.208503s *)
euler40[] := Module[{d},
  d = IntegerDigits@Range[210000] // Flatten;
  Times @@ (d[[10^#]] & /@ Range[6])
];
checkSolution[euler40];

  
(*
  Problem 41:
  """
  We shall say that an n-digit number is pandigital if it makes use of all 
  the digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital 
  and is also prime.

  What is the largest n-digit pandigital prime that exists?
  """


*)
(* 0.026597s *)
pandigitalPrimes[len_] := Module[{},
  FromDigits[#] &  /@ 
   Select[Permutations[Range[len]], PrimeQ[FromDigits[#] ] &]
]
euler41[] := Module[{},
  Table[pandigitalPrimes[n], {n, 4, 7}] // Flatten // Max
]
checkSolution[euler41];


  
(*

  Problem 42:
  """
  The nth term of the sequence of triangle numbers is given by, 
      tn = 1/2*n*(n+1); 
  so the first ten triangle numbers are:

  1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

  By converting each letter in a word to a number corresponding to its 
  alphabetical position and adding these values we form a word value. For example, 
  the word value for SKY is 19 + 11 + 25 = 55 = t10. If the word value 
  is a triangle number then we shall call the word a triangle word.

  Using words.txt (right click and 'Save Link/Target As...'), a 16K text file 
  containing nearly two-thousand common English words, how many 
  are triangle words?
  """

*)

(* 0.026597s *)
euler42[] := Module[{triNums, file, words, map}, 
  triNums = Table[triangleNumber[n] -> True, {n, 1, 20}];
  file = "/home/hakank/mathematica_me/euler42_words.txt";
  words = StringSplit[StringDelete[Import[file], "\""], ","];
  map = Thread[ToUpperCase@Alphabet[] -> Range[26]];
  Counts[(Lookup[triNums, Total@ Characters@# /. map, False] & /@  
      words)][True]
];
checkSolution[euler42];

  
(*

  Problem 43
  """  
  The number, 1406357289, is a 0 to 9 pandigital number because it is made up of 
  each of the digits 0 to 9 in some order, but it also has a rather interesting 
  sub-string divisibility property.
  
  Let d1 be the 1st digit, d2 be the 2nd digit, and so on. In this way, we 
  note the following:
  
      * d2d3d4=406 is divisible by 2
      * d3d4d5=063 is divisible by 3
      * d4d5d6=635 is divisible by 5
      * d5d6d7=357 is divisible by 7
      * d6d7d8=572 is divisible by 11
      * d7d8d9=728 is divisible by 13
      * d8d9d10=289 is divisible by 17
  
  Find the sum of all 0 to 9 pandigital numbers with this property.
  """


*)
(* Slow: 24.378829s *)
(* It's faster with global primes43Small. *)
primes43Small = {Null, 2, 3, 5, 7, 11, 13, 17};
check43[p_] := Module[{i},
  For[i = 2, i <= 8,
   i++,
   If[Mod[FromDigits[p[[i ;; i + 2]]], primes43Small[[i]]] != 0, 
    Return[False]]
   ];
  True
]
euler43[] := Module[{ps, sols},
  ps = Permutations[Range[0, 9]];
  sols = Select[ps, check43];
  FromDigits /@ sols // Total
  ]
checkSolution[euler43];

(*
  Problem 44:
  """  
  Pentagonal numbers are generated by the formula, P(n)=n(3n−1)/2. 
  The first ten pentagonal numbers are:

  1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...

  It can be seen that P(4) + P(7) = 22 + 70 = 92 = P(8). However, 
  their difference,  70 − 22 = 48, is not pentagonal.

  Find the pair of pentagonal numbers, P(j) and P(k), for which their sum 
  and difference is pentagonal and D = |P(k) − P(j)| is minimised; what 
  is the value of D?  
  """


*)
(* 9.584067s. Note: Association speeds things up considerably!  *)
euler44[] := Module[{size, s, sKeys, d, a, b},
  size = 2500;
  s = Association@Table[(n*(3*n - 1) / 2) -> True, {n, 1, size}];
  sKeys = Keys[s];
  d = 10000000;
  Do[
   a = j + k; b = Abs[j - k];
   If[j < k && a < d && KeyExistsQ[s, a] && b < d && 
     KeyExistsQ[s, b],
    d = b],
   {j, sKeys}, {k, sKeys}];
  d
];
checkSolution[euler44];

  
(*

  Problem 45:
  """  
  Triangle, pentagonal, and hexagonal numbers are generated by the following formulae:

  Triangle 	  	Tn=n(n+1)/2 	  	1, 3, 6, 10, 15, ...
  Pentagonal 	  	Pn=n(3n−1)/2 	  	1, 5, 12, 22, 35, ...
  Hexagonal 	  	Hn=n(2n−1) 	  	1, 6, 15, 28, 45, ...

  It can be verified that T(285) = P(165) = H(143) = 40755.

  Find the next triangle number that is also pentagonal and hexagonal.
  """

*)
(* 0.210152s *)
pent[n_] := n (3 n - 1)/2
tri[n_] := n (n + 1) / 2
hex[n_] := n (2 n - 1)
(* 0.22ss *)
(* Monitor[While[... ]] is a great debugging tool! *)

euler45[] := Module[{t, tt, p, pp, h, hh},
  t = 285 + 1; p = 165; h = 143;
  tt = tri[t]; pp = pent[p]; hh = hex[h];
  While[(tt != pp || pp != hh) ,
   t++; tt = tri[t]; 
   If[tt > pp, p++; pp = pent[p]];
   If[pp > hh, h++; hh = hex[h]];
   If[tt > hh, h++; hh = hex[h]]
   ];
  tt
]
checkSolution[euler45];
  
(*
  Problem 46:
  """  
  It was proposed by Christian Goldbach that every odd composite number can be 
  written as the sum of a prime and twice a square.

  9 = 7 + 2×1^2
  15 = 7 + 2×2^2
  21 = 3 + 2×3^2
  25 = 7 + 2×3^2
  27 = 19 + 2×2^2
  33 = 31 + 2×1^2

  It turns out that the conjecture was false.

  What is the smallest odd composite that cannot be written as the 
  sum of a prime and twice a square?
  """


*)
(* 0.13135s *)
euler46[] := Module[{comp, ts, found, res},
   comp = Select[Table[i, {i, 3, 10000, 2}], Not[PrimeQ[#]] &];
   res = 0;
   Do[
    found = False;
    Do[
     ts = j*j*2; 
     If[PrimeQ[Abs[i - ts]], found = True],
     {j, 1, Round[Sqrt[i/2]]}
     ];
    If[found == False, res = i; Return[res]],
    {i , comp}];
   res
   ];
checkSolution[euler46];

(*
  Problem 47:
  """  
  The first two consecutive numbers to have two distinct prime factors are:

  14 = 2 x 7
  15 = 3 x 5

  The first three consecutive numbers to have three distinct 
  prime factors are:

  644 = 2^2 x 7 x 23
  645 = 3 x 5 x 43
  646 = 2 x 17 x 19.

  Find the first four consecutive integers to have four distinct primes 
  factors. What is the first of these numbers?
   """ 


*)
(* 0.805591s *)
euler47[] := Module[{maxN = 1000000, f, goal, sol = 0},
  f = Table[0, {i, maxN}];
  (* Note: the i < maxN/2 is a guard for too large values in f[] *)
  
  Do[
   If[f[[i]] == 0 && i < maxN/2,
    f[[2*i ;; -2 ;; i]]++
    ],
   {i, 2, maxN - 1}];
  goal = {4, 4, 4, 4};
  Do[
   If[f[[i ;; i + 3]] == goal, sol = i; Return[sol]],
   {i, 2, maxN - 3}];
  sol
  ]
checkSolution[euler47];

(*

  Problem 48
  """
  The series, 1^(1) + 2^(2) + 3^(3) + ... + 10^(10) = 10405071317.
  
  Find the last ten digits of the series, 
  1^(1) + 2^(2) + 3^(3) + ... + 1000^(1000).
  """

*)
(* 0.005341s *)
euler48[] := StringJoin[ToString/@ IntegerDigits[Total@Map[#^# &, Range[1000]]][[-10 ;; -1]],""];
checkSolution[euler48];

(*
  Problem 49:
  """  
  The arithmetic sequence, 1487, 4817, 8147, in which each of the terms 
  increases by 3330, is unusual in two ways: (i) each of the three terms are 
  prime, and, (ii) each of the 4-digit numbers are permutations of one another.

  There are no arithmetic sequences made up of three 1-, 2-, or 3-digit primes, 
  exhibiting this property, but there is one other 4-digit increasing sequence.

  What 12-digit number do you form by concatenating the three terms 
  in this sequence?
  """

*)

(* 0.005596s *)
check49[n_] := Module[{ns, ds, ret = {}},
  ns = Table[n + i*3330, {i, 0, 2}];
  If[AllTrue[ns, PrimeQ],
   ds = IntegerDigits@ns;
   ps = Permutations[First@ds];
   Length[Select[ds, MemberQ[ps, #] &]] == 3,
   False
   ]
  ]
euler49[] := Module[{diff = 3330, res = 0, t},
  t = Select[Table[n, {n, 1001, 9999, 2}], # != 1487 && PrimeQ[#] &];
  Do[
    If[check49[n], res = n; Return[res]],
    {n, t}];
  StringJoin[Table[ToString[res + i*3330], {i, 0, 2}], ""]
  ]
checkSolution[euler49];

(*
  Problem 50
  """
  The prime 41, can be written as the sum of six consecutive primes:
  41 = 2 + 3 + 5 + 7 + 11 + 13

  This is the longest sum of consecutive primes that adds to a prime 
  below one-hundred.

  The longest sum of consecutive primes below one-thousand that adds to a prime, 
  contains 21 terms, and is equal to 953.
  
  Which prime, below one-million, can be written as the sum of the most 
  consecutive primes?
  """

*)
(* 0.011869s *)
euler50[] := Module[{ps, pp, found = 0},
  ps = Select[Range[10000], PrimeQ];
  Do[
   If[found > 0, Return[found],
       Do[
     pp = Total[ps[[offset + 1 ;; offset + len]]];
     If[pp < 1000000 && PrimeQ[pp], found = pp; Return[pp]]
     , {offset, 1, 549}]
    ], {len, 550, 21, -1}];
  pp
  ]
checkSolution[euler50];

  
Print["\n\n"];
Print["Total time: ", totalTime, "s (", {{Floor[103.10462700000001 / 60],"minutes ", Mod[103.10462700000001, 60],"seconds"},")"];
Print["Num correct: ", numCorrect, " numFailed: ", numFailed];

Print["Failed problems:"];
Print[failed];

  
Print["\nTimes (decreasing times):"];
Print /@ Reverse@SortBy[times,2];

If[Length@failed == 0,Print["All OK!"]]
