Difference between revisions of "Euler problems/141 to 150"
Jump to navigation
Jump to search
CaleGibbard (talk | contribs) (rv: vandalism) |
m |
||
(12 intermediate revisions by 7 users not shown) | |||
Line 1: | Line 1: | ||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=141 Problem 141] == |
Investigating progressive numbers, n, which are also square. |
Investigating progressive numbers, n, which are also square. |
||
Line 35: | Line 35: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=142 Problem 142] == |
Perfect Square Collection |
Perfect Square Collection |
||
Line 44: | Line 44: | ||
aToX (a,b,c)=[x,y,z] |
aToX (a,b,c)=[x,y,z] |
||
where |
where |
||
− | x= |
+ | x=(a+b)`div`2 |
− | y= |
+ | y=(a-b)`div`2 |
z=c-x |
z=c-x |
||
{- |
{- |
||
Line 85: | Line 85: | ||
let n=(a2+b2)*(a2*b2+1), |
let n=(a2+b2)*(a2*b2+1), |
||
isSquare n, |
isSquare n, |
||
− | let t= |
+ | let t=n`div`4, |
let t2=a2*b2, |
let t2=a2*b2, |
||
− | let t3= |
+ | let t3=(a2*(b2+1)^2)`div`4 |
] |
] |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=143 Problem 143] == |
Investigating the Torricelli point of a triangle |
Investigating the Torricelli point of a triangle |
||
+ | |||
+ | == [http://projecteuler.net/index.php?section=problems&id=144 Problem 144] == |
||
+ | Investigating multiple reflections of a laser beam. |
||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | type Point = (Double, Double) |
||
− | import Data.List |
||
+ | type Vector = (Double, Double) |
||
− | import Data.Array.ST |
||
+ | type Normal = (Double, Double) |
||
− | import Data.Array |
||
− | import qualified Data.Array.Unboxed as U |
||
− | import Control.Monad |
||
− | + | sub :: Vector -> Vector -> Vector |
|
+ | sub (x,y) (a,b) = (x-a, y-b) |
||
− | mkCan lst = map func $ group $ insert 3 lst |
||
+ | |||
− | where |
||
+ | mull :: Double -> Vector -> Vector |
||
− | func ps@(p:_) |
||
+ | mull s (x,y) = (s*x, s*y) |
||
− | | p == 3 = (3,2*l-1) |
||
+ | |||
− | | otherwise = (p, 2*l) |
||
+ | mulr :: Vector -> Double -> Vector |
||
− | where |
||
+ | mulr v s = mull s v |
||
− | l = length ps |
||
+ | |||
+ | dot :: Vector -> Vector -> Double |
||
+ | dot (x,y) (a,b) = x*a + y*b |
||
+ | |||
+ | normSq :: Vector -> Double |
||
+ | normSq v = dot v v |
||
+ | |||
+ | normalize :: Vector -> Vector |
||
+ | normalize v |
||
+ | |len /= 0 =mulr v (1.0/len) |
||
+ | |otherwise=error "Vettore nullo.\n" |
||
+ | where |
||
+ | len = (sqrt . normSq) v |
||
+ | |||
+ | proj :: Vector -> Vector -> Vector |
||
+ | proj a b = mull ((dot a b)/normSq b) b |
||
+ | reflect :: Vector -> Normal -> Vector |
||
− | spfArray :: U.UArray Int Int |
||
+ | reflect i n = sub i $ mulr (proj i n) 2.0 |
||
− | 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) |
||
+ | type Ray = (Point, Vector) |
||
− | 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) |
||
− | + | makeRay :: Point -> Vector -> Ray |
|
+ | makeRay p v = (p, v) |
||
− | sdivs s |
||
+ | |||
− | = filter ((<= 100000) . uncurry (+)) $ zip sds' lds' |
||
+ | getPoint :: Ray -> Double -> Point |
||
− | where |
||
+ | getPoint ((px,py),(vx,vy)) t = (px + t*vx, py + t*vy) |
||
− | bd = 3*s*s |
||
+ | |||
− | pks = mkCan $ factArray ! s |
||
+ | type Ellipse = (Double, Double) |
||
− | fun (p,k) = take (k+1) $ iterate (*p) 1 |
||
+ | |||
− | ds = map fun pks |
||
+ | getNormal :: Ellipse -> Point -> Normal |
||
− | (sds,lds) = span ((< bd) . (^2)) . sort $ foldr (liftM2 (*)) [1] ds |
||
+ | getNormal (a,b) (x,y) = ((-b/a)*x, (-a/b)*y) |
||
− | sds' = map (+ 2*s) sds |
||
− | lds' = reverse $ map (+ 2*s) lds |
||
+ | rayFromPoint :: Ellipse -> Vector -> Point -> Ray |
||
− | pairArray :: Array Int [Int] |
||
+ | rayFromPoint e v p = makeRay p (reflect v (getNormal e p)) |
||
− | 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 |
||
− | + | test :: Point -> Bool |
|
+ | test (x,y) = y > 0 && x >= -0.01 && x <= 0.01 |
||
− | 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) |
||
+ | intersect :: Ellipse -> Ray -> Point |
||
− | main :: IO () |
||
+ | intersect (e@(a,b)) (r@((px,py),(vx,vy))) = |
||
− | main = writeFile "p143.log"$show$ sum [s | (s,True) <- U.assocs sumArray] |
||
+ | getPoint r t1 |
||
− | problem_143 = main |
||
+ | where |
||
+ | c0 = normSq (vx/a, vy/b) |
||
+ | c1 = 2.0 * dot (vx/a, vy/b) (px/a, py/b) |
||
+ | c2 = (normSq (px/a, py/b)) - 1.0 |
||
+ | (t0, t1) = quadratic c0 c1 c2 |
||
+ | |||
+ | quadratic :: Double -> Double -> Double -> (Double, Double) |
||
+ | quadratic a b c |
||
+ | |d < 0= error "Discriminante minore di zero" |
||
+ | |otherwise= if (t0 < t1) then (t0, t1) else (t1, t0) |
||
+ | where |
||
+ | d = b * b - 4.0 * a * c |
||
+ | sqrtD = sqrt d |
||
+ | q = if b < 0 then -0.5*(b - sqrtD) else 0.5*(b + sqrtD) |
||
+ | t0 = q / a |
||
+ | t1 = c / q |
||
+ | |||
+ | calculate :: Ellipse -> Ray -> Int -> IO () |
||
+ | calculate e (r@(o,d)) n |
||
+ | |test p=print n |
||
+ | |otherwise=do |
||
+ | putStrLn $ "\rHit " ++ show n |
||
+ | calculate e (rayFromPoint e d p) (n+1) |
||
+ | where |
||
+ | p = intersect e r |
||
+ | |||
+ | origin = (0.0,10.1) |
||
+ | direction = sub (1.4,-9.6) origin |
||
+ | ellipse = (5.0,10.0) |
||
+ | |||
+ | problem_144 = do |
||
+ | calculate ellipse (makeRay origin direction) 0 |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=145 Problem 145] == |
− | 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? |
How many reversible numbers are there below one-billion? |
||
Line 237: | Line 213: | ||
y=floor$logBase 10 $fromInteger x |
y=floor$logBase 10 $fromInteger x |
||
ten=10^y |
ten=10^y |
||
− | s= |
+ | s=x`mod`10 |
− | h= |
+ | h=x`div`ten |
a2=[i|i<-[10..99],isOdig i] |
a2=[i|i<-[10..99],isOdig i] |
||
Line 263: | Line 239: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=146 Problem 146] == |
Investigating a Prime Pattern |
Investigating a Prime Pattern |
||
Line 269: | Line 245: | ||
<haskell> |
<haskell> |
||
import List |
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=millerRabinPrimality x 2 |
||
− | --isPrime x= |
+ | --isPrime x=all (millerRabinPrimality x) [2,3,7,61,24251] |
six=[1,3,7,9,13,27] |
six=[1,3,7,9,13,27] |
||
− | allPrime x= |
+ | allPrime x=all (\a -> isPrime (x^2+a)) six |
linkPrime [x]=filterPrime x |
linkPrime [x]=filterPrime x |
||
linkPrime (x:xs)=[y| |
linkPrime (x:xs)=[y| |
||
Line 324: | Line 254: | ||
b<-[0..(x-1)], |
b<-[0..(x-1)], |
||
let y=b*prxs+a, |
let y=b*prxs+a, |
||
− | let c= |
+ | let c=y`mod`x, |
elem c d] |
elem c d] |
||
where |
where |
||
Line 333: | Line 263: | ||
[a| |
[a| |
||
a<-[0..(p-1)], |
a<-[0..(p-1)], |
||
− | length[b|b<-six, |
+ | length[b|b<-six,(a^2+b)`mod`p/=0]==6 |
] |
] |
||
testPrimes=[2,3,5,7,11,13,17,23] |
testPrimes=[2,3,5,7,11,13,17,23] |
||
Line 343: | Line 273: | ||
allPrime (y) |
allPrime (y) |
||
]==1242490 |
]==1242490 |
||
− | p146 =[y|y<-linkPrime primes,y<150000000,allPrime |
+ | p146 =[y|y<-linkPrime primes,y<150000000,allPrime y] |
problem_146=[a|a<-p146, allNext a] |
problem_146=[a|a<-p146, allNext a] |
||
allNext x= |
allNext x= |
||
Line 349: | Line 279: | ||
where |
where |
||
a=[x^2+b|b<-six] |
a=[x^2+b|b<-six] |
||
− | b=head a: |
+ | b=head a:map nextPrime a |
nextPrime x=head [a|a<-[(x+1)..],isPrime a] |
nextPrime x=head [a|a<-[(x+1)..],isPrime a] |
||
main=writeFile "p146.log" $show $sum problem_146 |
main=writeFile "p146.log" $show $sum problem_146 |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=147 Problem 147] == |
Rectangles in cross-hatched grids |
Rectangles in cross-hatched grids |
||
+ | == [http://projecteuler.net/index.php?section=problems&id=148 Problem 148] == |
||
− | Solution: |
||
− | <haskell> |
||
− | problem_147 = undefined |
||
− | </haskell> |
||
− | |||
− | == [http://projecteuler.net/index.php?section=view&id=148 Problem 148] == |
||
Exploring Pascal's triangle. |
Exploring Pascal's triangle. |
||
Line 376: | Line 301: | ||
j= -(n`div`(-k7)) |
j= -(n`div`(-k7)) |
||
k7=7^k |
k7=7^k |
||
− | k=floor |
+ | k=floor . logBase 7 . fromIntegral $ n |
problem_148=triangel (10^9) |
problem_148=triangel (10^9) |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=149 Problem 149] == |
Searching for a maximum-sum subsequence. |
Searching for a maximum-sum subsequence. |
||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | import Data.Array |
||
− | problem_149 = undefined |
||
+ | import Data.List (foldl') |
||
+ | |||
+ | n = 2000 |
||
+ | |||
+ | res = maximum' $ concat [rows, cols, diags, diags'] |
||
+ | where |
||
+ | rows = map (maxSumInRow . getRow laggedFibArray) [0 .. n-1] |
||
+ | cols = map (maxSumInRow . getCol laggedFibArray) [0 .. n-1] |
||
+ | diags = map (maxSumInRow . getDiag laggedFibArray) [-(n-2) .. (n-2)] |
||
+ | diags' = map (maxSumInRow . getDiag' laggedFibArray) [-(n-2) .. (n-2)] |
||
+ | |||
+ | |||
+ | laggedFibArray :: Array Integer Integer |
||
+ | laggedFibArray = listArray (0, n^2-1) $ map f [1..n^2] |
||
+ | where |
||
+ | f k = norm $ if k < 56 |
||
+ | then 100003 - (200003*k) + (300007*(k^3)) |
||
+ | else (laggedFibArray ! (k-25)) + (laggedFibArray ! (k-56)) + (10^6) |
||
+ | |||
+ | norm x = mod x (10^6) - 500000 |
||
+ | |||
+ | |||
+ | getRow a i = map (a!) [i*n .. (i+1)*n-1] |
||
+ | getCol a i = map (a!) [i,n+i .. n*(n-1)+i] |
||
+ | getDiag a i = map (a!) $ |
||
+ | if i >= 0 |
||
+ | then [(i*n) + (k*(n+1)) | k <- [0..n-i-1]] |
||
+ | else [k + n*(k+i) | k <- [-i .. n-1]] |
||
+ | getDiag' a i = map (a!) $ |
||
+ | if i >= 0 |
||
+ | then [(n*k) + n-k-i-1 | k <- [0..n-i-1]] |
||
+ | else [n*(k-i) + n-k-1 | k <- [0..n+i-1]] |
||
+ | |||
+ | |||
+ | maxSumInRow = snd . foldl' f (0,0) |
||
+ | where |
||
+ | f (line_sum, line_max) x = (line_sum', max line_max line_sum') |
||
+ | where line_sum' = max (line_sum+x) 0 |
||
+ | |||
+ | -- strict version of maximum |
||
+ | maximum' (x:xs) = foldl' max x xs |
||
+ | |||
+ | main = print res |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=150 Problem 150] == |
Searching a triangular array for a sub-triangle having minimum-sum. |
Searching a triangular array for a sub-triangle having minimum-sum. |
||
+ | {{sect-stub}} |
||
− | Solution: |
||
− | <haskell> |
||
− | problem_150 = undefined |
||
− | </haskell> |
Latest revision as of 10:51, 12 February 2010
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=(a+b)`div`2
y=(a-b)`div`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=n`div`4,
let t2=a2*b2,
let t3=(a2*(b2+1)^2)`div`4
]
Problem 143
Investigating the Torricelli point of a triangle
Problem 144
Investigating multiple reflections of a laser beam.
Solution:
type Point = (Double, Double)
type Vector = (Double, Double)
type Normal = (Double, Double)
sub :: Vector -> Vector -> Vector
sub (x,y) (a,b) = (x-a, y-b)
mull :: Double -> Vector -> Vector
mull s (x,y) = (s*x, s*y)
mulr :: Vector -> Double -> Vector
mulr v s = mull s v
dot :: Vector -> Vector -> Double
dot (x,y) (a,b) = x*a + y*b
normSq :: Vector -> Double
normSq v = dot v v
normalize :: Vector -> Vector
normalize v
|len /= 0 =mulr v (1.0/len)
|otherwise=error "Vettore nullo.\n"
where
len = (sqrt . normSq) v
proj :: Vector -> Vector -> Vector
proj a b = mull ((dot a b)/normSq b) b
reflect :: Vector -> Normal -> Vector
reflect i n = sub i $ mulr (proj i n) 2.0
type Ray = (Point, Vector)
makeRay :: Point -> Vector -> Ray
makeRay p v = (p, v)
getPoint :: Ray -> Double -> Point
getPoint ((px,py),(vx,vy)) t = (px + t*vx, py + t*vy)
type Ellipse = (Double, Double)
getNormal :: Ellipse -> Point -> Normal
getNormal (a,b) (x,y) = ((-b/a)*x, (-a/b)*y)
rayFromPoint :: Ellipse -> Vector -> Point -> Ray
rayFromPoint e v p = makeRay p (reflect v (getNormal e p))
test :: Point -> Bool
test (x,y) = y > 0 && x >= -0.01 && x <= 0.01
intersect :: Ellipse -> Ray -> Point
intersect (e@(a,b)) (r@((px,py),(vx,vy))) =
getPoint r t1
where
c0 = normSq (vx/a, vy/b)
c1 = 2.0 * dot (vx/a, vy/b) (px/a, py/b)
c2 = (normSq (px/a, py/b)) - 1.0
(t0, t1) = quadratic c0 c1 c2
quadratic :: Double -> Double -> Double -> (Double, Double)
quadratic a b c
|d < 0= error "Discriminante minore di zero"
|otherwise= if (t0 < t1) then (t0, t1) else (t1, t0)
where
d = b * b - 4.0 * a * c
sqrtD = sqrt d
q = if b < 0 then -0.5*(b - sqrtD) else 0.5*(b + sqrtD)
t0 = q / a
t1 = c / q
calculate :: Ellipse -> Ray -> Int -> IO ()
calculate e (r@(o,d)) n
|test p=print n
|otherwise=do
putStrLn $ "\rHit " ++ show n
calculate e (rayFromPoint e d p) (n+1)
where
p = intersect e r
origin = (0.0,10.1)
direction = sub (1.4,-9.6) origin
ellipse = (5.0,10.0)
problem_144 = do
calculate ellipse (makeRay origin direction) 0
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=x`mod`10
h=x`div`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
isPrime x=millerRabinPrimality x 2
--isPrime x=all (millerRabinPrimality x) [2,3,7,61,24251]
six=[1,3,7,9,13,27]
allPrime x=all (\a -> isPrime (x^2+a)) six
linkPrime [x]=filterPrime x
linkPrime (x:xs)=[y|
a<-linkPrime xs,
b<-[0..(x-1)],
let y=b*prxs+a,
let c=y`mod`x,
elem c d]
where
prxs=product xs
d=filterPrime x
filterPrime p=
[a|
a<-[0..(p-1)],
length[b|b<-six,(a^2+b)`mod`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
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 . logBase 7 . fromIntegral $ n
problem_148=triangel (10^9)
Problem 149
Searching for a maximum-sum subsequence.
Solution:
import Data.Array
import Data.List (foldl')
n = 2000
res = maximum' $ concat [rows, cols, diags, diags']
where
rows = map (maxSumInRow . getRow laggedFibArray) [0 .. n-1]
cols = map (maxSumInRow . getCol laggedFibArray) [0 .. n-1]
diags = map (maxSumInRow . getDiag laggedFibArray) [-(n-2) .. (n-2)]
diags' = map (maxSumInRow . getDiag' laggedFibArray) [-(n-2) .. (n-2)]
laggedFibArray :: Array Integer Integer
laggedFibArray = listArray (0, n^2-1) $ map f [1..n^2]
where
f k = norm $ if k < 56
then 100003 - (200003*k) + (300007*(k^3))
else (laggedFibArray ! (k-25)) + (laggedFibArray ! (k-56)) + (10^6)
norm x = mod x (10^6) - 500000
getRow a i = map (a!) [i*n .. (i+1)*n-1]
getCol a i = map (a!) [i,n+i .. n*(n-1)+i]
getDiag a i = map (a!) $
if i >= 0
then [(i*n) + (k*(n+1)) | k <- [0..n-i-1]]
else [k + n*(k+i) | k <- [-i .. n-1]]
getDiag' a i = map (a!) $
if i >= 0
then [(n*k) + n-k-i-1 | k <- [0..n-i-1]]
else [n*(k-i) + n-k-1 | k <- [0..n+i-1]]
maxSumInRow = snd . foldl' f (0,0)
where
f (line_sum, line_max) x = (line_sum', max line_max line_sum')
where line_sum' = max (line_sum+x) 0
-- strict version of maximum
maximum' (x:xs) = foldl' max x xs
main = print res
Problem 150
Searching a triangular array for a sub-triangle having minimum-sum.