Difference between revisions of "Euler problems/41 to 50"
(added solution for 49 (a bit ugly though)) 
Jim Burton (talk  contribs) m (Made some changes to problem 49) 

Line 124:  Line 124:  
I'm new to haskell, improve here :) 
I'm new to haskell, improve here :) 

−  
+  I tidied up your solution a bit, mostly by using library functions where possible...makes it slightly faster on my system. [[User:Jim BurtonJim Burton]] 10:02, 9 July 2007 (UTC) 

<haskell> 
<haskell> 

−  isprime2 n x = if x < n then 

+  import Data.List 

−  if (n `mod` x == 0) then 

−  False 

−  else 

−  isprime2 n (x+1) 

−  else 

−  True 

−  
−  isprime n = isprime2 n 2 

−  
−  quicksort [] = [] 

−  quicksort (x:xs) = quicksort [y  y < xs, y<x ] ++ [x] ++ quicksort [y  y < xs, y>=x] 

−  
−   'each' works like this: each 1234 => [1,2,3,4] 

−  each n 0 = [] 

−  each n len = let x = 10 ^ (len1) 

−  in n `div` x : each (n `mod` x) (len1) 

−  ispermut x y = if x /= y then (quicksort (each x 4)) == (quicksort (each y 4)) 

+  isprime :: (Integral a) => a > Bool 

−  else False 

+  isprime n = isprime2 2 

+  where isprime2 x  x < n = if n `mod` x == 0 then False else isprime2 (x+1) 

+   otherwise = True 

+  
−  isin2 a [] = False 

+   'each' works like this: each (1234,4) => [1,2,3,4] 

−  isin2 a (b:bs) = if a == b then True else isin2 a bs 

+  each :: (Int, Int) > [Int] 

+  each = unfoldr (\(y,o) > let x = 10 ^ (o1) 

+  (d,m) = y `divMod` x in 

+  if o == 0 then Nothing else Just (d,(m,o1))) 

−  isin a [] = False 

+  ispermut :: Int > Int > Bool 

−  isin a (b:bs) = if a `isin2` b then True else isin a bs 

+  ispermut x y = sort (each (x,4)) == sort (each (y,4)) 

−  problem_49_2 prime [] = [] 

+  isin :: (Eq a) => a > [[a]] > Bool 

−  problem_49_2 prime (pr:rest) = if ispermut prime pr then 

+  isin = any . elem 

−  (pr:(problem_49_2 prime rest)) 

−  else 

−  problem_49_2 prime rest 

+  problem_49_1 :: [Int] > [[Int]] > [[Int]] 

problem_49_1 [] res = res 
problem_49_1 [] res = res 

−  problem_49_1 (pr:prims) res = 
+  problem_49_1 (pr:prims) res = problem_49_1 prims res' 
−  +  where res' = if pr `isin` res then res else res ++ [pr:(filter (ispermut pr) (pr:prims))] 

−  in 

−  if x /= [] then 

−  problem_49_1 prims (res ++ [(pr:x)]) 

−  else 

−  problem_49_1 prims res 

−  else 

−  problem_49_1 prims res 

+  problem_49 :: [[Int]] 

problem_49 = problem_49_1 [n  n < [1000..9999], isprime n] [] 
problem_49 = problem_49_1 [n  n < [1000..9999], isprime n] [] 

</haskell> 
</haskell> 
Revision as of 10:02, 9 July 2007
Contents
Problem 41
What is the largest ndigit pandigital prime that exists?
Solution:
problem_41 = head [p  n < init (tails "987654321"),
p < perms n, isPrime (read p)]
where perms [] = [[]]
perms xs = [x:ps  x < xs, ps < perms (delete x xs)]
isPrime n = n > 1 && smallestDivisor n == n
smallestDivisor n = findDivisor n (2:[3,5..])
findDivisor n (testDivisor:rest)
 n `mod` testDivisor == 0 = testDivisor
 testDivisor*testDivisor >= n = n
 otherwise = findDivisor n rest
