Difference between revisions of "Euler problems/131 to 140"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
|||
| Line 3: | Line 3: | ||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | 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] |
||
| − | </haskell> |
||
== [http://projecteuler.net/index.php?section=view&id=132 Problem 132] == |
== [http://projecteuler.net/index.php?section=view&id=132 Problem 132] == |
||
| Line 28: | Line 8: | ||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | -- 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 |
||
| − | </haskell> |
||
== [http://projecteuler.net/index.php?section=view&id=133 Problem 133] == |
== [http://projecteuler.net/index.php?section=view&id=133 Problem 133] == |
||
| Line 43: | Line 13: | ||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | 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 |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=134 Problem 134] == |
== [http://projecteuler.net/index.php?section=view&id=134 Problem 134] == |
||
Finding the smallest positive integer related to any pair of consecutive primes. |
Finding the smallest positive integer related to any pair of consecutive primes. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | 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 |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=135 Problem 135] == |
== [http://projecteuler.net/index.php?section=view&id=135 Problem 135] == |
||
Determining the number of solutions of the equation x2 − y2 − z2 = n. |
Determining the number of solutions of the equation x2 − y2 − z2 = n. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | 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 .. div m 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 |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=136 Problem 136] == |
== [http://projecteuler.net/index.php?section=view&id=136 Problem 136] == |
||
Discover when the equation x2 − y2 − z2 = n has a unique solution. |
Discover when the equation x2 − y2 − z2 = n has a unique solution. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | 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=foldl (&& )True [millerRabinPrimality x y|y<-[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 mod p 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 num |
||
| − | -- write file to change bignum to small num |
||
| − | =if (num>49) |
||
| − | then return() |
||
| − | else do t1<-problem_136 num |
||
| − | appendFile "file.log" $show t1 ++ "\n" |
||
| − | google (num+1) |
||
| − | main=do |
||
| − | appendFile "file.log" $show fun ++ "\n" |
||
| − | k<-fillmap 100 0 groups |
||
| − | appendFile "file.log" $show k ++ "\n" |
||
| − | google 1 |
||
| − | sToInt =(+0).read |
||
| − | problem_136a=do |
||
| − | s<-readFile "file.log" |
||
| − | print$sum$map sToInt$lines s |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=137 Problem 137] == |
== [http://projecteuler.net/index.php?section=view&id=137 Problem 137] == |
||
Determining the value of infinite polynomial series for which the coefficients are Fibonacci numbers. |
Determining the value of infinite polynomial series for which the coefficients are Fibonacci numbers. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | -- 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 |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=138 Problem 138] == |
== [http://projecteuler.net/index.php?section=view&id=138 Problem 138] == |
||
Investigating isosceles triangle for which the height and base length differ by one. |
Investigating isosceles triangle for which the height and base length differ by one. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | {- |
||
| − | - 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) |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=139 Problem 139] == |
== [http://projecteuler.net/index.php?section=view&id=139 Problem 139] == |
||
Finding Pythagorean triangles which allow the square on the hypotenuse square to be tiled. |
Finding Pythagorean triangles which allow the square on the hypotenuse square to be tiled. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | {- |
||
| − | - 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] |
||
| − | </haskell> |
||
| − | |||
== [http://projecteuler.net/index.php?section=view&id=140 Problem 140] == |
== [http://projecteuler.net/index.php?section=view&id=140 Problem 140] == |
||
Investigating the value of infinite polynomial series for which the coefficients are a linear second order recurrence relation. |
Investigating the value of infinite polynomial series for which the coefficients are a linear second order recurrence relation. |
||
Solution: |
Solution: |
||
| − | <haskell> |
||
| − | {- |
||
| − | 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)] |
||
| − | </haskell> |
||
Revision as of 21:35, 29 January 2008
Problem 131
Determining primes, p, for which n3 + n2p is a perfect cube.
Solution:
Problem 132
Determining the first forty prime factors of a very large repunit.
Solution:
Problem 133
Investigating which primes will never divide a repunit containing 10n digits.
Solution:
Problem 134
Finding the smallest positive integer related to any pair of consecutive primes.
Solution:
Problem 135
Determining the number of solutions of the equation x2 − y2 − z2 = n.
Solution:
Problem 136
Discover when the equation x2 − y2 − z2 = n has a unique solution.
Solution:
Problem 137
Determining the value of infinite polynomial series for which the coefficients are Fibonacci numbers.
Solution:
Problem 138
Investigating isosceles triangle for which the height and base length differ by one.
Solution:
Problem 139
Finding Pythagorean triangles which allow the square on the hypotenuse square to be tiled.
Solution:
Problem 140
Investigating the value of infinite polynomial series for which the coefficients are a linear second order recurrence relation.
Solution: