1
2
3
4
5
6
7
8
9

s = Import["p081_matrix.txt", "Data"];
Clear@MinPathSum;
MinPathSum[1, 1] := s[[1, 1]]
MinPathSum[r_, c_] := MinPathSum[r, c] =
   If[r == 1, MinPathSum[r, c - 1],
     If[c == 1, MinPathSum[r - 1, c],
      Min[MinPathSum[r - 1, c], MinPathSum[r, c - 1]]]] + s[[r, c]];
MinPathSum[80, 80]
427337

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

m = Import["p081_matrix.txt", "Data"];
n = Length@m;
dirs = { {0, 1}, {1, 0}, {-1, 0} };
ew = Flatten[
   Rest@Reap[ret = {};
     Table[If[1 <= x + i[[1]] <= n && 1 <= y + i[[2]] <= n,
       Sow[{x, y} \[DirectedEdge] {x, y} + i, e];
       Sow[m[[Sequence @@ ({x, y} + i)]], w]], {x, n}, {y, n}, {i,
       dirs}];], 1];
gr = Graph[ew[[1]], EdgeWeight -> ew[[2]]];
Min@Table[GraphDistance[%, {i, 1}, {j, n}] + m[[i, 1]], {i, n}, {j, n}]
260324

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

m = Import["p081_matrix.txt", "Data"];
n = Length@m;
dirs = { {0, 1}, {1, 0}, {-1, 0}, {0, -1} };
ew = Flatten[
   Rest@Reap[ret = {};
     Table[If[1 <= x + i[[1]] <= n && 1 <= y + i[[2]] <= n,
       Sow[{x, y} \[DirectedEdge] {x, y} + i, e];
       Sow[m[[Sequence @@ ({x, y} + i)]], w]], {x, n}, {y, n}, {i,
       dirs}];], 1];
gr = Graph[ew[[1]], EdgeWeight -> ew[[2]]];
m[[1, 1]] + GraphDistance[gr, {1, 1}, {n, n}]
425185

1
2
3
4
5

s = Abs[Table[Binomial[x + 1, 2]*Binomial[y + 1, 2], {x, 2000, 1, -1}, {y, 2001 - x}] - 2*10^6];
Position[s, Min@s]
{ {1924, 36}, {1965, 77} }
36*77
2772

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

#include <iostream>
#include <cmath>
int main()
{
    int m = 2;
    int count = 0;
    int target = 1000000;
 
    while (count < target) {
        m++;
        for (int wh = 3; wh <= 2 * m; wh++) {
            double s = sqrt(wh * wh + m * m);                   
            if (s == (int)(s)) {
                count += (wh <= m) ? wh / 2 : 1 + (m - (wh+1)/2);
            }
        }
    }
    printf("m:%d\ncount:%d\n",m,count);
}
m:1818
count:1000457

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

limit = 5*10^7;
ps = Array[Prime, PrimePi@Sqrt@limit];
ret = {};
For[i = 1, i <= Length@ps, i++,
x = ps[[i]];
yset = PrimePi[(limit - x^2)^(1/3)];
For[j = 1, j <= yset, j++,
  y = Prime[j]; If[limit - x^2 - y^3 > 0,
   ret = {ret, x^2 + y^3 + (Array[Prime, PrimePi[(limit - x^2 - y^3)^(1/4)]])^4}];
  ]
];
Length@DeleteDuplicates@Flatten@ret
1097343

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

