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!