Euler problems/141 to 150
From HaskellWiki
(Difference between revisions)
| Line 136: | Line 136: | ||
Solution: | Solution: | ||
<haskell> | <haskell> | ||
| - | problem_146 = | + | 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> | </haskell> | ||
Revision as of 08:49, 23 December 2007
Contents |
1 Problem 141
Investigating progressive numbers, n, which are also square.
Solution:
problem_141 = undefined
2 Problem 142
Perfect Square Collection
Solution:
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 ]
3 Problem 143
Investigating the Torricelli point of a triangle
Solution:
problem_143 = undefined
4 Problem 144
Investigating multiple reflections of a laser beam.
Solution:
problem_144 = undefined
5 Problem 145
How many reversible numbers are there below one-billion?
Solution:
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]]
6 Problem 146
Investigating a Prime Pattern
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=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
7 Problem 147
Rectangles in cross-hatched grids
Solution:
problem_147 = undefined
8 Problem 148
Exploring Pascal's triangle.
Solution:
import List digits n {- 123->[3,2,1] - -} |n<7=[n] |otherwise= y:digits x where (x,y)=divMod n 7 notDivX x=product$map (+1) $digits x array::[Integer] array=[a*b*c*d*e*f|let t=[1..7],a<-t,b<-t,c<-t,d<-t,e<-t,f<-t] fastNotDivX::Integer->Integer fastNotDivX x=sum[k*a|a<-array] where k=product$map (+1) $digits x sumNotDivX x=sum[notDivX a|a<-[0..x]] -- sum[fastNotDivX x|x<-[0..b]]=sumNotDivX ((b+1)*7^6-1) moreNotDivX =sum[notDivX a|a<-[1000000000.. 1000016499 ]] google num -- write file to change bignum to small num =if (num>8499) then return() else do appendFile "file.log" $(show$fastNotDivX num) ++" "++(show num) ++"\n" google (num+1) -- first use main to make file.log -- then run problem_148 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_148=do x<-readFile "file.log" let y=sum$map sToInt $lines x print ( y-(fromInteger moreNotDivX))
9 Problem 149
Searching for a maximum-sum subsequence.
Solution:
problem_149 = undefined
10 Problem 150
Searching a triangular array for a sub-triangle having minimum-sum.
Solution:
problem_150 = undefined
