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

## 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']]
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 = scanl (*) 1 [1..100]
comb (r,n) = facs!!n `div` (facs!!r * facs!!(n-r))
perms = concatMap (\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

readCard [r,s] = (parseRank r, parseSuit s)
where parseSuit = translate "SHDC"
parseRank = translate "23456789TJQKA"
translate from x = fromJust \$ elemIndex x from

solveHand hand = (handRank,tiebreak)
where
handRank
| flush && straight   = 9
| all hasKinds [2,3]  = 7
| flush               = 6
| straight            = 5
| 1 < length (kind 2) = 3
| 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
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]]
```

Alternate solution:

```import Data.Char (digitToInt)

digiSum :: Integer -> Int
digiSum = sum . map digitToInt . show

problem_56 :: Int
problem_56 = maximum \$ map digiSum [a^b | a <- [1..100], b <- [1..100]]
```

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

The following solution is based on the observation that the fractions needed appear regularly in the repeating pattern _______\$____\$ where underscores are ignored and dollars are interesting fractions.

```calc :: Int -> Int
calc n = nd13 * 2 + ((n-nd13*13) `div` 8)
where
nd13 = n `div` 13

problem_57 :: Int
problem_57 = calc 1000
```

## 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
import Data.Ord (comparing)

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)

problem_59 = do
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 (comparing (howManySpaces.fst)) alphaDecrypts
asciisum = sum (map ord (fst message))
print 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]
```