dive into project euler part 3 (41 Problem 42 Problem 43 Problem 44 Problem 45 Problem 46 Problem 47 Problem 48 Problem 49 Problem 50 Problem 51 Problem 52 Problem 53 Problem 54 Problem 55 Problem 56 Problem 57 Problem 58 Problem 59 Problem 60

1
2
[email protected][ Select[FromDigits /@ Permutations[Range[i]], PrimeQ], {i, 9}]
7652413

Problem 42

1
2
3
4
5
6
s = (Total[ToCharacterCode[#] - [email protected]["A"] + 1]) & /@ StringSplit[StringReplace[Import["R:\words.txt"], """ -> ""],   ","];
Reduce[n*(n + 1)/2 >Max[s] && n > 0, n, Integers]
n >= 20
In[37]:= tn = Array[#*(# + 1)/2 &, 20];
In[38]:= Select[s, MemberQ[tn, #] &] // Length
Out[38]= 162

Problem 43

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
cf = With[{
    code =
     And @@ Thread[
         Table[100 A[[i]] + 10 A[[i + 1]] + A[[i + 2]], {i, 2, 8}]~
           Mod~{2, 3, 5, 7, 11, 13, 17} == 0] // Boole // Quiet
    },
   Compile[{ {A, _Integer, 1} },
    code,
    RuntimeAttributes -> Listable,
    RuntimeOptions -> "Speed", CompilationTarget -> "C"
    ]
   ];
FromDigits /@ Pick[#, [email protected]#, 1] &@[email protected][0, 9] // Tr
16695334890

Problem 44

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#include <iostream>
#include <cmath>
int main()
{
	int i=1;
	bool flag=true;
	int j,m,n;
	double a,b;
	while(flag)
	{
		n=i*(3*i-1)/2;
		j=i-1;
		for(j=i-1;j>0;--j)
		{
			m=j*(3*j-1)/2;
			a=(sqrt(24*(n+m)+1)+1)/6;
			b=(sqrt(24*(n-m)+1)+1)/6;
			if(a==int(a)&&b==int(b))
			{
				flag=false;
				break;
			}
		}
		i++;
	}
	printf("j:%dni:%dnm:%dnn:%dnn-m:%dn",j,i,m,n,n-m);
}
j:1020
i:2168
m:1560090
n:7042750
n-m:5482660

Problem 45

1
2
3
4
5
6
n = 60000;
T = Array[# (# + 1)/2 &, n];
P = Array[# (3 # - 1)/2 &, n];
H = Array[# (2 # - 1) &, n];
Intersection[T, P, H] 
{1, 40755, 1533776805}

Problem 46

1
2
3
In[17]:= CanWritten[n_] :=Count[n - Array[2*#^2 &, [email protected][n/2]], i_ /; [email protected]] > 0;
In[18]:= [email protected][Range[3, 6000, 2], [email protected]# && ! [email protected]# &]
Out[18]= {0.467058, {5777, 5993}}

Problem 47

1
2
3
Checker[n_, m_] :=(Length /@ (Part[#, All, 1] & /@ FactorInteger[Range[n, n + m - 1]])) == ConstantArray[m, m]
In[83]:= Select[Range[2, 2*^5], Checker[#, 4] &]
Out[83]= {134043}

Problem 48

1
2
FromDigits[Take[IntegerDigits[Sum[i^i, {i, 1000}]], -10]]
9110846700

Problem 49

1
2
3
4
5
s = Select[Range[1000, 9999], PrimeQ];
t = Select[s, MemberQ[s, # + 3330] && MemberQ[s, # + 6660] &];
u = Table[{i, i + 3330, i + 6660}, {i, t}];
Select[u, Length[DeleteDuplicates[Sort /@ IntegerDigits[#]]] == 1 &]
{ {1487, 4817, 8147}, {2969, 6299, 9629} }

Problem 50

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
In[138]:= s = 0; NestWhile[(# + 1) &, 1, (s += Prime[#]) < 1*^6 &]
Out[138]= 547
as = Accumulate[Array[Prime, 546]];
In[145]:= For[i = 546, i > 0, i--,
For[j = 1, j < i, j++,
  If[PrimeQ[as[[i]] - as[[j]]],
   Return[{"from", Prime[j], "to", Prime[i], i - j, "primes'stotal:",
     as[[i]] - as[[j]]}]]
  ]
]
Out[145]= Return[{"from", 5, "to", 3931, 543, "primes'stotal:",  997651}]

Problem 51

1
2
3
4
5
6
7
ps = Table[Prime[i], {i, PrimePi[1*^4] + 1, PrimePi[1*^6]}];
RepPrimeCount[n_, r_] := 
  Block[{m = [email protected][n], l = [email protected][n]}, 
   Count[Table[[email protected][ReplaceAll[m, i], l], {i,      Array[r -> # &, 10, 0]}], d_ /; [email protected] == [email protected] && [email protected]]];
Filter[n_] := Block[{s = [email protected]@n}, Or @@ Table[Count[s, i] == 3 && RepPrimeCount[n, i] == 8, {i, 0, 2}]];
Select[ps, [email protected]# &]
{121313}

Problem 52

1
2
NestWhile[# + 1 &, 1, [email protected][Sort /@ ([email protected](Range[6]*#))] != 1 &]
142857

Problem 53

1
2
Count[[email protected][Binomial[n, r], {n, 1, 100}, {r, 1, n}], d_ /; d > 1*^6]
4075

Problem 54

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
hands = Import["e:\U盘\p054_poker.txt", "Table"];
type[cards_] :=
Module[{},
  values = FromDigits /@ ((StringTake[#, 1] & /@ cards) /. {"A" ->"14", "K" -> "13", "Q" -> "12", "J" -> "11", "T" -> "10"}) //Sort // Reverse;
  suites = StringTake[#, -1] & /@ cards;
  valuepat = Tally[values][[;; , 2]] // Sort // Reverse;
  FirstComVal = [email protected]@values;
  Which[
   [email protected]@suites == 1 &&[email protected] == {-1, -1, -1, -1}, {9, values}, (*Royal/Straight Flush*)
   valuepat == {4, 1}, {8, Commonest[values, 2]},
   valuepat == {3, 2}, {7, Commonest[values, 2]},
   [email protected]@suites == 1, {6, values},
   [email protected] == {-1, -1, -1, -1}, {5, values},
   valuepat == {3, 1, 1}, {4, Prepend[DeleteCases[values, FirstComVal], FirstComVal]},
   valuepat == {2, 2, 1}, {3,  Append[Commonest[values, 2] // Sort // Reverse,    [email protected][values, Commonest[values, 2]]]},
   valuepat == {2, 1, 1, 1}, {2,  Prepend[DeleteCases[values, FirstComVal], FirstComVal]},
   True, {1, values}
   ]
  ]
GetWinner[hand_] :=  Module[{}, Player1 = type[hand[[;; 5]]];  Player2 = type[hand[[6 ;;]]];
   If[Player1[[1]] > Player2[[1]], Return[1],
    If[Player1[[1]] < Player2[[1]], Return[2],
     For[i = 1, i <= [email protected][[2]], i++,
      If[Player1[[2, i]] > Player2[[2, i]], Return[1],
       If[Player1[[2, i]] < Player2[[2, i]], Return[2]]
       ]
      ]
     ]
    ]
   ];
Count[GetWinner /@ hands, 1]
376

Problem 55

1
2
3
4
Rev[n_] := [email protected]@[email protected];
IsPal[n_] := n == [email protected];
IsLychrel[n_] :=  TrueQ[For[m = n + [email protected]; i = 1, i <= 50, i++,  If[[email protected], [email protected], m += [email protected]]] == Null]Count[IsLychrel /@ Range[10000], True]
249

Problem 56

1
2
Max[Total /@ [email protected]@Array[#1^#2 &, {99, 99}]]
972

Problem 57

1
2
Count[Convergents[[email protected],1001],f_/;[email protected]@f>[email protected]@f] 
153

Problem 58

1
2
3
4
f[3]=3;
f[n_]:=f[n]=f[n-2]+Count[PrimeQ[Array[(n-2)^2+(n-1)#&,3]],True];
NestWhile[#+2&,3,f[#]/(2#-1)>=0.1&]
26241

Problem 59

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
EncryptText = FromDigits /@ StringSplit[Import["p059_cipher.txt"], ","];
[email protected]
[email protected][
   FromCharacterCode[
    ToCharacterCode["a"] - 1 +
     Position[
      Array[BitXor[[email protected][" "], #] &, 26, [email protected]["a"]],
      [email protected]@EncryptText[[i ;; ;; 3]]
      ]
    ], {i, 3}]
"god"
[email protected][BitXor[#1, ToCharacterCode[key][[Mod[#2, 3, 1]]]] &, EncryptText]
107359

Problem 60

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
ps = Array[Prime, [email protected]];
FilterQ[n_] :=  Select[ps, # > n &&  AllTrue[{n*(10^[email protected]#) + #, #*(10^[email protected]) + n},      PrimeQ] &];
For[ia = 1, ia <= [email protected], ia++, a = ps[[ia]];
seta = [email protected];
For[ib = 1, ib <= [email protected], ib++, b = seta[[ib]];
  setb = [email protected];
  setbi = Intersection[seta, setb];
  For[ic = 1, ic <= [email protected], ic++, c = setbi[[ic]];
   setc = [email protected];
   setci = Intersection[setbi, setc];
   For[id = 1, id <= [email protected], id++, d = setci[[id]];
    setd = [email protected];
    setdi = Intersection[setci, setd];
    If[[email protected] > 0, Return[[email protected]{a, b, c, d, [email protected]}]]]]]]
Return[26033]