Project Euler

Steven Miller (sjm1@williams.edu)

(*For this problem we could go through and keep track of the multiples of 3 and 5 and add. We can also use the formula that the sum of the first n integers is n(n+1)/2. We use this and inclusion/exclusion to quickly get a formula for the sum of all multiples of 3 and 5 up to 1000.*)
(*We can't use N as a variable in Mathematica as that means numeric, so let's use n. Let sum(n) mean the sum of all integers up to n. The sum of all multiples of 3 or 5 below 1000 is the following:*)
(* 3 sum(n/3) + 5 sum(n/5) - 15 sum(n/15) *)
(* in the arguments below we use the floor function to make sure we're evaluating the sums at the largest integer at most a given argument. *)
problem1sum[n_] := Floor[n] Floor[n+1]/2;
problem1answer[n_] := Simplify[3 problem1sum[n/3] + 5 problem1sum[n/5] - 15 problem1sum[n/15]]
problem1answer[999]
(* Here is the brute force answer *)
Sum[ If[Mod[n,3] == 0 || Mod[n,5] == 0,n,0], {n,1,999}]
(* this is a good way to check and is a bit easier to code *)
(* I originally got this wrong as I forgot it said BELOW and included 1000 *)

(* one has to be careful; Mathematica has a predefined command for the Fibonaccis, but they have F1 = 1 and F2 = 1; so you might want to shift by 1. *)
(* the fibonacci numbers are 1, 2, 3, 5, 8, 13, 21, 34, ... *)
(* mod 2 they are 1, 0, 1, 1, 0, 1, 1, 0, ... *)
(* so we only need the numbers whose index is 2 mod 3 *)
(* this program uses the Fibonacci formula and adds every third *)
(* it does not require us to know ahead of time what the largest Fibonacci is under 4000000 *)
(* the argument below starts the sum at zero, starts our current at F[2], and then if the current value is less than 4000000 addds to our sum *)
(* note this uses the fact that we have a hard-coded formula for the Fibonaccis *)
(* if we don't want to use that we can just walk down by using the recurrence *)
Fib[n_] := Fibonacci[n+1];
n = 2;
sum = 0;
current = Fib[2];
While[current < 4000000,
{
sum = sum + current;
n = n + 3;
current = Fib[n];
}];
Print[sum]

(* this coe plays with things a bit so we can just experimentally find when we hit 4000000 *)
(* we then sum every third *)
Fib[32]
Sum[Fib[2+3*m],{m,0,10}]

(* we can also use Binet's formula and the fact that we have two geometric series *)
(* we have Fibonacci[n] = (1/Sqrt[5]) Phi^n - (1/Sqrt[5]) (1-Phi)^n *)
(* remembering to shift *)
(* could solve with geometric series formula *)
(* assuming we know how far to go, we also get the right answer *)
Phi = (1 + Sqrt[5])/2;
phi = 1 - Phi;
Simplify[(Phi/Sqrt[5]) Phi^2 ((1 - (Phi^3)^11)/(1-Phi^3)) - (phi/Sqrt[5]) phi^2 ((1 - (phi^3)^11)/(1-phi^3)) ]

(* Another possibility is to find a recurrence for just the evens:
a(n)=a(n-1)+a(n-2)
        =2 a(n-2)+a(n-3)
        =3 a(n-3)+2 a(n-4)
        =5 a(n-3)-2 a(n-5)
        =5 a(n-3)-2 a(n-4)+2 a(n-6)
        =5 a(n-3)-a(n-4)-a(n-5)+a(n-6)
        =4 a(n-3)+a(n-6)
this works and allows us to bypass mod conditions! *)

(* Mathematica has a factorization algorith so this could be very easy! *)
FactorInteger[600851475143]

(* A longer version is to use a list of primes *)
(* if you don't want to use a list of primes you can just divide by integers *)
(* for large numbers this will have problems, or numbers with a large prime factor *)
(* note we have to be careful about how often a prime divides a number *)
largest = 1;
current = 600851475143;
start = current;
current = 64 * 3;
n = 1;
p = Prime[n];
While[current > 1 && current ≤ Sqrt[start],
{
If[Mod[current,p] == 0,
{
current = current / p;
largest = p;
},
{
n = n + 1;
p = Prime[n];
}];
}];
Print[largest];

(* lots of ways to do this one, first one that made me stop for a bit *)
(* we could factor palindromic numbers and see which work *)
(* or we could multiply three digit numbers *)
(* we need a good test for palindromic *)
(* we can write a simple program that reverses the digits of a number *)
(* mathematica has a function that would give us the digits as a list, but fun to write a simple program to do this ourselves using modular arithmetic *)

reverse[num_] := Module[{},
digits = Ceiling[Log[10, num]];
newnum = 0;
temp = num;
For[d =1, d ≤   digits, d++,
{
x = Mod[temp,10];
newnum = newnum + x*10^(digits-d);
temp = (temp - x )/10;
}];
(*Print[newnum];*)
Return[newnum];
];
palindromecheck[n_] := If[n - reverse[n] ==  0, 1, 0];

max=0;
Timing[
For[a=999,a≥ 100,a--,
For[b=a,b≥ 100,b--,
{
curr = a * b;
If[palindromecheck[curr]==1 && curr > max, max = curr];
If[a b < max, b = 0]; (* exits loop *)
}];
];
]
Print[max];

(*largest = 1;
pair = {1,1};
For[x1 = 900, x1 ≤ 999, x1++,
For[x2 = 900, x2 ≤ 999, x2++,
{
prod = x1 x2;
If[prod > largest,
If[palindromecheck[prod] == 1,
{
largest = prod;
pair = {x1,x2};
}];
];
}]];
Print[largest,  " ", pair]*)

reverse[1034]
palindromecheck[9332]

The way to solve this is to note that the least common multiple is the product of all primes at most 20, where each prime is taken to the largest power so that it is still less than 20. Thus for the prime p, its power is r_p = log[p,20].

lcm[num_] := Product[Prime[n]^Floor[Log[Prime[n],1.0 num]], {n,1,PrimePi[num]}];
lcm[10]
lcm[20]

The sum of squares up to n is n(n+1)(2n-1)/6, while the square of the sum is (n(n+1)/2)^2. Thus the answer is

diffsquaring[n_] := (n(n+1)/2)^2 - n(n+1)(2n+1)/6
diffsquaring[10]
diffsquaring[100]

We should do this by the Sieve of Erasthones or some such, striking out the  numbers that are not prime from our list. We can also use pre-defined functions (cheating, I know!)

Prime[6]
Prime[10001]

bignum = ;
bignumlist = IntegerDigits[bignum];
prod = Product[bignumlist[[n]], {n,1,13}];
max = prod;
For[n = 14, n ≤ Length[bignumlist]-12, n++,
{
If[prod > 0, prod = prod * bignumlist[[n]] / bignumlist[[n-13]]];
If[prod > max, max = prod];
If[prod == 0, 
{
While[prod == 0 && n ≤ Length[bignumlist] - 13,
{
n=n+1;
prod = Product[bignumlist[[k]],{k,n-12,n}];
}
];
}];
}];
Print[max]

For[a= 1, a ≤ 1000/Sqrt[2], a++,
For[b = a, b ≤ (1000-a)/2, bn = 1++,
{
c = 1000-a-b;
If[a^2 + b^2 - c^2 == 0, Print[a b c]];
}]
];

sum = 0;
prime = 2;
While[prime < 2000000,
{
sum = sum + prime;
prime = NextPrime[prime];
}];
Print[sum]

list = {{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}};
maxprod = 0;
(* goes through horizontally, vertically and diagonally *)
(* as matrix is so small just do all products if inside *)

For[i = 1, i ≤ 20, i++,
For[j = 1, j ≤ 20, j++,
{
If[j+3 ≤ 20,
{
tempprod =  Product[list[[i,j+k]],{k,0,3}];
If[ tempprod> maxprod, maxprod = tempprod];
}];
If[i+3 ≤ 20,
{
tempprod =  Product[list[[i+k,j]],{k,0,3}];
If[ tempprod> maxprod, maxprod = tempprod];
}];
If[i+3 ≤ 20 && j+3 ≤ 20,
{
tempprod =  Product[list[[i+k,j+k]],{k,0,3}];
If[ tempprod> maxprod, maxprod = tempprod];
}];
If[i+3 ≤ 20 && j-3 ≥ 1,
{
tempprod =  Product[list[[i+k,j-k]],{k,0,3}];
If[ tempprod> maxprod, maxprod = tempprod];
}];
}]];
Print[maxprod]

(*TriangleNumber[n_]:=Sum[i,{i,1,n}];*)
trianglenumber[n_] := n(n+1)/2;
found = 0;
n = 1;
While[found == 0,
{
number = trianglenumber[n];
numdivisors = Length[Divisors[number]];
If[numdivisors≥ 501,
{
Print["Number is ",number,""];
Print["Number of divisors is ", numdivisors];
found = 1;
}];
n = n + 1;
};
]

problem13list = {37107287533902102798797998220837590246510135740250,
46376937677490009712648124896970078050417018260538,
74324986199524741059474233309513058123726617309629,
91942213363574161572522430563301811072406154908250,
23067588207539346171171980310421047513778063246676,
89261670696623633820136378418383684178734361726757,
28112879812849979408065481931592621691275889832738,
44274228917432520321923589422876796487670272189318,
47451445736001306439091167216856844588711603153276,
70386486105843025439939619828917593665686757934951,
62176457141856560629502157223196586755079324193331,
64906352462741904929101432445813822663347944758178,
92575867718337217661963751590579239728245598838407,
58203565325359399008402633568948830189458628227828,
80181199384826282014278194139940567587151170094390,
35398664372827112653829987240784473053190104293586,
86515506006295864861532075273371959191420517255829,
71693888707715466499115593487603532921714970056938,
54370070576826684624621495650076471787294438377604,
53282654108756828443191190634694037855217779295145,
36123272525000296071075082563815656710885258350721,
45876576172410976447339110607218265236877223636045,
17423706905851860660448207621209813287860733969412,
81142660418086830619328460811191061556940512689692,
51934325451728388641918047049293215058642563049483,
62467221648435076201727918039944693004732956340691,
15732444386908125794514089057706229429197107928209,
55037687525678773091862540744969844508330393682126,
18336384825330154686196124348767681297534375946515,
80386287592878490201521685554828717201219257766954,
78182833757993103614740356856449095527097864797581,
16726320100436897842553539920931837441497806860984,
48403098129077791799088218795327364475675590848030,
87086987551392711854517078544161852424320693150332,
59959406895756536782107074926966537676326235447210,
69793950679652694742597709739166693763042633987085,
41052684708299085211399427365734116182760315001271,
65378607361501080857009149939512557028198746004375,
35829035317434717326932123578154982629742552737307,
94953759765105305946966067683156574377167401875275,
88902802571733229619176668713819931811048770190271,
25267680276078003013678680992525463401061632866526,
36270218540497705585629946580636237993140746255962,
24074486908231174977792365466257246923322810917141,
91430288197103288597806669760892938638285025333403,
34413065578016127815921815005561868836468420090470,
23053081172816430487623791969842487255036638784583,
11487696932154902810424020138335124462181441773470,
63783299490636259666498587618221225225512486764533,
67720186971698544312419572409913959008952310058822,
95548255300263520781532296796249481641953868218774,
76085327132285723110424803456124867697064507995236,
37774242535411291684276865538926205024910326572967,
23701913275725675285653248258265463092207058596522,
29798860272258331913126375147341994889534765745501,
18495701454879288984856827726077713721403798879715,
38298203783031473527721580348144513491373226651381,
34829543829199918180278916522431027392251122869539,
40957953066405232632538044100059654939159879593635,
29746152185502371307642255121183693803580388584903,
41698116222072977186158236678424689157993532961922,
62467957194401269043877107275048102390895523597457,
23189706772547915061505504953922979530901129967519,
86188088225875314529584099251203829009407770775672,
11306739708304724483816533873502340845647058077308,
82959174767140363198008187129011875491310547126581,
97623331044818386269515456334926366572897563400500,
42846280183517070527831839425882145521227251250327,
55121603546981200581762165212827652751691296897789,
32238195734329339946437501907836945765883352399886,
75506164965184775180738168837861091527357929701337,
62177842752192623401942399639168044983993173312731,
32924185707147349566916674687634660915035914677504,
99518671430235219628894890102423325116913619626622,
73267460800591547471830798392868535206946944540724,
76841822524674417161514036427982273348055556214818,
97142617910342598647204516893989422179826088076852,
87783646182799346313767754307809363333018982642090,
10848802521674670883215120185883543223812876952786,
71329612474782464538636993009049310363619763878039,
62184073572399794223406235393808339651327408011116,
66627891981488087797941876876144230030984490851411,
60661826293682836764744779239180335110989069790714,
85786944089552990653640447425576083659976645795096,
66024396409905389607120198219976047599490197230297,
64913982680032973156037120041377903785566085089252,
16730939319872750275468906903707539413042652315011,
94809377245048795150954100921645863754710598436791,
78639167021187492431995700641917969777599028300699,
15368713711936614952811305876380278410754449733078,
40789923115535562561142322423255033685442488917353,
44889911501440648020369068063960672322193204149535,
41503128880339536053299340368006977710650566631954,
81234880673210146739058568557934581403627822703280,
82616570773948327592232845941706525094512325230608,
22918802058777319719839450180888072429661980811197,
77158542502016545090413245809786882778948721859617,
72107838435069186155435662884062257473692284509516,
20849603980134001723930671666823555245252804609722,
53503534226472524250874054075591789781264330331690};
Sum[problem13list[[n]],{n,1,Length[problem13list]}]

(*  debugging code *)
start = 111;
now = start;
f[x_] := If[Mod[x,2] == 1, 3x+1,x/2];
list = {};
While[now > 1,
{
list = AppendTo[list,now];
now = f[now];
}];
list = AppendTo[list,now];
Print[list, " ", Length[list]]

max = 1000000;
(*safety = 1;*)
maxlength = 0;
maxstart = 0;
For[n = 1, n ≤ max+5, n++,arraysteps[n] = 0];
Clear[f];
f[x_] := If[Mod[x,2] == 1, 3x+1,x/2];
arraysteps[1] = 1;
arraysteps[2] = 2;
(*arraysteps[3] = 8;*)
For[n = 3, n≤ max, n++,
{
temp = {};
steps = 0;
curr = n;
While[curr ≥ n && arraysteps[n] == 0,
{
temp = AppendTo[temp,curr];
steps = steps + 1;
curr = f[curr];
(*steps = steps + 1;*)
(*If[curr >  max && arraysteps[n] == 0,
{
Print["Exceed safety * max at ", curr];
curr = 0;
n = max + 10;
}]; (* end of if *)
*)
}]; (* end of while *)
For[j = 1, j ≤ Length[temp], j++,
{
x = temp[[j]];
If[x ≤ max && arraysteps[x] == 0,arraysteps[x] = steps + arraysteps[curr] - j +1];
}];

If[ arraysteps[n]  > maxlength,
{
maxlength = arraysteps[n];
maxstart = n;
}]; (* end of if *)
}]; 
(* end of n loop *)
Print["max n is ", maxstart, " and length was ", maxlength, "."];

arraysteps[7]

For[n = 1, n ≤ 20, n++, Print[n, " ", arraysteps[n]]]

(* we have a 20 by 20 grid *)
(* we have 20 downs and 20 rights *)
(* answer is (40 choose 20) *)
Binomial[40,20] Binomial[20,20]
path[n_] := Binomial[2n,n]
path[1]
path[2]
path[3]

(* we can do by a recurrence relation *)
(* if a(i,j) is how many paths from (i,j), so i downs and j rights *)
(* we have a(i,j) = a(i-1,j) + a(i,j-1) *)
(* start with a(1,0) = a(0,1) = 1 *)
(* note a(i,0) = 1 and a(0,i) = 1 *)
(* we would get a(1,1) = a(1,0) + a(0,1) = 2 *)
(* to get to a(2,2) we need a(2,1) and a(1,2) first *)
(* fortunately a(i,j) and a(j,i) are equal *) (* replace down with right... *)
(* so a(2,1) = a(2,0) + a(1,1) *)
(* thus a(2,1) = 1 + 2 = 3 *)
(* thus a(2,2) = a(2,1) + a(1,2) = 6 *)
(* more generally a(i,i) = a(i-1,i) + a(i,i-1) = 2 a(i-1,i) *)
Clear[a]; (* clears a *)

For[i = 1, i ≤ 40, i++,
For[j  = 1, j ≤ 40, j++, a[i,j] = 0]]; (* initialize all to 0 *)

a[0,0] = 0; (* these are some initial knowns *)
a[1,0] = a[0,1] = 1;
a[1,1] = 2;
a[2,0] = a[0,2] = 1;
a[2,1] = a[1,2] = 3;
a[2,2] = 6;
For[i = 3, i ≤ 20, i++, a[i,0] = a[0,i] = 1]; 

(* now we build up our 2-dim recurrence values, using a(i,j) = a(i-1,j) + a(i,j-1) *)
For[i = 3, i ≤ 20, i++,
For[j = 1, j ≤ i, j++,
{
a[i,j] = a[i-1,j] + a[i,j-1]; (* our recurrence *)
a[j,i] = a[i,j]; (* note must fill in symmetrically *)
}]; (* end of j loop *)
]; (* end of i loop *)

a[3,2] (* checking some values, answering the problem *)
a[3,3]
Print["We get for 20 ups and 20 downs ", a[20,20], "."];
Print["The answer is ", Binomial[40,20], "."];

num = 2^1000;
numstring = IntegerDigits[num];
Sum[numstring[[n]],{n,1,Length[numstring]}]

Solution by my student Elliot Chester

Timing[sundays = 0(*We start our running total at 0*); start  = 2(*January 1, 1901 was a Tuesday, which is 2 mod 7. We call Sunday 0 mod 7.*);
(*A loop for each month over our 100 year period*)For[which = 1, which <1200,which++,
(*The 31 day months, which push the start of the next month back three days (ie January/Monday --> February/Thursday. So if one of these months starts *)If[Mod[which,12]==1||Mod[which,12]==3||Mod[which,12]==5||Mod[which,12]==7||Mod[which,12]==8||Mod[which,12]==10||Mod[which,12]==0, start = Mod[start+3,7]];
(*The 30 day months, which take general form June/Monday --> July/Wednesday*)
If[ Mod[which,12]==4 ||Mod[which,12]==6||Mod[which,12]==9||Mod[which,12]==11,start = Mod[start+2,7]];
(*February in leap years,where February/Monday --> March/Tuesday. Leap Februaries are the 38th month in a 48 (4-month) cycle.
Normal Februaries are exactly 4 weeks long, only Februaries that start on a Sunday add another Sunday
NOTE: This code does NOT fully account for the century leap year rule*)
If[Mod[which,12]==2 && Mod[which,48]==38,start=Mod[start+1,7]];
(*This line says, "If a month starts on a Sunday, add a Sunday to our running total*)
If[start==0,sundays+=1];
]
Print[sundays]]

(*A solution from the message boards that is a lot neater, since apparently Mathematica knows about dates. That's cheating, though :) Besides, mine runs faster, even if as noted it is not generalizable to arbitrary year ranges quite yet*)Timing[interval=With[{first={1901,1,1},last={2000,12,31}},DateRange[first,last,"Month"]];
Tally[DayName/@interval]]

list = IntegerDigits[100!];
Sum[list[[n]],{n,1,Length[list]}]

sum = 0;
For[a = 1, a ≤ 10000, a++,
{
b = DivisorSigma[1,a]-a;
divb = DivisorSigma[1,b]-b;
If[divb == a && a < b && b < 10000, sum = sum + a+b;];
}];
Print[sum];

DivisorSigma[1,15]-15

f[n_] := DivisorSigma[1,n]-n
list = {};
For[n=2, n ≤ 28123, n++, If[f[n] > n, list = AppendTo[list,n]]]
newlist = {};
Print["The length of the list is ", Length[list]];

(*For[n= 1, n ≤ Length[list], n++,
{
If[Mod[n,400] == 0, Print["We are at ", n, " of ", Length[list], " and found ", Length[newlist]]];
x = list[[n]];
For[m = 1, m ≤ n, m++,
{
y = list[[m]];
If[x+y > 28123, m = 2n+ 100,
If[MemberQ[newlist,x+y] == False, newlist = AppendTo[newlist, x+y]];];
}];
}];
Print["Found ", Length[newlist]];
sum = 0;
For[n = 1, n ≤ 28123, n++, If[MemberQ[newlist,n] == False, sum = sum+n]];*)

sum = Sum[i, {i,1,23}];
(*  first number sum two abundants is 24 *)
Print["Number abundants is ", Length[list]];
For[n = 25, n ≤ 28123, n++, 
{
If[Mod[n,400] == 0, Print["We are at ", n, " of 28123 and sum is ", sum,"."]];
work = 0;
For[i = 1, i ≤ Length[list], i++.
{
x = n - list[[i]];
If[x <0, i = 30000,
{
If[MemberQ[list,x] == True, 
{
work = 1;
i = 30000;
}];
}];
}]; (* end of i loop *)
If[work == 0, sum = sum + n];
}];
Print["Sum is ", sum]

n

;
fib[n_] := (1/Sqrt[5])((1+Sqrt[5])/2)^n - (1/Sqrt[5])((1-Sqrt[5])/2)^n ;
fibapprox[n_] := (1/Sqrt[5])((1+Sqrt[5])/2)^n;
napprox = (999Log[10] - Log[1./Sqrt[5]]) / Log[(1+Sqrt[5])/2]

Log[10.,Fibonacci[4782]]

(* there are only finitely many, and eventually 10^n grows faster than a lot of 9s*)
(* I gambled at first -- I checked up to a large number and hoped it found all *)
(* fortunately the only way we can get such a large number is to essentially have almost all 9s *)
(* even one digit of 8^5 instead of 9^5 is bad *)
(* seven 9's gives 7 9^5 = 413343 which is too small, as it is less than 1000000 *)
(* thus we only need to check up to 413343 and that'll speed things up *)

numwork = 0;
runningsum = 0;
For[n = 10, n ≤ 10000000, n++,
{
temp = IntegerDigits[n];
If[n == Sum[temp[[i]]^5,{i,1,Length[temp]}],{Print[n]; numwork = numwork+1; runningsum = runningsum + n;}];
}];
Print[numwork, " ", runningsum]

8^5
7 9^5

S=200;
num=1; (* from using the 200 pence coin *)
For[a=0,a≤Floor[S/100],a++,For[b=0,b≤Floor[(S-a*100)/50],b++,For[c=0,c≤Floor[(S-a*100-b*50)/20],c++,For[d=0,d≤Floor[(S-a*100-b*50-c*20)/10],d++,For[e=0,e≤Floor[(S-a*100-b*50-c*20-d*10)/5],e++,For[f=0,f≤Floor[(S-a*100-b*50-c*20-d*10-e*5)/2],f++,num=num+1]]]]]]
Print[num]

prod = 1;
For[a = 1, a ≤ 9, a++,
For[b = 1, b ≤ 9, b++,
For[c = 1, c ≤ 9, c++,
{
x = (10a+b)/(10*b+c);
y = (10a+b)/(10*c+a);
If[x == a/c && x < 1, prod = prod * a/c];
If[x ≠ y&& y == b/c && y < 1, prod = prod*b/c];
}]]];
prod = Simplify[prod];
Print[prod]

numcircle = 0;
numprimes = PrimePi[1000000];
For[n = 1, n ≤ numprimes, n++,
{
temp = IntegerDigits[Prime[n]];
length = Length[temp];
For[i = 1, i ≤ length, i++, temp  = AppendTo[temp,temp[[i]]]];
primecheck = 1;
For[i = 1, i ≤ length, i++,
{
num = Sum[10^(length-j) temp[[i-1+j]], {j,1,length}];
If[PrimeQ[num] == False,{primecheck = 0; i = length + 100;}];
}];
If[primecheck == 1, numcircle = numcircle + 1];
}];
Print[numcircle];

goldbachtest[n_] := Module[{},
check = 1;
For[m = 1, m ≤ Sqrt[n/2], m++,
If[PrimeQ[n - 2m^2] == True,
{
m = 2n+10;
check = 0;
}];
];
Return[check];
(*Print[check];*)
]
max =     20000001;
start = 11;
For[n = start, n ≤ max, n= n+2,
{
(*Print[n, " ",  goldbachtest[n]];*)
If[PrimeQ[n] == False,
If[goldbachtest[n] == 1,
{
Print["n is ", n];
n = max + 5;
}];
];
}];

Sum[Mod[n^n,10^10],{n,1,1000}]
(* better to do fast exponentiation but... *)

A=0
Timing[For[n=1,n≤100,n++,{For[r=1,r≤n/2,r++,{If[Binomial[n,r]>1000000,{If[r==n/2,A=A+1,A=A+2]};]};]};]]
Print["",A,""]

max = 0;
For[a = 2, a ≤ 100, a++,
For[b = 2, b ≤ 100, b++,
{
temp = IntegerDigits[a^b];
sum = Sum[temp[[i]],{i,1,Length[temp]}];
If[sum > max, max = sum];
}]];
Print[max]

count = 0;
For[n = 1, n ≤ 1000, n++,
{
x = FromContinuedFraction[ContinuedFraction[Sqrt[2],n]];
num = Numerator[x];
denom = Denominator[x];
If[Floor[Log[10.,num]] > Floor[Log[10.,denom]], count = count+1];
}];
Print[count]

max = 0;
For[n = 1, n ≤ 1000000, n++, 
{
temp =n/EulerPhi[n];
If[temp > max, 
{
max = temp;
nmax = n;
}]
}];
Print[nmax, " ", max];