Difference between revisions of "Euler problems/51 to 60"
Marypoppins (talk | contribs) |
CaleGibbard (talk | contribs) (rv: vandalism) |
||
Line 1: | Line 1: | ||
− | + | == [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] == | |
+ | 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 04:58, 30 January 2008
Contents
Problem 51
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
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
]
Problem 52
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.
Solution:
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..]
Problem 53
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?
Solution:
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
Problem 54
How many hands did player one win in the poker games?
Solution:
probably not the most straight forward way to do it.
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
Problem 55
How many Lychrel numbers are there below ten-thousand?
Solution:
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]
Problem 56
Considering natural numbers of the form, ab, finding the maximum digital sum.
Solution:
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]]
Problem 57
Investigate the expansion of the continued fraction for the square root of two.
Solution:
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
Problem 58
Investigate the number of primes that lie on the diagonals of the spiral grid.
Solution:
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
Problem 59
Using a brute force attack, can you decrypt the cipher using XOR encryption?
Solution:
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)
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.
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]