# Euler problems/131 to 140

(Difference between revisions)
Jump to: navigation, search

## 1 Problem 131

Determining primes, p, for which n3 + n2p is a perfect cube.

Solution:

```primes=sieve [2..]
sieve (x:xs)=x:sieve [y|y<-xs,mod y x>0]
primeFactors n = factor n primes
where
factor _ [] = []
factor m (p:ps) | p*p > m        = [m]
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)
| otherwise      = factor m ps

isPrime n = case (primeFactors n) of
(_:_:_)   -> False
_         -> True
problem_131 =
length \$ takeWhile (<1000000)
[x|
a<-[1 .. ],
let x=(3*a*(a+1)+1),
isPrime x]```

## 2 Problem 132

Determining the first forty prime factors of a very large repunit.

Solution:

```-- primes powMod in problem_133
fun x =
(powMod x 10 n)==1
where
n=10^9
--add 3
p132 =sum\$take 41 [a|a<-primes,fun a]
problem_132 =p132-3```

## 3 Problem 133

Investigating which primes will never divide a repunit containing 10n digits.

Solution:

```import Data.List
mulMod :: Integral a => a -> a -> a -> a
mulMod a b c= (b * c) `rem` a
squareMod :: Integral a => a -> a -> a
squareMod a b = (b * b) `rem` a
pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a
pow' _ _ _ 0 = 1
pow' mul sq x' n' = f x' n' 1
where
f x n y
| n == 1 = x `mul` y
| r == 0 = f x2 q y
| otherwise = f x2 q (x `mul` y)
where
(q,r) = quotRem n 2
x2 = sq x
powMod :: Integral a => a -> a -> a -> a
powMod m = pow' (mulMod m) (squareMod m)

merge xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (merge xt ys)
EQ -> x : (merge xt yt)
GT -> y : (merge xs yt)

diff  xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (diff xt ys)
EQ -> diff xt yt
GT -> diff xs yt

primes, nonprimes :: [Integer]
primes    = [2,3,5] ++ (diff [7,9..] nonprimes)
nonprimes = foldr1 f . map g \$ tail primes
where f (x:xt) ys = x : (merge xt ys)
g p = [ n*p | n <- [p,p+2..]]
fact25 m
| m `mod` 2 == 0 = 2 : fact25 (m `div` 2)
| m `mod` 5 == 0 = 5 : fact25 (m `div` 5)
| otherwise      = []
fun x
|n==x-1=True
|otherwise= (powMod x 10 n)==1
where
n=product\$fact25 (x-1)
--miss 2 3 5
test =sum\$takeWhile (<100)[a|a<-primes,not\$fun a]
p133 =sum\$takeWhile (<100000)[a|a<-primes,not\$fun a]
problem_133 = p133+2+3+5```

## 4 Problem 134

Finding the smallest positive integer related to any pair of consecutive primes.

Solution:

```merge xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (merge xt ys)
EQ -> x : (merge xt yt)
GT -> y : (merge xs yt)

diff  xs@(x:xt) ys@(y:yt) = case compare x y of
LT -> x : (diff xt ys)
EQ -> diff xt yt
GT -> diff xs yt

primes, nonprimes :: [Integer]
primes    = [2,3,5] ++ (diff [7,9..] nonprimes)
nonprimes = foldr1 f . map g \$ tail primes
where f (x:xt) ys = x : (merge xt ys)
g p = [ n*p | n <- [p,p+2..]]

problem_134 :: Integer
problem_134 = sum xs
where
ps = drop 2 primes
ds = takeWhile ((< 10^6) . fst) \$ zip ps (tail ps)
xs = map (uncurry func) ds

expo :: Integer -> Int
expo = length . show

find :: Integer -> Integer -> (Integer, Integer)
find a b = findStep a 1 0 b 0 1

findStep :: Integer -> Integer -> Integer -> Integer -> Integer
-> Integer -> (Integer, Integer)
findStep a x1 x2 b y1 y2 =
case divMod a b of
(q,0) -> (x2, y2)
(q,r) -> findStep b x2 (x1-q*x2) r  y2 (y1-q*y2)

checkL :: Integer -> Integer -> (Integer,Integer)
checkL 0 _ = (-1,1)
checkL n d
= let (u,v) = find n d
in if u <= 0 then (n-v,d+u) else (-v,u)

func :: Integer -> Integer -> Integer
func p1 p2
= n*p2
where
md = 10^(expo p1)
(_,h) = checkL p2 md
n = p1*h `mod` md```

## 5 Problem 135

Determining the number of solutions of the equation x2 − y2 − z2 = n.

Solution:

