Personal tools

Euler problems/41 to 50

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
m
(added solution for 49 (a bit ugly though))
Line 121: Line 121:
   
 
Solution:
 
Solution:
  +
  +
I'm new to haskell, improve here :-)
  +
  +
 
<haskell>
 
<haskell>
problem_49 = undefined
+
isprime2 n x = if x < n then
  +
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 ^ (len-1)
  +
in n `div` x : each (n `mod` x) (len-1)
  +
  +
ispermut x y = if x /= y then (quicksort (each x 4)) == (quicksort (each y 4))
  +
else False
  +
  +
isin2 a [] = False
  +
isin2 a (b:bs) = if a == b then True else isin2 a bs
  +
  +
isin a [] = False
  +
isin a (b:bs) = if a `isin2` b then True else isin a bs
  +
  +
problem_49_2 prime [] = []
  +
problem_49_2 prime (pr:rest) = if ispermut prime pr then
  +
(pr:(problem_49_2 prime rest))
  +
else
  +
problem_49_2 prime rest
  +
  +
problem_49_1 [] res = res
  +
problem_49_1 (pr:prims) res = if not (pr `isin` res) then
  +
let x = (problem_49_2 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 = problem_49_1 [n | n <- [1000..9999], isprime n] []
 
</haskell>
 
</haskell>
   

Revision as of 23:08, 8 July 2007

Contents

1 Problem 41

What is the largest n-digit 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

2 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

3 Problem 43

Find the sum of all pandigital numbers with an unusual sub-string divisibility property.

Solution:

problem_43 = undefined

4 Problem 44

Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.

Solution:

problem_44 = undefined

5 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*n-1) `div` 2 | n <- [1..]]
          hexes = [n*(2*n-1)         | n <- [1..]]

6 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

7 Problem 47

Find the first four consecutive integers to have four distinct primes factors.

Solution:

problem_47 = undefined

8 Problem 48

Find the last ten digits of 11 + 22 + ... + 10001000.

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

9 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 :-)


isprime2 n x = if x < n then
                  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 ^ (len-1)
             in n `div` x : each (n `mod` x) (len-1)
 
ispermut x y = if x /= y then (quicksort (each x 4)) == (quicksort (each y 4))
               else False
 
isin2 a [] = False
isin2 a (b:bs) = if a == b then True else isin2 a bs
 
isin a [] = False
isin a (b:bs) = if a `isin2` b then True else isin a bs
 
problem_49_2 prime [] = []
problem_49_2 prime (pr:rest) = if ispermut prime pr then
                                   (pr:(problem_49_2 prime rest))
                               else
                                   problem_49_2 prime rest
 
problem_49_1 [] res = res
problem_49_1 (pr:prims) res = if not (pr `isin` res) then
                                let x = (problem_49_2 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 = problem_49_1 [n | n <- [1000..9999], isprime n] []

10 Problem 50

Which prime, below one-million, can be written as the sum of the most consecutive primes?

Solution:

problem_50 = undefined