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
33
34
35
36
37
38
39

LEN=6
numbers=[[] for row in range(LEN)]
solution=[0]*LEN
for i in range(200):
    if(1000<=i*(i+1)/2<10000):
        numbers[0].append(int(i*(i+1)/2))
    if(1000<=i*i<10000):
        numbers[1].append(i*i)
    if(1000<=i*(3*i-1)/2<10000):
        numbers[2].append(int(i*(3*i-1)/2))
    if(1000<=i*(2*i-1)<10000):
        numbers[3].append(i*(2*i-1))           
    if(1000<=i*(5*i-3)/2<10000):
        numbers[4].append(int(i*(5*i-3)/2))
    if(1000<=i*(3*i-2)<10000):
        numbers[5].append(i*(3*i-2))
 
def FindNext(last, length):
    for i in range(LEN):
        if (solution[i] == 0):
            for j in range(len(numbers[i])):
                if(numbers[i][j] not in solution and ((numbers[i][j] // 100) == (solution[last] % 100))):
                    solution[i] = numbers[i][j]
                    if (length == 5):
                        if (solution[5] // 100 == solution[i] % 100):
                            return True
                    elif (FindNext(i, length + 1)):
                        return True
 
            solution[i] = 0  #backforce
    return  False
 
for i in range(len(numbers[5])):
    solution[5]=numbers[5][i]
    if(FindNext(5, 1)):       
        print(solution, sum(solution))
        break

[8256, 5625, 2882, 8128, 2512, 1281] 28684

1
2
3
4

Reverse@SortBy[Tally[Table[Sort@IntegerDigits[i^3], {i, 10000}]], Last]
{ { {0, 1, 2, 3, 3, 4, 5, 6, 6, 7, 8, 9},  5}, { {0, 1, 2, 3, 3, 4, 5, 5, 6, 7, 8, 9}, 5}, ...}
Min@Select[Table[i^3, {i, 1000, 10000}], Sort@IntegerDigits[#] == {0, 1, 2, 3, 3, 4, 5, 6, 6, 7, 8, 9} ||   Sort@IntegerDigits[#] == {0, 1, 2, 3, 3, 4, 5, 5, 6, 7, 8, 9} &]
127035954683

1
2
3
4
5
6

Reduce[10^((i - 1)/i) <= 9. && i > 0, i, Reals]
0 < i <= 21.8543
s =Table[Length@  Solve[10^(i - 1) <= x^i < 10^i && x > 0, x, Integers], {i, 21}]
 {9, 6, 5, 4, 3, 3, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}
Total@s
49

1
2

Count[Sqrt /@ Range[10000], s_ /; (! IntegerQ@s) && OddQ@Length[(ContinuedFraction@s)[[2]]]]
1322

1
2

Total@IntegerDigits@Numerator@Last@Convergents[E, 100]
272

1
2
3
4
5
6
7

f[d_] :=Module[{n = 1}, If[IntegerQ@Sqrt@d, ret = 0, While[True, 
    b = Last@Convergents[Sqrt@d, n]; 
    {x, y} = {Numerator@b,  Denominator@b}; 
    If[x^2 == d*y^2 + 1, ret = x; Break[], n++] ]];
  ret]
Ordering[f /@ Range[1000], -1]
{661}

1

See Problem 18.

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

outer = {1, 4, 6, 8,  10}; 
seq = { {1, 2, 3}, {4, 3, 5} , {6, 5, 7} ,   {8, 7, 9}  , {10,  9, 2} };
p = Select[Permutations@Range@10,
   Length@Union@Table[Total@#[[i]], {i, seq}] == 1 &&
     MemberQ[#[[outer]], 10] && Min[#[[outer]]] == 6 &];
 
In[54]:= f[l_] := Module[{},
  sm = Ordering[l[[outer]], 1];
  s = RotateLeft[seq, sm - 1];
  FromDigits@StringJoin[ToString /@ l[[Flatten@s]]]
  ]
 
In[55]:= Max[f /@ p]
Out[55]= 6531031914842725

1
2

Ordering[Table[n/EulerPhi[n],{n,2,1*^6}],-1]+1
{510510} 

1
2
3
4
5
6

ps = Table[Prime@i, {i, PrimePi@2000, PrimePi@5000}];
s =Select[Flatten[{Table[{i, i}, {i, ps}], Subsets[ps, {2}]}, 1],  Times @@ # < 1*^7 && Sort@IntegerDigits[(#[[1]] - 1) (#[[2]] - 1)] == Sort@IntegerDigits[#[[1]]*#[[2]]] &]
s[[Ordering[(1 - 1/#) (1 - 1/#2) & @@@ s, -1]]]
{ {2339, 3557} }
2339*3557
8319823

1
2

Numerator[Union[Floor[3 #/7]/# & /@ Range[1*^6]][[-2]]]
428570

1
2

Total[EulerPhi /@ Range[2, 1*^6]]
303963552391

1
2
3

f[n_]:=Count[Range[Floor[n/3]+1,Ceiling[n/2]-1],a_/;CoprimeQ[n,a]]
Total[f /@ Range[4, 12000]]
7295372

 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

import time
start_time = time.time()
 
total=0
#Why bother calculating? We only need factorials of 0 - 9.
f = [1,1,2,6,24,120,720,5040,40320,362880]
#Let's keep a list of chains that we know the value for already.
chains={}
for i in range(1,1000001):
        chain=[]
        count=0
        n = i
        while not n in chain:
                try:
                        #If we've already found the chain value for this value of n, why recalculate it? Grab from our list, and end.
                        count += chains[n]
                        break
                except KeyError:
                        #Python threw an error, which means we don't know this n's chain value. Keep going.
                        chain.append(n)
                        ns = str(n)
                        n = sum(f[int(d)] for d in ns)
                        count+=1
        #Record the chain value for the first value of n in this chain.
        chains[chain[0]] = count
        if count == 60: total+=1
print total
run_time = time.time() - start_time
print(run_time)
402
59.08246302604675

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19

def gcd(a,b):
    while b != 0:
        a,b = b,a%b
    return a
 
limit=1500000
triplets = limit * [0]
import math
 
for m in range( 2, int( math.sqrt( limit / 2 ) ), 1 ):
    for n in range( 1, m, 1 ):
        if ( m - n ) % 2 == 1 and gcd( m, n ) == 1:
            p = 2 * m * ( m + n )
            if p > limit: break
            for idx in range( p, limit, p ):
                triplets[idx] += 1
 
print( sum( n == 1 for n in triplets ) )
161667

1
2

PartitionsP[100]-1
190569291

1
2

NestWhile[# + 1 &, 2, Length@IntegerPartitions[#, All, Array[Prime, PrimePi[1000]]] <=   5000 &]
71

1
2
3
4
5
6
7
8

Clear[ml, sl, p];
ml[n_] := ml[n] = # (3 # - 1)/2 & /@ Flatten@Table[{1, -1}*i, {i, n}];
sl[n_] := sl[n] = ((-1)^Floor[(# - 1)/2]) & /@ Range[2 n];
p[0] = p[1] = 1;
p[k_Integer?Negative] := 0;
p[k_] := p[k] = Module[{maxk = Ceiling[(1 + Sqrt[24 k + 1])/6]}, Total[(p /@ (k - ml[maxk]))*sl[maxk]]]
NestWhile[# + 1 &, 1, Mod[p@#, 1*^6] != 0 &]
55374

1
2

TopologicalSort@Graph@Flatten[{DirectedEdge[#[[1]], #[[2]]], DirectedEdge[#[[2]], #[[3]]]} & /@ s]
{7, 3, 1, 6, 2, 8, 9, 0}

1
2
3

ps = Select[Range[100], IntegerPart[Sqrt[#]] != Sqrt[#] &];
Total[Take[First@RealDigits@N[Sqrt[#], 102], 100] & /@ ps, 2]
40886