Difference between revisions of "Euler problems/141 to 150"
Jump to navigation
Jump to search
Marypoppins (talk | contribs) |
CaleGibbard (talk | contribs) (rv: vandalism) |
||
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> |
Revision as of 04:59, 30 January 2008
Problem 141
Investigating progressive numbers, n, which are also square.
Solution:
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
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
]
Problem 143
Investigating the Torricelli point of a triangle
Solution:
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
Problem 144
Investigating multiple reflections of a laser beam.
Solution:
problem_144 = undefined
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]]
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
Problem 147
Rectangles in cross-hatched grids
Solution:
problem_147 = undefined
Problem 148
Exploring Pascal's triangle.
Solution:
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)
Problem 149
Searching for a maximum-sum subsequence.
Solution:
problem_149 = undefined
Problem 150
Searching a triangular array for a sub-triangle having minimum-sum.
Solution:
problem_150 = undefined