```import Control.Monad
import Data.List
import Data.Array.ST
import Control.Monad.ST
import Control.Monad.Cont

--  ghc -package mtl p135.hs
p135 m = runST (do
counts <- newArray (1,m-1) 0 :: ST s (STUArray s Int Int)

forM_ [1 .. m - 1] \$ \ x ->
forM_' [x `div` 3 + 1 .. m `div` 2] \$ \ break n ->

let t = (n + x) * (3 * n - x)
in if t < m
then lift \$ incArray counts t
else break ()

xs <- getElems counts
return \$ length \$ filter (==10) xs)

where
forM_' xs f = flip runContT return \$ callCC \$ forM_ xs . f

incArray arr index = do
v <- readArray arr index
writeArray arr index (v + 1)
main=appendFile "p135.log"\$show \$p135 (10^6)
problem_135=main```

Another solution by expressing x, y, z as n+k, n, n-k, then x^2 - y^2 - z^2 = n*(4*k - n):

```import Data.Array
prob_135 = concat
[takeWhile ((<1000000).fst)
[(r,1)|k <- [1+(n`div`4)..n-1], let r = n*(4*k-n)] |n <- [1..1000000]]
main = putStrLn \$ show \$ length \$
filter ((==10).snd) \$ assocs \$ accumArray (+) 0 (1,1000000) prob_135```

## 6 Problem 136

Discover when the equation x2 − y2 − z2 = n has a unique solution.

Solution:

```import List
find2km :: Integral a => a -> (a,a)
find2km n = f 0 n
where
f k m
| r == 1 = (k,m)
| otherwise = f (k+1) q
where (q,r) = quotRem m 2

millerRabinPrimality :: Integer -> Integer -> Bool
millerRabinPrimality n a
| a <= 1 || a >= n-1 =
error \$ "millerRabinPrimality: a out of range ("
++ show a ++ " for "++ show n ++ ")"
| n < 2 = False
| even n = False
| b0 == 1 || b0 == n' = True
| otherwise = iter (tail b)
where
n' = n-1
(k,m) = find2km n'
b0 = powMod n a m
b = take (fromIntegral k) \$ iterate (squareMod n) b0
iter [] = False
iter (x:xs)
| x == 1 = False
| x == n' = True
| otherwise = iter xs

pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a
pow' _ _ _ 0 = 1
pow' mul sq x' n' = f x' n' 1
where
f x n y
| n == 1 = x `mul` y
| r == 0 = f x2 q y
| otherwise = f x2 q (x `mul` y)
where
(q,r) = quotRem n 2
x2 = sq x

mulMod :: Integral a => a -> a -> a -> a
mulMod a b c = (b * c) `mod` a
squareMod :: Integral a => a -> a -> a
squareMod a b = (b * b) `rem` a
powMod :: Integral a => a -> a -> a -> a
powMod m = pow' (mulMod m) (squareMod m)
isPrime x=all (millerRabinPrimality x) [2,3,7,61]
nextPrime x=head [a|a<-[(x+1)..],isPrime a]
lazyPrimeSieve :: [Integer] -> [Integer]
lazyPrimeSieve [] = []
lazyPrimeSieve (x:xs) = x : (lazyPrimeSieve \$ filter (\y -> y `rem` x /= 0) xs)

oddPrimes :: [Integer]
oddPrimes = lazyPrimeSieve [3,5..]
fun =2+sum[testPrime a|a<-takeWhile (<100) oddPrimes]
limit=50000000
groups=1000000
fillmap num total rlimit=do
let a=nextPrime num
if a>rlimit then
return  total
else do
let b=testPrime a
fillmap (a+1) (total+b) rlimit
testPrime p =p1+p2+p3
where
p1=if p`mod`4==3 then 1 else 0
p2=if p*4<limit then 1 else 0
p3=if p*16<limit then 1 else 0
problem_136 b=fillmap ming 0 maxg
where
ming=b*groups
maxg=(b+1)*groups
google
-- write file to change bignum to small num
= forM_ [1..49] \$ \num ->
do t1<-problem_136 num
appendFile "file.log" \$show t1  ++ "\n"
main=do
appendFile "file.log" \$show fun  ++ "\n"
k<-fillmap 100 0 groups
appendFile "file.log" \$show k  ++ "\n"
google
problem_136a=do
s<-readFile "file.log"
print\$sum\$map read\$lines s```

## 7 Problem 137

Determining the value of infinite polynomial series for which the coefficients are Fibonacci numbers.

Solution:

```-- afx=x/(1-x-x^2)=n
--   ->5*n^2+2*n+1=d^2
--   ->let k=10*n+2
--   ->20*d^2=k^2+16
--   ->5*d^2=k^2+4
--   ->let d k is even
--   ->5*d^2=k^2+1
--   ->let d k is odd
--   ->5*d^2=k^2+4

import Data.List
findmin d =
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d*m*m+1
]
findmin_s d =
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d*m*m-1
]
findmu d y=
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d-y*m
]
mux2 [d,a, b]=[d,a,-b]
mult [d,a, b] [_,a1, b1]=
d:[a*a1+d*b*b1,a*b1+b*a1]
pow 1 x=x
pow n x =mult x \$pow (n-1) x
where
mult [d,a, b] [_,a1, b1]=[d,a*a1+d*b*b1,a*b1+b*a1]
fun =[c|
a<-[1..20],
[_,b,_]<-powmu a,
let bb=abs b,
bb`mod`5==1,
let c=bb`div`5
]
powmu n =
[a,b]
where
c=pow n \$findmin 5
x1=findmu 5 4
x2=mux2 x1
a=mult c x1
b=mult c x2
fun2=[c|
a<-[1..20],
let[_,b,_]=pow a \$findmin_s 5,
let bb=b*2,bb`mod`5==1,
let c=bb`div`5
]
problem_137 =(!!14)\$sort \$(++fun)\$fun2```

