Difference between revisions of "Euler problems/51 to 60"

== [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^b, 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>