Difference between revisions of "Euler problems/131 to 140"
Line 30: | Line 30: | ||
<haskell> |
<haskell> |
||
-- primes powMod in problem_133 |
-- primes powMod in problem_133 |
||
− | fun x = |
+ | fun x = |
+ | (powMod x 10 n)==1 |
||
where |
where |
||
n=10^9 |
n=10^9 |
||
Line 77: | Line 78: | ||
where f (x:xt) ys = x : (merge xt ys) |
where f (x:xt) ys = x : (merge xt ys) |
||
g p = [ n*p | n <- [p,p+2..]] |
g p = [ n*p | n <- [p,p+2..]] |
||
+ | fact25 m |
||
− | fact25 m | m `mod` 2 == 0 = 2 : fact25 (m `div` 2) |
||
− | + | | m `mod` 2 == 0 = 2 : fact25 (m `div` 2) |
|
− | + | | m `mod` 5 == 0 = 5 : fact25 (m `div` 5) |
|
+ | | otherwise = [] |
||
fun x |
fun x |
||
|n==x-1=True |
|n==x-1=True |
||
Line 116: | Line 118: | ||
dign x=(+1)$floor$logBase 10$fromInteger x |
dign x=(+1)$floor$logBase 10$fromInteger x |
||
− | + | extEuclid x1 x2 x3 y1 y2 1=(x3,y2) |
|
− | + | extEuclid x1 x2 x3 y1 y2 y3 |
|
=euler y1 y2 y3 t1 t2 t3 |
=euler y1 y2 y3 t1 t2 t3 |
||
where |
where |
||
Line 126: | Line 128: | ||
-- mod (x*a) y = 1 |
-- mod (x*a) y = 1 |
||
-- mod (y*b) x = 1 |
-- mod (y*b) x = 1 |
||
− | congrue x y |x>y= |
+ | congrue x y |x>y= extEuclid 1 0 x 0 1 y |
|otherwise =(a,b) |
|otherwise =(a,b) |
||
where |
where |
||
Line 146: | Line 148: | ||
groups=1000 |
groups=1000 |
||
− | funsum k=sum[fastfun a| |
+ | funsum k=sum[fastfun a| |
+ | a<-[1+k*groups..groups*(k+1)] |
||
+ | ] |
||
google num |
google num |
||
Line 209: | Line 213: | ||
|otherwise=[] |
|otherwise=[] |
||
− | slowfun x =[a| |
+ | slowfun x =[a| |
+ | a<-factors x, |
||
+ | a*a<3*x, |
||
+ | let b=div x a, |
||
+ | mod (a+b) 4==0 |
||
+ | ] |
||
− | problem_135 =[a| |
+ | problem_135 =[a| |
+ | a<-[1..groups], |
||
+ | (length$fastfun a)==10 |
||
+ | ] |
||
</haskell> |
</haskell> |
||
Line 221: | Line 233: | ||
-- fastfun in the problem 135 |
-- fastfun in the problem 135 |
||
groups=1000000 |
groups=1000000 |
||
− | pfast=[a| |
+ | pfast=[a| |
− | + | a<-[1..5000], |
|
+ | (length$fastfun a)==1 |
||
+ | ] |
||
+ | pslow=[a| |
||
+ | a<-[1..5000], |
||
+ | (length$slowfun a)==1 |
||
+ | ] |
||
-- find len pfast=len pslow+2 |
-- find len pfast=len pslow+2 |
||
-- so sum file.log and +2 |
-- so sum file.log and +2 |
||
− | problem_136 b=[a| |
+ | problem_136 b=[a| |
+ | a<-[1+b*groups..groups*(b+1)], |
||
+ | (length$fastfun a)==1 |
||
+ | ] |
||
google num |
google num |
||
-- write file to change bignum to small num |
-- write file to change bignum to small num |
||
Line 251: | Line 272: | ||
import Data.List |
import Data.List |
||
+ | findmin d = |
||
− | findmin d = d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d*m*m+1] |
||
− | + | 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] |
mux2 [d,a, b]=[d,a,-b] |
||
− | mult [d,a, b] [_,a1, b1]= |
+ | mult [d,a, b] [_,a1, b1]= |
+ | d:[a*a1+d*b*b1,a*b1+b*a1] |
||
pow 1 x=x |
pow 1 x=x |
||
pow n x =mult x $pow (n-1) x |
pow n x =mult x $pow (n-1) x |
||
where |
where |
||
mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] |
mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] |
||
+ | fun =[c| |
||
− | fun =[c|a<-[1..20],[_,b,_]<-powmu a,let bb=abs(b),mod bb 5==1,let c=div bb 5] |
||
+ | a<-[1..20], |
||
+ | [_,b,_]<-powmu a, |
||
+ | let bb=abs(b), |
||
+ | mod bb 5==1, |
||
+ | let c=div bb 5 |
||
+ | ] |
||
powmu n = |
powmu n = |
||
[a,b] |
[a,b] |
||
Line 269: | Line 312: | ||
a=mult c x1 |
a=mult c x1 |
||
b=mult c x2 |
b=mult c x2 |
||
+ | fun2=[c| |
||
− | fun2=[c|a<-[1..20],let[_,b,_]=pow a $findmin_s 5,let bb=b*2,mod bb 5==1,let c=div bb 5] |
||
+ | a<-[1..20], |
||
+ | let[_,b,_]=pow a $findmin_s 5, |
||
+ | let bb=b*2,mod bb 5==1, |
||
+ | let c=div bb 5 |
||
+ | ] |
||
problem_137 =(!!14)$sort $(++fun)$fun2 |
problem_137 =(!!14)$sort $(++fun)$fun2 |
||
</haskell> |
</haskell> |
||
Line 285: | Line 333: | ||
-} |
-} |
||
import Data.List |
import Data.List |
||
− | mult [d,a, b] [_,a1, b1]= |
+ | mult [d,a, b] [_,a1, b1]= |
+ | d:[a*a1+d*b*b1,a*b1+b*a1] |
||
pow 1 x=x |
pow 1 x=x |
||
pow n x =mult x $pow (n-1) x |
pow n x =mult x $pow (n-1) x |
||
Line 292: | Line 341: | ||
-- 2^2-5*1^2=-1 |
-- 2^2-5*1^2=-1 |
||
-- so [5,2,1] |
-- so [5,2,1] |
||
+ | fun = |
||
− | fun =[d^2+c^2|a<-[1..20],let [_,b,c]=pow a [5,2,1],let d=2*c+b] |
||
+ | [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 |
-- 9^2-5*4^2=1 |
||
-- so [5,9,4] |
-- so [5,9,4] |
||
+ | fun2 = |
||
− | fun2 =[d^2+c^2|a<-[1..20],let [_,b,c]=pow a [5,9,4],let d=2*c+b] |
||
+ | [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) |
problem_138 =sum$take 12 $nub$sort (fun++fun2) |
||
</haskell> |
</haskell> |
||
Line 316: | Line 375: | ||
-} |
-} |
||
import Data.List |
import Data.List |
||
− | mult [d,a, b] [_,a1, b1]= |
+ | mult [d,a, b] [_,a1, b1]= |
+ | d:[a*a1+d*b*b1,a*b1+b*a1] |
||
pow 1 x=x |
pow 1 x=x |
||
pow n x =mult x $pow (n-1) 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] |
||
div2 [x,y,z] |
div2 [x,y,z] |
||
|mod x 2==0 && mod y 2==0 && mod z 2==0= |
|mod x 2==0 && mod y 2==0 && mod z 2==0= |
||
Line 361: | Line 419: | ||
-} |
-} |
||
import Data.List |
import Data.List |
||
+ | findmin d = |
||
− | findmin d = d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d*m*m+1] |
||
− | + | 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] |
mux2 [d,a, b]=[d,a,-b] |
||
mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] |
mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] |
||
Line 369: | Line 442: | ||
pow 1 x=x |
pow 1 x=x |
||
pow n x =mult x $pow (n-1) x |
pow n x =mult x $pow (n-1) x |
||
+ | fun = |
||
− | where |
||
+ | [c| |
||
− | mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] |
||
+ | a<-[1..20], |
||
− | fun =[c|a<-[1..20],[_,b,_]<-powmu a,let bb=abs(b),mod bb 5==2,let c=div bb 5] |
||
+ | [_,b,_]<-powmu a, |
||
− | fun2=[c|a<-[1..20],[_,b,_]<-powmu1 a ,let bb=(abs b)*2,mod bb 5==2,let c=div bb 5] |
||
+ | let bb=abs(b), |
||
+ | mod bb 5==2, |
||
+ | let c=div bb 5 |
||
+ | ] |
||
+ | fun2= |
||
+ | [c| |
||
+ | a<-[1..20], |
||
+ | [_,b,_]<-powmu1 a , |
||
+ | let bb=(abs b)*2, |
||
+ | mod bb 5==2, |
||
+ | let c=div bb 5 |
||
+ | ] |
||
powmu n = |
powmu n = |
||
[a,b,a1,a2,b1,b2] |
[a,b,a1,a2,b1,b2] |
Revision as of 06:26, 6 January 2008
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]
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
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
Problem 134
Finding the smallest positive integer related to any pair of consecutive primes.
Solution:
import List
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..]]
dign x=(+1)$floor$logBase 10$fromInteger x
extEuclid x1 x2 x3 y1 y2 1=(x3,y2)
extEuclid x1 x2 x3 y1 y2 y3
=euler y1 y2 y3 t1 t2 t3
where
(k,t3)=divMod x3 y3
t1=x1-k*y1
t2=x2-k*y2
-- find a ,b
-- mod (x*a) y = 1
-- mod (y*b) x = 1
congrue x y |x>y= extEuclid 1 0 x 0 1 y
|otherwise =(a,b)
where
(b,a)=congrue y x
--fastfun 7=1219
fastfun x
|x==1=0
|p1>1000000=0
|otherwise= a*d+p1
where
p1=primes!!x
p2=primes!!(x+1)
dp=p2-p1
d=10^dign p1
dmod=mod d p2
eu=(+p2)$fst$congrue dmod p2
a=mod (eu*dp) p2
groups=1000
funsum k=sum[fastfun a|
a<-[1+k*groups..groups*(k+1)]
]
google num
-- write file to change bignum to small num
=if (num>79)
then return()
else do appendFile "file.log" $(show$funsum num) ++" "++(show num) ++"\n"
google (num+1)
-- first use main to make file.log
-- then run problem_134
main=google 0
split :: Char -> String -> [String]
split = unfoldr . split'
split' :: Char -> String -> Maybe (String, String)
split' c l
| null l = Nothing
| otherwise = Just (h, drop 1 t)
where (h, t) = span (/=c) l
sToInt x=((+0).read) $head$split ' ' x
problem_134=do
x<-readFile "file.log"
let y=sum$map sToInt $lines x
print y
Problem 135
Determining the number of solutions of the equation x2 − y2 − z2 = n.
Solution:
import List
primes :: [Integer]
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]
primeFactors :: Integer -> [Integer]
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 :: Integer -> Bool
isPrime 1 = False
isPrime n = case (primeFactors n) of
(_:_:_) -> False
_ -> True
fstfac x = [(head a ,length a)|a<-group$primeFactors x]
fac [(x,y)]=[x^a|a<-[0..y]]
fac (x:xs)=[a*b|a<-fac [x],b<-fac xs]
factors x=fac$fstfac x
fastfun x
|mod x 4==3=[a|a<-factors x,a*a<3*x]
|mod x 16==4=[a|let n=div x 4,a<-factors n,a*a<3*n]
|mod x 16==12=[a|let n=div x 4,a<-factors n,a*a<3*n]
|mod x 16==0=[a|let n=div x 16,a<-factors n,a*a<3*n]
|otherwise=[]
slowfun x =[a|
a<-factors x,
a*a<3*x,
let b=div x a,
mod (a+b) 4==0
]
problem_135 =[a|
a<-[1..groups],
(length$fastfun a)==10
]
Problem 136
Discover when the equation x2 − y2 − z2 = n has a unique solution.
Solution:
-- fastfun in the problem 135
groups=1000000
pfast=[a|
a<-[1..5000],
(length$fastfun a)==1
]
pslow=[a|
a<-[1..5000],
(length$slowfun a)==1
]
-- find len pfast=len pslow+2
-- so sum file.log and +2
problem_136 b=[a|
a<-[1+b*groups..groups*(b+1)],
(length$fastfun a)==1
]
google num
-- write file to change bignum to small num
=if (num>49)
then return()
else do appendFile "file.log" ((show$length$problem_136 num) ++ "\n")
google (num+1)
main=google 0
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),
mod bb 5==1,
let c=div bb 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,mod bb 5==1,
let c=div bb 5
]
problem_137 =(!!14)$sort $(++fun)$fun2
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)
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]
|mod x 2==0 && mod y 2==0 && mod z 2==0=
[div x 2,div y 2,div z 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=div m (n+k),
let y=div m (n-1),
let side=[y^2-x^2, 2*x*y, y^2+x^2]
]
limit=100000000
problem_139=sum [div limit$sum a|a<-fun, sum a<limit]
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:[div a 2,div b 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),
mod bb 5==2,
let c=div bb 5
]
fun2=
[c|
a<-[1..20],
[_,b,_]<-powmu1 a ,
let bb=(abs b)*2,
mod bb 5==2,
let c=div bb 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)]