uf[m_, 1] := { {} }
uf[1, n_] := { {} }
uf[m_, n_?PrimeQ] := If[m < n, {}, { {n} }]
uf[m_, n_] :=
uf[m, n] =
  Join @@ Table[
    Prepend[#, d] & /@ uf[d, n/d], {d,
     Select[Rest@Divisors@n, # <= m &]}]
uf[n_] := uf[n, n]
k = 12000;
limit = 2 k;
f[n_] := If[Length@uf@n == 1, 0,
   DeleteCases[
    DeleteDuplicates[Length@# + n - Total@# & /@ (Most@uf@n)],
    a_ /; a > k]];
s = f /@ Range@limit;
arr = ConstantArray[0, k];
mf[fl_, pos_] :=
  If[Length@fl > 0, If[arr[[#]] == 0, arr[[#]] = First@pos] & /@ fl,
   0];
MapIndexed[mf, s];
Total@DeleteDuplicates@arr
7587457

1

Total[StringLength@# - StringLength@IntegerString[FromDigits[#, "Roman"], "Roman"] & /@  ps]

1
2
3
4

r = 50; Pts = Flatten[Table[{i, j}, {i, r}, {j, r}], 1];
NatPt[i_, j_] :=  Module[{}, k = j/i; knew = -1/k; b = j - knew*i;   Count[(knew*# + b) & /@ Range[0, r],   a_ /; IntegerQ@a && 0 <= a <= r] - 1];
Total[NatPt @@@ Pts] + 3 r^2
14234

 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
40
41
42
43
44
45
46
47
48
49
50
51
52
53

private int nextNumber(int input)
{
    int retVal = 0;
 
    while (input > 0)
    {
        int digit = input % 10;
        retVal += digit * digit;
        input /= 10;
    }
 
    return retVal;
}
public void Solve()
{
 
    Stopwatch clock = Stopwatch.StartNew();
    int result = 0;
    int target = 10000000;
    int cachesize = (int)Math.Ceiling(81 * Math.Log10(target)) + 1;
    bool[] cache = new bool[cachesize + 1];
 
    for (int i = 1; i < cachesize; i++)
    {
        int sequence = nextNumber(i);
 
        while (sequence > i && sequence != 89)
        {
            sequence = nextNumber(sequence);
        }
 
        if (cache[sequence] || sequence == 89)
        {
            result++;
            cache[i] = true;
        }
 
    }
 
    for (int i = cachesize; i <= target; i++)
    {
        if (cache[nextNumber(i)])
        {
            result++;
        }
    }
 
    clock.Stop();
    Console.WriteLine("There are {0} numbers that ends in 89", result);
    Console.WriteLine("Solution took {0} ms", clock.Elapsed.TotalMilliseconds);
}
There are 8581146 numbers that ends in 89
Solution took 1930.5379 ms

 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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

operators=['+','-','*','/']
import itertools
opslist=list(itertools.product(operators,repeat=3))

def results(inputints):
    inputs=[str(x) for x in inputints]
    res=[]
    for ops in opslist:
        s=list(filter(lambda x: x != '', itertools.chain.from_iterable(itertools.zip_longest(inputs, ops, fillvalue = ''))))
        
        #added brackets
        #a+b+c+d
        #a+(b+c)+d
        #a+b+(c+d)
        #a+(b+c+d)
        #(a+b)+(c+d)
        exps=[s]
        for i in range(4):
            exps.append(s.copy())
        exps[1].insert(2,'(')
        exps[1].insert(6,')')
        
        exps[2].insert(4,'(')
        exps[2].append(')')
        
        exps[3].insert(2,'(')
        exps[3].append(')')
        
        exps[4].insert(0,'(')
        exps[4].insert(4,')')
        exps[4].insert(6,'(')
        exps[4].append(')')    
    
        for exp in exps:
            expstr=''.join(exp)
            try:
                value=eval(expstr)
                if value==int(value) and value>0:
                    res.append(int(value))
            except ZeroDivisionError as err:
                #print(err)
                pass
    return list(set(res))

def GetNonCaled(operands):
    res=[]
    intlists=list(itertools.permutations(operands,4))
    for inputints in intlists:
        res.extend(results(inputints))
    res=sorted(list(set(res)))
    #print(res)
    for i in range(1,len(res)+1):
        if i not in res:
            return i


arglist=[]
for a in range(1,10):
    for b in range(a+1,10):
        for c in range(b+1,10):
            for d in range(c+1,10):
                arglist.append([a,b,c,d])
data={}
for l in arglist:
    r=GetNonCaled(l)
    if r not in data:
        data[r]=[l]
    else:
        data[r].append(l)

print(data)
1258

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

x,y=2,1
sum=0
while True:
    x,y=2*x+3*y,2*y+x
    if (2*x+1) % 3==0 and ((x+2)*y)%3==0:
        print(int((2*x+1)/3),int((2*x+1)/3-1))
        p=2*x+2
        if p>10**9:break
        sum+=p
    if (2*x-1) % 3==0 and ((x-2)*y) % 3==0:
        print(int((2*x-1)/3),int((2*x-1)/3-1))
        p=2*x-2
        if p>10**9:break
        sum+=p
 
print(sum)
518408346

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

f[n_] := DivisorSigma[1, n] - n;
fl[n_] := Module[{}, i = 1;
   x = n; ret = {x};
   While[True, x = f@x;
    If[x > 10^6 || x < 2, ret = {}; Break[],
     If[MemberQ[ret, x, Infinity],
      If[x == n, ret = {ret, x}, ret = {}]; Break[], ret = {ret, x}]]];
   Length@Flatten@ret - 1];
ps = Position[fl /@ Range[10000, 1000000], a_ /; a > 0]
fres = fl @@@ (10000 + ps - 1)
ps[[FirstPosition[fres, Max@fres]]]
14316

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

grids = Map[FromDigits, Characters[  Rest /@ Partition[Import["p096_sudoku.txt", "Data"], 10]], {3}];
f[g_, i_, j_] := Complement[Range[9], DeleteDuplicates@ DeleteCases[ Join[g[[i, All]], g[[All, j]], Flatten@g[[3 Floor[(i - 1)/3] + 1 ;; 3 Floor[(i - 1)/3] + 3, 3 Floor[(j - 1)/3] + 1 ;; 3 Floor[(j - 1)/3] + 3]]], 0]];
SpreadCands[l_] := Module[{candis = <||>},  Do[If[l[[i, j]] == 0, candis[{i, j}] = f[l, i, j]], {i, 9}, {j,9}]; Sort@candis];
Step[] :=  Module[{assc, g, rule, pt, values}, g = Last@gl;  assc = SpreadCands[g];
   If[assc == <||>, Throw[FromDigits@g[[1, 1 ;; 3]]]];
   If[MemberQ[assc, {}, All], gl = First@gl,
    rule = First@Normal@assc; pt = First@rule; values = Last@rule;
    Do[g[[Sequence @@ pt]] = v;  gl = {gl, g}; Step[], {v, values}]];
   ];
AbsoluteTiming@Total@Table[gl = { {}, i}; Catch@Step[], {i, grids}]
{49.13, 24702}

1
2

FromDigits@Take[IntegerDigits[28433*2^7830457 + 1], -10]
8739992577

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

words = StringSplit[StringReplace[Import["p098_words.txt"], "\"" -> ""], ","];
wordpairs= SortBy[Select[GatherBy[words, Sort@Characters@# &], Length@# > 1 &],100 - StringLength@First@# &];
f[w1_, w2_] :=
Module[{}, l = StringLength@w1; ret = {};
  For[i = Ceiling@Sqrt[10^(l - 1)], i <= Floor@Sqrt[10^l - 1], i++,
   {d, w1d, w2d} = {IntegerDigits[i^2], Characters@w1, Characters@w2};
   assc = <||>;
   flag = True;
   For[j = 1, j <= Length@d, j++,
    If[KeyExistsQ[assc, w1d[[j]]],
     If[assc[w1d[[j]]] != d[[j]], flag = False; Break[]],
     If[MemberQ[Values@assc, d[[j]]], flag = False; Break[],
      assc[w1d[[j]]] = d[[j]]]]
    ];
   If[flag, w2i = FromDigits[w2d /. Normal[assc]];
    If[IntegerLength@w2i == l && IntegerQ@Sqrt@w2i, ret = {ret, assc}]]
   ]; Flatten@ret];
Take[f@@@wordpairs,-20]
{f["POST", "SPOT",  "STOP"], {}, {<|"B" -> 1, "O" -> 7, "A" -> 6, "R" -> 8,   "D" -> 9|>}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {} }
18769

1
2

Ordering[Import["p099_base_exp.txt", "Data"], -1, #1[[2]]*Log@#1[[1]] < #2[[2]]*Log@#2[[1]] &]
{709}

1

First@Solve[b/(b + r)*(b - 1)/(b + r - 1) == 1/2 && b + r > 10^12 && b > 0 &&  r > 0, {b, r}, Integers]