Problem 42
How many triangle words can you make using the list of common English words?
Solution:
score :: String > Int
score = sum . map ((subtract 64) . ord . toUpper)
istrig :: Int > Bool
istrig n = istrig' n trigs
istrig' :: Int > [Int] > Bool
istrig' n (t:ts)  n == t = True
 otherwise = if t < n && head ts > n then False else istrig' n ts
trigs = map (\n > n*(n+1) `div` 2) [1..]
get ws from the Euler site
ws = ["A","ABILITY" ... "YOURSELF","YOUTH"]
problem_42 = length $ filter id $ map (istrig . score) ws
Problem 43
Find the sum of all pandigital numbers with an unusual substring divisibility property.
Solution:
problem_43 = undefined
Problem 44
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.
Solution:
problem_44 = undefined
Problem 45
After 40755, what is the next triangle number that is also pentagonal and hexagonal?
Solution:
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes)
where match (x:xs) (y:ys)
 x < y = match xs (y:ys)
 y < x = match (x:xs) ys
 otherwise = x : match xs ys
tries = [n*(n+1) `div` 2  n < [1..]]
pents = [n*(3*n1) `div` 2  n < [1..]]
hexes = [n*(2*n1)  n < [1..]]
Problem 46
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?
Solution:
This solution is inspired by exercise 3.70 in Structure and Interpretation of Computer Programs, (2nd ed.).
problem_46 = head $ oddComposites `orderedDiff` gbSums
oddComposites = filter ((>1) . length . primeFactors) [3,5..]
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n  n < [1..]]
gbWeight (a,b) = a + b
weightedPairs w (x:xs) (y:ys) =
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))
mergeWeighted w (x:xs) (y:ys)
 w x <= w y = x : mergeWeighted w xs (y:ys)
 otherwise = y : mergeWeighted w (x:xs) ys
x `orderedDiff` [] = x
[] `orderedDiff` y = []
(x:xs) `orderedDiff` (y:ys)
 x < y = x : xs `orderedDiff` (y:ys)
 x > y = (x:xs) `orderedDiff` ys
 otherwise = xs `orderedDiff` ys
Problem 47
Find the first four consecutive integers to have four distinct primes factors.
Solution:
problem_47 = undefined
Problem 48
Find the last ten digits of 1^{1} + 2^{2} + ... + 1000^{1000}.
Solution: If the problem were more computationally intensive, modular exponentiation might be appropriate. With this problem size the naive approach is sufficient.
problem_48 = sum [n^n  n < [1..1000]] `mod` 10^10
Problem 49
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.
Solution:
I'm new to haskell, improve here :)
I tidied up your solution a bit, mostly by using library functions where possible...makes it slightly faster on my system. Jim Burton 10:02, 9 July 2007 (UTC)
import Data.List
isprime :: (Integral a) => a > Bool
isprime n = isprime2 2
where isprime2 x  x < n = if n `mod` x == 0 then False else isprime2 (x+1)
 otherwise = True
 'each' works like this: each (1234,4) => [1,2,3,4]
each :: (Int, Int) > [Int]
each = unfoldr (\(y,o) > let x = 10 ^ (o1)
(d,m) = y `divMod` x in
if o == 0 then Nothing else Just (d,(m,o1)))
ispermut :: Int > Int > Bool
ispermut x y = sort (each (x,4)) == sort (each (y,4))
isin :: (Eq a) => a > [[a]] > Bool
isin = any . elem
problem_49_1 :: [Int] > [[Int]] > [[Int]]
problem_49_1 [] res = res
problem_49_1 (pr:prims) res = problem_49_1 prims res'
where res' = if pr `isin` res then res else res ++ [pr:(filter (ispermut pr) (pr:prims))]
problem_49 :: [[Int]]
problem_49 = problem_49_1 [n  n < [1000..9999], isprime n] []
Problem 50
Which prime, below onemillion, can be written as the sum of the most consecutive primes?
Solution:
problem_50 = undefined