|
|
| 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>
| |