## 8 Problem 138

Investigating isosceles triangle for which the height and base length differ by one.

Solution:

```{-
- 4*m^2-16*m*n-4*n^2+1=0
- 4*m^2-16*m*n-4*n^2-1=0
- (m-2*n)^2-5*n^2=1
- (m-2*n)^2-5*n^2=-1
-}
import Data.List
mult [d,a, b] [_,a1, b1]=
[d,a*a1+d*b*b1,a*b1+b*a1]
pow 1 x=x
pow n x =mult x \$pow (n-1) x
where
mult [d,a, b] [_,a1, b1]=[d,a*a1+d*b*b1,a*b1+b*a1]
-- 2^2-5*1^2=-1
-- so [5,2,1]
fun =
[d^2+c^2|
a<-[1..20],
let [_,b,c]=pow a [5,2,1],
let d=2*c+b
]
-- 9^2-5*4^2=1
-- so [5,9,4]
fun2 =
[d^2+c^2|
a<-[1..20],
let [_,b,c]=pow a [5,9,4],
let d=2*c+b
]
problem_138 =sum\$take 12 \$nub\$sort (fun++fun2)```

## 9 Problem 139

Finding Pythagorean triangles which allow the square on the hypotenuse square to be tiled.

Solution:

```{-
-                              2                        2
-                     (n - 1) y  - 2 n x y + (- n - 1) x  = 0
--->
-                                           2       2       2
-                          ((n - 1) y - n x)  = (2 n  - 1) x
--->
-                       2        2
-                    2 n  - 1 = k
-
-}
import Data.List
mult [d,a, b] [_,a1, b1]=
[d,a*a1+d*b*b1,a*b1+b*a1]
pow 1 x=x
pow n x =mult x \$pow (n-1) x
div2 [x,y,z]
|even x && even y && even z=
[x`div`2,y`div`2,z`div`2]
|otherwise=[x,y,z]
-- 1^2-2*1^2=-1
-- so [2,1,1]
fun =map div2 [
side
|a<-[3,5..40],
let [_,k,n]=pow a [2,1,1],
let m=lcm (n+k) (n-1),
let x=m`div`(n+k),
let y=m`div`(n-1),
let side=[y^2-x^2, 2*x*y, y^2+x^2]
]
limit=100000000
problem_139=sum [limit `div` sum a|a<-fun,  sum a<limit]```

## 10 Problem 140

Investigating the value of infinite polynomial series for which the coefficients are a linear second order recurrence relation.

Solution:

```{-
2
3 x  + x
agx= ------------
2
- x  - x + 1
--->
2             2
5 n  + 14 n + 1=d

--->                          k = 10 n + 14
--->                          20*d^2=k^2-176
--->                          k = 5 n + 2
--->                          5*d^2=k^2-44
-}
import Data.List
findmin d =
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d*m*m+1
]
findmin_s d =
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d*m*m+1
]
findmu d y=
d:head [[n,m]|
m<-[1..10],
n<-[1..10],
n*n==d+y*m
]
mux2 [d,a, b]=[d,a,-b]
mult [d,a, b] [_,a1, b1]=[d,a*a1+d*b*b1,a*b1+b*a1]
div2 [d,a, b] =[d,a`div`2,b`div`2]
pow 1 x=x
pow n x =mult x \$pow (n-1) x
fun =
[c|
a<-[1..20],
[_,b,_]<-powmu a,
let bb=abs b,
bb`mod`5==2,
let c=bb`div`5
]
fun2=
[c|
a<-[1..20],
[_,b,_]<-powmu1 a ,
let bb=(abs b)*2,
bb`mod`5==2,
let c=bb`div`5
]
powmu n =
[a,b,a1,a2,b1,b2]
where
c=pow n \$findmin 5
x1=findmu 5 44
x2=mux2 x1
a=mult c x1
b=mult c x2
a1=div2\$mult a [5,3, -1]
a2=div2\$mult a [5,3, 1]
b1=div2\$mult b [5,3, -1]
b2=div2\$mult b [5,3, 1]
powmu1 n =
[a,b]
where
c=pow n \$findmin_s 5
x1=findmu 5 11
x2=mux2 x1
a=mult c x1
b=mult c x2
problem_140 =sum \$take 30 [a-1|a<-nub\$sort (fun++fun2)]```