|
|
Line 1: |
Line 1: |
| == [http://projecteuler.net/index.php?section=view&id=141 Problem 141] ==
| | Do them on your own! |
| 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>
| |