Difference between revisions of "Euler problems/141 to 150"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
|||
| Line 1: | Line 1: | ||
| + | Do them on your own! |
||
| − | == [http://projecteuler.net/index.php?section=view&id=141 Problem 141] == |
||
| − | Investigating progressive numbers, n, which are also square. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | import Data.List |
||
| − | intSqrt :: Integral a => a -> a |
||
| − | intSqrt n |
||
| − | | n < 0 = error "intSqrt: negative n" |
||
| − | | otherwise = f n |
||
| − | where |
||
| − | f x = if y < x then f y else x |
||
| − | where y = (x + (n `quot` x)) `quot` 2 |
||
| − | isSqrt n = n==((^2).intSqrt) n |
||
| − | takec a b = |
||
| − | two++takeWhile (<=e12) |
||
| − | [sq| c1<-[1..], let c=c1*c1,let sq=(c^2*a^3*b+b^2*c) ] |
||
| − | where |
||
| − | e12=10^12 |
||
| − | two=[sq|c<-[b,2*b],let sq=(c^2*a^3*b+b^2*c) ] |
||
| − | problem_141= |
||
| − | sum$nub[c| |
||
| − | (a,b)<-takeWhile (\(a,b)->a^3*b+b^2<e12) |
||
| − | [(a,b)| |
||
| − | a<-[2..e4], |
||
| − | b<-[1..(a-1)] |
||
| − | ], |
||
| − | gcd a b==1, |
||
| − | c<-takec a b, |
||
| − | isSqrt c |
||
| − | ] |
||
| − | where |
||
| − | e4=120 |
||
| − | e12=10^12 |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=142 Problem 142] == |
||
| − | Perfect Square Collection |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | import List |
||
| − | isSquare n = (round . sqrt $ fromIntegral n) ^ 2 == n |
||
| − | aToX (a,b,c)=[x,y,z] |
||
| − | where |
||
| − | x=div (a+b) 2 |
||
| − | y=div (a-b) 2 |
||
| − | z=c-x |
||
| − | {- |
||
| − | - 2 2 2 |
||
| − | - a = c + d |
||
| − | - 2 2 2 |
||
| − | - a = e + f |
||
| − | - 2 2 2 |
||
| − | - c = e + b |
||
| − | - let b=x*y then |
||
| − | - (y + xb) |
||
| − | - c= --------- |
||
| − | - 2 |
||
| − | - (-y + xb) |
||
| − | - e= --------- |
||
| − | - 2 |
||
| − | - (-x + yb) |
||
| − | - d= --------- |
||
| − | - 2 |
||
| − | - (x + yb) |
||
| − | - f= --------- |
||
| − | - 2 |
||
| − | - |
||
| − | - and |
||
| − | - 2 2 2 |
||
| − | - a = c + d |
||
| − | - then |
||
| − | - 2 2 2 2 |
||
| − | - 2 (y + x ) (x y + 1) |
||
| − | - a = --------------------- |
||
| − | - 4 |
||
| − | - |
||
| − | -} |
||
| − | problem_142 = sum$head[aToX(t,t2 ,t3)| |
||
| − | a<-[3,5..50], |
||
| − | b<-[(a+2),(a+4)..50], |
||
| − | let a2=a^2, |
||
| − | let b2=b^2, |
||
| − | let n=(a2+b2)*(a2*b2+1), |
||
| − | isSquare n, |
||
| − | let t=div n 4, |
||
| − | let t2=a2*b2, |
||
| − | let t3=div (a2*(b2+1)^2) 4 |
||
| − | ] |
||
| − | |||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=143 Problem 143] == |
||
| − | Investigating the Torricelli point of a triangle |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | import Data.List |
||
| − | import Data.Array.ST |
||
| − | import Data.Array |
||
| − | import qualified Data.Array.Unboxed as U |
||
| − | import Control.Monad |
||
| − | |||
| − | mkCan :: [Int] -> [(Int,Int)] |
||
| − | mkCan lst = map func $ group $ insert 3 lst |
||
| − | where |
||
| − | func ps@(p:_) |
||
| − | | p == 3 = (3,2*l-1) |
||
| − | | otherwise = (p, 2*l) |
||
| − | where |
||
| − | l = length ps |
||
| − | |||
| − | spfArray :: U.UArray Int Int |
||
| − | spfArray |
||
| − | = runSTUArray |
||
| − | (do ar <- newArray (2,13397) 0 |
||
| − | let loop k |
||
| − | | k > 13397 = return () |
||
| − | | otherwise = do writeArray ar k 2 |
||
| − | loop (k+2) |
||
| − | loop 2 |
||
| − | let go i |
||
| − | | i > 13397 = return ar |
||
| − | | otherwise |
||
| − | = do p <- readArray ar i |
||
| − | if (p == 0) |
||
| − | then do writeArray ar i i |
||
| − | let run k |
||
| − | | k > 13397 = go (i+2) |
||
| − | | otherwise |
||
| − | = do q <- readArray ar k |
||
| − | when (q == 0) |
||
| − | (writeArray ar k i) |
||
| − | run (k+2*i) |
||
| − | run (i*i) |
||
| − | else go (i+2) |
||
| − | go 3) |
||
| − | |||
| − | factArray :: Array Int [Int] |
||
| − | factArray |
||
| − | = runSTArray |
||
| − | (do ar <- newArray (1,13397) [] |
||
| − | let go i |
||
| − | | i > 13397 = return ar |
||
| − | | otherwise = do let p = spfArray U.! i |
||
| − | q = i `div` p |
||
| − | fs <- readArray ar q |
||
| − | writeArray ar i (p:fs) |
||
| − | go (i+1) |
||
| − | go 2) |
||
| − | |||
| − | sdivs :: Int -> [(Int,Int)] |
||
| − | sdivs s |
||
| − | = filter ((<= 100000) . uncurry (+)) $ zip sds' lds' |
||
| − | where |
||
| − | bd = 3*s*s |
||
| − | pks = mkCan $ factArray ! s |
||
| − | fun (p,k) = take (k+1) $ iterate (*p) 1 |
||
| − | ds = map fun pks |
||
| − | (sds,lds) = span ((< bd) . (^2)) . sort $ foldr (liftM2 (*)) [1] ds |
||
| − | sds' = map (+ 2*s) sds |
||
| − | lds' = reverse $ map (+ 2*s) lds |
||
| − | |||
| − | pairArray :: Array Int [Int] |
||
| − | pairArray |
||
| − | = runSTArray |
||
| − | (do ar <- newArray (3,50000) [] |
||
| − | let go s |
||
| − | | s > 13397 = return ar |
||
| − | | otherwise |
||
| − | = do let run [] = go (s+1) |
||
| − | run ((r,q):ds) |
||
| − | = do lst <- readArray ar r |
||
| − | let nlst = insert q lst |
||
| − | writeArray ar r nlst |
||
| − | run ds |
||
| − | run $ sdivs s |
||
| − | go 1) |
||
| − | |||
| − | select2 :: [Int] -> [(Int,Int)] |
||
| − | select2 [] = [] |
||
| − | select2 (a:bs) = [(a,b) | b <- bs] ++ select2 bs |
||
| − | |||
| − | sumArray :: U.UArray Int Bool |
||
| − | sumArray |
||
| − | = runSTUArray |
||
| − | (do ar <- newArray (12,100000) False |
||
| − | let go r |
||
| − | | r > 33332 = return ar |
||
| − | | otherwise |
||
| − | = do let run [] = go (r+1) |
||
| − | run ((q,p):xs) |
||
| − | = do when (p `elem` (pairArray!q)) |
||
| − | (writeArray ar (p+q+r) True) |
||
| − | run xs |
||
| − | run $ filter ((<= 100000) . (+r) . uncurry (+)) $ |
||
| − | select2 $ pairArray!r |
||
| − | go 3) |
||
| − | |||
| − | main :: IO () |
||
| − | main = writeFile "p143.log"$show$ sum [s | (s,True) <- U.assocs sumArray] |
||
| − | problem_143 = main |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=144 Problem 144] == |
||
| − | Investigating multiple reflections of a laser beam. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | problem_144 = undefined |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=145 Problem 145] == |
||
| − | How many reversible numbers are there below one-billion? |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | import List |
||
| − | |||
| − | digits n |
||
| − | {- 123->[3,2,1] |
||
| − | -} |
||
| − | |n<10=[n] |
||
| − | |otherwise= y:digits x |
||
| − | where |
||
| − | (x,y)=divMod n 10 |
||
| − | -- 123 ->321 |
||
| − | dmm=(\x y->x*10+y) |
||
| − | palind n=foldl dmm 0 (digits n) |
||
| − | |||
| − | isOdd x=(length$takeWhile odd x)==(length x) |
||
| − | isOdig x=isOdd m && s<=h |
||
| − | where |
||
| − | k=x+palind x |
||
| − | m=digits k |
||
| − | y=floor$logBase 10 $fromInteger x |
||
| − | ten=10^y |
||
| − | s=mod x 10 |
||
| − | h=div x ten |
||
| − | |||
| − | a2=[i|i<-[10..99],isOdig i] |
||
| − | aa2=[i|i<-[10..99],isOdig i,mod i 10/=0] |
||
| − | a3=[i|i<-[100..999],isOdig i] |
||
| − | m5=[i|i1<-[0..99],i2<-[0..99], |
||
| − | let i3=i1*1000+3*100+i2, |
||
| − | let i=10^6* 8+i3*10+5, |
||
| − | isOdig i |
||
| − | ] |
||
| − | |||
| − | fun i |
||
| − | |i==2 =2*le aa2 |
||
| − | |even i=(fun 2)*d^(m-1) |
||
| − | |i==3 =2*le a3 |
||
| − | |i==7 =fun 3*le m5 |
||
| − | |otherwise=0 |
||
| − | where |
||
| − | le=length |
||
| − | m=div i 2 |
||
| − | d=2*le a2 |
||
| − | |||
| − | problem_145 = sum[fun a|a<-[1..9]] |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=146 Problem 146] == |
||
| − | Investigating a Prime Pattern |
||
| − | |||
| − | 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=millerRabinPrimality x 2 |
||
| − | --isPrime x=foldl (&& )True [millerRabinPrimality x y|y<-[2,3,7,61,24251]] |
||
| − | six=[1,3,7,9,13,27] |
||
| − | allPrime x=foldl (&&) True [isPrime k|a<-six,let k=x^2+a] |
||
| − | linkPrime [x]=filterPrime x |
||
| − | linkPrime (x:xs)=[y| |
||
| − | a<-linkPrime xs, |
||
| − | b<-[0..(x-1)], |
||
| − | let y=b*prxs+a, |
||
| − | let c=mod y x, |
||
| − | elem c d] |
||
| − | where |
||
| − | prxs=product xs |
||
| − | d=filterPrime x |
||
| − | |||
| − | filterPrime p= |
||
| − | [a| |
||
| − | a<-[0..(p-1)], |
||
| − | length[b|b<-six,mod (a^2+b) p/=0]==6 |
||
| − | ] |
||
| − | testPrimes=[2,3,5,7,11,13,17,23] |
||
| − | primes=[2,3,5,7,11,13,17,23,29] |
||
| − | test = |
||
| − | sum[y| |
||
| − | y<-linkPrime testPrimes, |
||
| − | y<1000000, |
||
| − | allPrime (y) |
||
| − | ]==1242490 |
||
| − | p146 =[y|y<-linkPrime primes,y<150000000,allPrime (y)] |
||
| − | problem_146=[a|a<-p146, allNext a] |
||
| − | allNext x= |
||
| − | sum [1|(x,y)<-zip a b,x==y]==6 |
||
| − | where |
||
| − | a=[x^2+b|b<-six] |
||
| − | b=head a:(map nextPrime a) |
||
| − | nextPrime x=head [a|a<-[(x+1)..],isPrime a] |
||
| − | main=writeFile "p146.log" $show $sum problem_146 |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=147 Problem 147] == |
||
| − | Rectangles in cross-hatched grids |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | problem_147 = undefined |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=148 Problem 148] == |
||
| − | Exploring Pascal's triangle. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | triangel 0 = 0 |
||
| − | triangel n |
||
| − | |n <7 =n+triangel (n-1) |
||
| − | |n==k7 =28^k |
||
| − | |otherwise=(triangel i) + j*(triangel (n-i)) |
||
| − | where |
||
| − | i=k7*((n-1)`div`k7) |
||
| − | j= -(n`div`(-k7)) |
||
| − | k7=7^k |
||
| − | k=floor(log (fromIntegral n)/log 7) |
||
| − | problem_148=triangel (10^9) |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=149 Problem 149] == |
||
| − | Searching for a maximum-sum subsequence. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | problem_149 = undefined |
||
| − | </haskell> |
||
| − | |||
| − | == [http://projecteuler.net/index.php?section=view&id=150 Problem 150] == |
||
| − | Searching a triangular array for a sub-triangle having minimum-sum. |
||
| − | |||
| − | Solution: |
||
| − | <haskell> |
||
| − | problem_150 = undefined |
||
| − | </haskell> |
||
Revision as of 21:44, 29 January 2008
Do them on your own!