Personal tools

Euler problems/51 to 60

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] ==
+
Do them on your own!
Find the smallest prime which, by changing the same part of the number, can form eight different primes.
+
 
+
Solution:
+
 
+
millerRabinPrimality on the [[Prime_numbers]] page
+
 
+
<haskell>
+
isPrime x
+
    |x==3=True
+
    |otherwise=millerRabinPrimality x 2
+
ch='1'
+
numChar n= sum [1|x<-show(n),x==ch]
+
replace d c|c==ch=d
+
          |otherwise=c
+
nextN repl n= (+0)$read $map repl $show n 
+
same n= [if isPrime$nextN (replace a) n then 1 else 0|a<-['1'..'9']]
+
problem_51=head [n|
+
    n<-[100003,100005..999999],
+
    numChar n==3,
+
    (sum $same n)==8
+
    ]
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] ==
+
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.
+
 
+
Solution:
+
<haskell>
+
import List
+
+
has_same_digits a b = (show a) \\ (show b) == []
+
+
check n = all (has_same_digits n) (map (n*) [2..6])
+
+
problem_52 = head $ filter check [1..]
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] ==
+
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?
+
 
+
Solution:
+
<haskell>
+
facs = reverse $ foldl (\y x->(head y) * x : y) [1] [1..100]
+
comb (r,n) = facs!!n `div` (facs!!r * facs!!(n-r))
+
perms = concat $ map (\x -> [(n,x) | n<-[1..x]]) [1..100]
+
problem_53 = length $ filter (>1000000) $ map comb $ perms
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=54 Problem 54] ==
+
How many hands did player one win in the [http://www.pokerroom.com poker games]?
+
 
+
Solution:
+
 
+
probably not the most straight forward way to do it.
+
 
+
<haskell>
+
import Data.List
+
import Data.Maybe
+
import Control.Monad
+
 
+
readCard [r,s] = (parseRank r, parseSuit s)
+
where parseSuit = translate "SHDC"
+
      parseRank = translate "23456789TJQKA"
+
      translate from x = fromJust $ findIndex (==x) from
+
 
+
solveHand hand = (handRank,tiebreak)
+
where
+
handRank
+
  | flush && straight  = 9
+
  | hasKinds 4          = 8
+
  | all hasKinds [2,3]  = 7
+
  | flush              = 6
+
  | straight            = 5
+
  | hasKinds 3          = 4
+
  | 1 < length (kind 2) = 3
+
  | hasKinds 2          = 2
+
  | otherwise          = 1
+
tiebreak = kind =<< [4,3,2,1]
+
hasKinds = not . null . kind
+
kind n = map head $ filter ((n==).length) $ group ranks
+
ranks  = reverse $ sort $ map fst hand
+
flush  = 1 == length (nub (map snd hand))
+
straight = length (kind 1) == 5 && 4 == head ranks - last ranks
+
+
gameLineToHands = splitAt 5 . map readCard . words
+
p1won (a,b) = solveHand a > solveHand b
+
 
+
problem_54 = do
+
    f <- readFile "poker.txt"
+
    let games = map gameLineToHands $ lines f
+
        wins = filter p1won games
+
    print $ length wins
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] ==
+
How many Lychrel numbers are there below ten-thousand?
+
 
+
Solution:
+
<haskell>
+
reverseNum = read . reverse . show
+
+
palindrome x =
+
    sx == reverse sx
+
    where
+
    sx = show x
+
 
+
lychrel =
+
    not . any palindrome . take 50 . tail . iterate next
+
    where
+
    next x = x + reverseNum x
+
+
problem_55 = length $ filter lychrel [1..10000]
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] ==
+
Considering natural numbers of the form, a<sup>b</sup>, finding the maximum digital sum.
+
 
+
Solution:
+
<haskell>
+
digitalSum 0 = 0
+
digitalSum n =
+
    let (d,m) = quotRem n 10 in m + digitalSum d
+
+
problem_56 =
+
    maximum [digitalSum (a^b) | a <- [99], b <- [90..99]]
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=57 Problem 57] ==
+
Investigate the expansion of the continued fraction for the square root of two.
+
 
+
Solution:
+
<haskell>
+
twoex = zip ns ds
+
    where
+
    ns = 3 : zipWith (\x y -> x + 2 * y) ns ds
+
    ds = 2 : zipWith (+) ns ds
+
+
len = length . show
+
+
problem_57 =
+
    length $ filter (\(n,d) -> len n > len d) $ take 1000 twoex
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=58 Problem 58] ==
+
Investigate the number of primes that lie on the diagonals of the spiral grid.
+
 
+
Solution:
+
<haskell>
+
isPrime x
+
    |x==3=True
+
    |otherwise=all id [millerRabinPrimality x n|n<-[2,3]]
+
diag = 1:3:5:7:zipWith (+) diag [8,10..]
+
problem_58 =
+
    result $ dropWhile tooBig $ drop 2 $ scanl primeRatio (0,0) diag
+
    where
+
    primeRatio (n,d) num = (if d `mod` 4 /= 0 && isPrime num then n+1 else n,d+1)
+
    tooBig (n,d) = n*10 >= d
+
    result ((_,d):_) = (d+2) `div` 4 * 2 + 1
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=59 Problem 59] ==
+
Using a brute force attack, can you decrypt the cipher using XOR encryption?
+
 
+
Solution:
+
<haskell>
+
import Data.Bits
+
import Data.Char
+
import Data.List
+
+
keys = [ [a,b,c] | a <- [97..122], b <- [97..122], c <- [97..122] ]
+
allAlpha a = all (\k -> let a = ord k in (a >= 32 && a <= 122)) a
+
howManySpaces x = length (elemIndices ' ' x)
+
compareBy f x y = compare (f x) (f y)
+
+
problem_59 = do
+
s <- readFile "cipher1.txt"
+
let
+
cipher = (read ("[" ++ s ++ "]") :: [Int])
+
decrypts = [ (map chr (zipWith xor (cycle key) cipher), map chr key) | key <- keys ]
+
alphaDecrypts = filter (\(x,y) -> allAlpha x) decrypts
+
message = maximumBy (\(x,y) (x',y') -> compareBy howManySpaces x x') alphaDecrypts
+
asciisum = sum (map ord (fst message))
+
putStrLn (show asciisum)
+
</haskell>
+
 
+
== [http://projecteuler.net/index.php?section=problems&id=60 Problem 60] ==
+
Find a set of five primes for which any two primes concatenate to produce another prime.
+
 
+
Solution:
+
 
+
Breadth first search that works on infinite lists. Breaks the 60 secs rule. This program finds the solution in 185 sec on my Dell D620 Laptop.
+
<haskell>
+
problem_60 = print$sum $head solve
+
isPrime x
+
    |x==3=True
+
    |otherwise=millerRabinPrimality x 2
+
+
solve = do
+
a <- primesTo10000
+
let m = f a $ dropWhile (<= a) primesTo10000
+
b <- m
+
let n = f b $ dropWhile (<= b) m
+
c <- n
+
let o = f c $ dropWhile (<= c) n
+
d <- o
+
let p = f d $ dropWhile (<= d) o
+
e <- p
+
return [a,b,c,d,e]
+
where
+
f x = filter (\y -> all id[isPrime $read $shows x $show y,
+
                isPrime $read $shows y $show x])
+
primesTo10000 = 2:filter (isPrime) [3,5..9999]
+
</haskell>
+

Revision as of 21:46, 29 January 2008

Do them on your own!