A continuation from part 2:

**Problem 25 – What is the first term in the Fibonacci sequence to contain 1000 digits?**

A function to generate the fib numbers:

`fibonacci2 :: Int -> Int`

fibonacci2 0 = 0

fibonacci2 1 = 1

fibonacci2 2 = 1

fibonacci2 n = fibonacci2 (n - 1) + fibonacci2 (n - 2)

This function is different from the other Fibonacci function because *now* Project Euler wants the sequence to start at 0, not 1.

Next, a function to count the number of digits is simply to turn into a char list and grab the length of that list:

`numDigits :: Int -> Int`

numDigits n = length (show n)

The return type is int because of the length function’s return type. The final answer is:

`let fib = map fibonacci2 [1..]`

length (takeWhile(<1000) $ map numDigits fib) + 1

**Problem 29 – How many distinct terms are in the sequence generated by ***a*^{b} for 2 ≤ *a* ≤ 100 and 2 ≤ *b* ≤ 100?

`length (nub [ x ^ y | x <- [2..100], y <- [2..100] ])`

The inner list comprehension generates all the numbers of the form x ^ y between the 2 ranges needed. The nub function then removes all duplicates, the length function then counts the number of terms.

**Problem 36 – Find the sum of all numbers, less than one million, which are palindromic in base 10 and base 2.**

Check if it’s a palindrome with:

`isPalindrome :: (Eq a) => [a] -> Bool`

isPalindrome x = x == reverse x

for example, the following code shows all numbers between 1 and 100 that are palindromic in base 10 and also shows their base 2 equivalent:

`[ (x, showIntAtBase 2 intToDigit x "") | x <- [1..100], isPalindrome (show x) ]`

[(1,”1″),(2,”10″),(3,”11″),(4,”100″),(5,”101″),(6,”110″),(7,”111″),(8,”1000″),(9,”1001″),(11,”1011″),(22,”10110″),(33,”100001″),(44,”101100″),(55,”110111″),(66,”1000010″),(77,”1001101″),(88,”1011000″),(99,”1100011″)]

Filtering out the non-palindromic base 2 equivalents:

***Main Numeric Data.Char>** filter (\(_, b) -> isPalindrome2 b) [ (x, showIntAtBase 2 intToDigit x "") | x <- [1..100], isPalindrome2 (show x) ]

[(1,"1"),(3,"11"),(5,"101"),(7,"111"),(9,"1001"),(33,"100001"),(99,"1100011")]

Now we just simply extend the texas range from 1..100 to 1..999999

***Main Numeric Data.Char>** filter (\(_, b) -> isPalindrome2 b) [ (x, showIntAtBase 2 intToDigit x "") | x <- [1..999999], isPalindrome2 (show x) ]

[(1,"1"),(3,"11"),(5,"101"),(7,"111"),(9,"1001"),(33,"100001"),(99,"1100011"),(313,"100111001"),(585,"1001001001"),(717,"1011001101"),(7447,"1110100010111"),(9009,"10001100110001"),(15351,"11101111110111"),(32223,"111110111011111"),(39993,"1001110000111001"),(53235,"1100111111110011"),(53835,"1101001001001011"),(73737,"10010000000001001"),(585585,"10001110111101110001")]

Then sum up the base 10 parts so altogether it’s:

`foldl (\acc x -> acc + (fst x)) 0 (filter (\(_, b) -> isPalindrome2 b) [ (x, showIntAtBase 2 intToDigit x "") | x <- [1..999999], isPalindrome2 (show x) ])`

**Problem 48 – Find the last ten digits of the series, 1**^{1} + 2^{2} + 3^{3} + … + 1000^{1000}

The sum of the series is:

`sum $ map (\x -> x^x) [1..1000]`

To get the last 10 digits, we can just turn this into a char list and grab the last 10, then turn it back into a number:

`let s = sum $ map (\x -> x^x) [1..1000]`

let sAsString = show s

read (snd (splitAt ((length sAsString) - 10) sAsString)) :: Int

**Problem 49 – What 12-digit number do you form by concatenating the three terms in the sequence in which each of the terms increases by 3330, each of the three terms are prime and each of the 4-digit numbers are permutations of one another?**

Since the number needs to be increased by 3330 twice and they all have to 4 digits long, the first number is at most 9999 – (2*3330) = 3339 and at least 1000.

We grab all the numbers from 1000 to 3339, call it x, calculate x + 3330 and x + 6660 and see if they’re all using the exact same digits using:

`haveSameDigitsButDiffOrder :: Int -> Int -> Bool`

haveSameDigitsButDiffOrder x y = sort (show x) == sort (show y)

and then filter out the rest using isPrime on all 3 numbers:

`greatestCommonDivisor :: Integer -> Integer -> Integer`

greatestCommonDivisor a 0 = a

