1
2

Max@Table[ Select[FromDigits /@ Permutations[Range[i]], PrimeQ], {i, 9}]
7652413

1
2
3
4
5
6

s = (Total[ToCharacterCode[#] - First@ToCharacterCode["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

 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[#, cf@#, 1] &@Permutations@Range[0, 9] // Tr
16695334890

 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:%d\ni:%d\nm:%d\nn:%d\nn-m:%d\n",j,i,m,n,n-m);
}
j:1020
i:2168
m:1560090
n:7042750
n-m:5482660

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}

1
2
3

In[17]:= CanWritten[n_] :=Count[n - Array[2*#^2 &, Floor@Sqrt[n/2]], i_ /; PrimeQ@i] > 0;
In[18]:= AbsoluteTiming@Select[Range[3, 6000, 2], CompositeQ@# && ! CanWritten@# &]
Out[18]= {0.467058, {5777, 5993}}

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}

1
2

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

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} }

 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}]

1
2
3
4
5
6
7

ps = Table[Prime[i], {i, PrimePi[1*^4] + 1, PrimePi[1*^6]}];
RepPrimeCount[n_, r_] := 
  Block[{m = Most@IntegerDigits[n], l = Last@IntegerDigits[n]}, 
   Count[Table[FromDigits@Append[ReplaceAll[m, i], l], {i,      Array[r -> # &, 10, 0]}], d_ /; IntegerLength@d == IntegerLength@n && PrimeQ@d]];
Filter[n_] := Block[{s = Most@IntegerDigits@n}, Or @@ Table[Count[s, i] == 3 && RepPrimeCount[n, i] == 8, {i, 0, 2}]];
Select[ps, Filter@# &]
{121313}

1
2

NestWhile[# + 1 &, 1, Length@DeleteDuplicates[Sort /@ (IntegerDigits@(Range[6]*#))] != 1 &]
142857

1
2

Count[Flatten@Table[Binomial[n, r], {n, 1, 100}, {r, 1, n}], d_ /; d > 1*^6]
4075

 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 = First@Commonest@values;
  Which[
   Length@Union@suites == 1 &&Differences@values == {-1, -1, -1, -1}, {9, values}, (*Royal/Straight Flush*)
   valuepat == {4, 1}, {8, Commonest[values, 2]},
   valuepat == {3, 2}, {7, Commonest[values, 2]},
   Length@Union@suites == 1, {6, values},
   Differences@values == {-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,    First@Complement[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 <= Length@Player1[[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

1
2
3
4

Rev[n_] := FromDigits@Reverse@IntegerDigits@n;
IsPal[n_] := n == Rev@n;
IsLychrel[n_] :=  TrueQ[For[m = n + Rev@n; i = 1, i <= 50, i++,  If[IsPal@m, Return@False, m += Rev@m]] == Null]Count[IsLychrel /@ Range[10000], True]
249

1
2

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

1
2

Count[Convergents[Sqrt@2,1001],f_/;IntegerLength@Numerator@f>IntegerLength@Denominator@f] 
153

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

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

EncryptText = FromDigits /@ StringSplit[Import["p059_cipher.txt"], ","];
key=StringJoin@
Flatten@Table[
   FromCharacterCode[
    ToCharacterCode["a"] - 1 +
     Position[
      Array[BitXor[First@ToCharacterCode[" "], #] &, 26, First@ToCharacterCode["a"]],
      First@Commonest@EncryptText[[i ;; ;; 3]]
      ]
    ], {i, 3}]
"god"
Total@MapIndexed[BitXor[#1, ToCharacterCode[key][[Mod[#2, 3, 1]]]] &, EncryptText]
107359

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

ps = Array[Prime, PrimePi@10000];
FilterQ[n_] :=  Select[ps, # > n &&  AllTrue[{n*(10^IntegerLength@#) + #, #*(10^IntegerLength@n) + n},      PrimeQ] &];
For[ia = 1, ia <= Length@ps, ia++, a = ps[[ia]];
seta = FilterQ@a;
For[ib = 1, ib <= Length@seta, ib++, b = seta[[ib]];
  setb = FilterQ@b;
  setbi = Intersection[seta, setb];
  For[ic = 1, ic <= Length@setbi, ic++, c = setbi[[ic]];
   setc = FilterQ@c;
   setci = Intersection[setbi, setc];
   For[id = 1, id <= Length@setci, id++, d = setci[[id]];
    setd = FilterQ@d;
    setdi = Intersection[setci, setd];
    If[Length@setdi > 0, Return[Total@{a, b, c, d, First@setdi}]]]]]]
Return[26033]