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!