greatestCommonDivisor a b = greatestCommonDivisor b (a `mod` b)

`isPrime :: Integer -> Bool`

isPrime x | x <= 1 = error "Please enter a number greater than one"

isPrime x = let listOfDivisors = map (greatestCommonDivisor x) [1..ceiling (sqrt (fromIntegral x)) :: Integer]

in all (\a -> a == 1 || a == x) listOfDivisors

***Main Data.List>** filter (\(x,y,z) -> isPrime x && isPrime y && isPrime z) [ (x, x + 3330, x + 6660) | x <- [1000..3339], haveSameDigitsButDiffOrder x (x + 3330) && haveSameDigitsButDiffOrder x (x + 6660) ]

[(1487,4817,8147),(2969,6299,9629)]

We already know what 1487,4817,8147 is answer from the example so the answer for this problem is the concatenation of 2969,6299,9629 which is 296962999629

**Problem 52 – Find the smallest positive integer, ***x*, such that 2*x*, 3*x*, 4*x*, 5*x*, and 6*x*, contain the same digits.

`haveSameDigitsButDiffOrder :: Int -> Int -> Bool`

haveSameDigitsButDiffOrder x y = sort (show x) == sort (show y)

***Main Data.List>** let h = haveSameDigitsButDiffOrder

***Main Data.List>** [ x | x <- [1..200000], h x (2*x) && h x (3*x) && h x (4*x) && h x (5*x) && h x (6*x)]

[142857]

This one was kind of lucky really, I just tested out a range of 1..200000 and it found an answer. This range was my first guess too.

But let’s say I didn’t want to guess the range. In that case:

***Main Data.List>** take 1 [ x | x <- [1..], h x (2*x) && h x (3*x) && h x (4*x) && h x (5*x) && h x (6*x)]

[142857]

**Problem 53 – How many, not necessarily distinct, values of **^{n}C_{r}, for 1 ≤ *n* ≤ 100, are greater than one-million?

Re-using the choose function from an earlier problem:

`choose :: Integer -> Integer -> Integer`

choose n r = factorial n `div` (factorial r * (factorial (n - r)))

The answer is then found with:

***Main Data.List>** length $ filter (>1000000) [ n `choose` r | n <- [1..100], r <- [1..n] ]

**Problem 56 – Considering natural numbers of the form, ***a*^{b}, where *a, b* < 100, what is the maximum digital sum?

We already have a function that sums digits from a previous problem so we can just reuse that:

***Main Data.List>** maximum [ sumOfDigits (a^b) | a <- [1..100], b <- [1..100] ]

972

**Problem 206 – Find the unique positive integer whose square has the form 1_2_3_4_5_6_7_8_9_0, where each “_” is a single digit**

The “highest” case scenario is the number: 1929394959697989990 which has a square root of 1389026623 when rounded down to an integer. The “lowest” case scenario is 1020304050607080900 which has a square root of 1010101010 rounded down to the nearest integer so the answer lies between these two bounds. Also, the only way a square ends in 0 is if the number we’re squaring also ends in a 0:

- Integer to square ends in 1 => Square of integer will always end in 1
- Integer to square ends in 2 => Square of integer will always end in 4
- Integer to square ends in 3 => Square of integer will always end in 9
- Integer to square ends in 4 => Square of integer will always end in 6
- Integer to square ends in 5 => Square of integer will always end in 5
- Integer to square ends in 6 => Square of integer will always end in 6
- Integer to square ends in 7 => Square of integer will always end in 9
- Integer to square ends in 8 => Square of integer will always end in 4
- Integer to square ends in 9 => Square of integer will always end in 1
- Integer to square ends in 0 => Square of integer will always end in 0

It makes sense that none of them end in a 2,3 or 7 since they are prime but none ending in 8 was a surprise. So if only the integers ending in a 0 can possibly have a square ending in 0, we not only have an upper and lower bounds but also the gap between each number in these bounds we should test.

When changed to a string, it then becomes a case of comparing the even indices 0,2,4,6,8,10,12,14,16,18 with the numbers 1,2,3,4,5,6,7,8,9,0.

`problem206Checker :: Integer -> Bool`

problem206Checker x = let xS = show (x*x);

in xS !! 0 == '1' && xS !! 2 == '2' && xS !! 4 == '3' && xS !! 6 == '4' && xS !! 8 == '5' && xS !! 10 == '6' && xS !! 12 == '7' && xS !! 14 == '8' && xS !! 16 == '9' && xS !! 18 == '0'

horrible but it works! The final answer is then:

`head [x | x <- [1010101010, (1010101010 + 10)..1389026623], problem206Checker x ]`

Use head since there is only one so we should stop checking the rest as soon as we find the answer. Using **zip [0,2..18] ([1..9]++[0])** will generate the pairing of index to value so there probably is a way of using that to make the function look much **much** nicer but here’s where I ran out of time for the day!