Personal tools

Euler problems/141 to 150

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
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 21:44, 29 January 2008

Do them on your own!