FAO Recruitment agency workers

Hello and good day to any recruitment agency workers who have made their way to my site from the link on my C.V.

Since November 2013 I have been in employment. However, some of the C.V. sites out there may still have me listed as unemployed and still looking for work. Sorry to disappoint you folks but since I’m already employed, I won’t be applying for any jobs you have available.

However at the very least, thank you for considering me as a possible candidate and I do hope you find someone to fill the role as soon as possible.

-Carl Mitchell

Welcome

Welcome.

This site serves as the portfolio of Carl Mitchell.

Here is a contents list specifying the name of the projects and the languages/technologies used for your convenience:

Do note that this is a newly created and continually updated site, so not all of my projects may have been written about just yet. For example,  some C# projects are in the process of being finished and will appear on this site soon. I’ve also recently started using the Unity game engine and hope to have some projects appear in this portfolio in the nearby future.

If you have obtained my C.V and wish to know more about any of the projects, feel free to contact me via the details specified on my C.V.

Solving Project Euler problems with Haskell Part 3 (Haskell)

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 ab 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, 11 + 22 + 33 + … + 10001000

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 2x, 3x, 4x, 5x, and 6x, 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  nCr, 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, ab, 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!

Solving Project Euler problems with Haskell Part 2 (Haskell)

A continuation from Part 1:

Problem 10 – Find the sum of all the primes below two million

The primesR function from earlier will yield the primes between a and b so primesR 2 1999999 yields all primes less than two million, then we simply sum them

sum (primesR 2 1999999)

This is very slow however because the isPrime function that primesR uses is too slow.

One problem is that we’re just going through all numbers from 2 to 1999999 and then checking whether they’re prime. We know that 2 is the only even prime number so we can immediately cut out all the even numbers in our range to make it a little faster:

primesRWithStep :: Integer -> Integer -> Integer -> [Integer]
primesRWithStep a b s = filter isPrime [a, (a + s)..b]

Then the answer becomes:

sum $ (2 : primesRWithStep2 3 1999999 2)

Of course….writing a better isPrime function is also a way of speeding things up!

Problem 12 – What is the value of the first triangle number to have over five hundred divisors?

Yes, problem 12! I did around 27 problems but they weren’t necessarily problems 1 to 27 :P

First, to generate triangle numbers:

triangleNumber :: Int -> Int
triangleNumber 0 = 0
triangleNumber n = n + triangleNumber (n - 1)

To generate factors:

factors :: Int -> [Int]
factors n = [ x | x <- [1..n], n `mod` x == 0 ]

To generate the number of factors:

numFactors :: Int -> Int
numFactors n = length (factors n)

This gives the first triangle number over 5 factors long

triangleNumber (length (takeWhile (<=5) [ numFactors x | x <- (map triangleNumber [1..]) ]) + 1)

so this gives the first triangle number over 500 factors long

triangleNumber (length (takeWhile (<=500) [ numFactors x | x <- (map triangleNumber [1..]) ]) + 1)

However, triangle numbers form a series which can be summed! So this is a faster method:

triangleNumber2 :: Int -> Int
triangleNumber2 n = (n * (n + 1)) `div` 2

I noticed that when writing out the factors of a number, the last number is always n and the second to last number is always at most equal to n/2 so there’s no reason to check any numbers in between n/2 and n. Also, 1 divides every natural number evenly so we don’t need to calculate for that either. So we can make the factors function faster:

factors2 :: Int -> [Int]
factors2 n = 1 :  [ x | x <- [2..(n `div` 2)], n `mod` x == 0 ] ++ [n]

Another way of calculating factors is to use cofactors. For example, here are the factors of 12:
1, 2, 3, 4, 6, 12
and
1 * 12 = 2 * 6 = 3 * 4.

The first number is always less than the square root of 12 and b is always 12 divided by the first number so we can also calculate factors as:

factors3 :: Int -> [Int]
factors3 n = let s = ceiling (sqrt (fromIntegral n)) :: Int in nub (concat [ [x, n `div` x] | x <- [1..s], n `mod` x == 0 ])

So my final code is:

triangleNumber2 (length (takeWhile (<=500) [ numFactors3 x | x <- (map triangleNumber2 [1..]) ]) + 1)

Problem 14 – Which starting number, under one million, produces the longest Collatz chain?

First need a function that generates collatz sequqnces:

collatzSequence :: Int -> [Int]
collatzSequence 1 = [1]
collatzSequence n
| even n = n : collatzSequence (n `div` 2)
| odd n = n : collatzSequence ((3*n) + 1)

Then a function that counts the length of collatz sequences for a specific starting number:

collatzLength :: Int -> Int
collatzLength n = length (collatzSequence n)

*Main> collatzSequence 13
[13,40,20,10,5,16,8,4,2,1]
*Main> collatzLength 13
10

Run this over the range 1..999999 storing the starting number (first) and the length (second). Then find the maximal second value and return the first.

maximumBy (\ a b -> (snd a) `compare` (snd b)) [ (x, collatzLength x) | x <- [1..999999] ]

Have to use maximumBy since we aren’t comparing singular elements but rather our own pair. So the full answer is:

fst $ maximumBy (\ a b -> (snd a) `compare` (snd b)) [ (x, collatzLength x) | x <- [1..999999] ]

Problem 15 – Starting in the top left corner of a 2×2 grid, and only being able to move to the right and down, there are exactly 6 routes to the bottom right corner. How many such routes are there through a 20×20 grid?

Using this amazing picture where the leaf nodes denote that you have reached the end point, D means you went downwards, L means you went left:

gridPath

We can see that for a 2*2 grid each path from the root to a leaf node takes 4 steps and more importantly, consists of exactly 2 lefts and 2 downs regardless of which path you take. It’s then a case of: how many different unique combinations of 2 lefts 2 downs are there? There are 6 as you can see on the graph which is precisely the answer to the question (for the example case). So for a 20*20 grid it will be a combination of 20 lefts and 20 downs. In Haskell this is done simply with the nub and permutations functions:

Prelude Data.List> let s = concat $ replicate 20 "L" ++ replicate 20 "D"
Prelude Data.List> nub $ permutations s

But this is really slow!

Or, a much easier way to calculate it is: 40 choose 20 = 137846528820

The general formula for N choose K is N! / (K! * (N-K)!) which in will need a factorial function:

factorial :: Integer -> Integer
factorial 0 = 1
factorial 1 = 1
factorial n = n * factorial (n - 1)

*Main Data.List> factorial 40 `div` (factorial 20 * (factorial (40 - 20)))
137846528820

or to store it nicely in a function:

choose :: Integer -> Integer -> Integer
choose n r = factorial n `div` (factorial r * (factorial (n - r)))

Problem 16 – What is the sum of the digits of the number 21000?

To grab the individual digits, I used the show function to turn the number into its string equivalent where I can grab the individual characters, turn it back into its integer equivalent and add it to a running sum. Once again we’re reducing a list to a single value, so I used a fold:

foldl (\acc x -> acc + (read [x] :: Int)) 0 (show (2^1000))

A really good thing about Haskell is that it can cope with very large numbers! I don’t know how I would store 2^1000 in C++.

Problem 20 – Find the sum of the digits in the number 100!

Firstly, the factorial function from before:

factorial :: Integer -> Integer
factorial 0 = 1
factorial 1 = 1
factorial n = n * factorial (n - 1)

Next, a function that takes a number and sums together its digits. This is done by simply turning the number in a list of char and then for each char, turning back into single number and adding it to the sum:

sumOfDigits :: Integer -> Integer
sumOfDigits n
| length xs == 1 = n
| otherwise = (read ([head xs]) :: Integer) + sumOfDigits (read (tail xs) :: Integer)
where xs = show n

But of course, I just showed a fold that does this in the previous problem! so why didn’t I use that instead? I actually completed problem 20 before problem 16. For this problem however, the answer is computed practically instantly regardless of what route we take:

*Main> sumOfDigits $ factorial 100
648
(0.00 secs, 12595056 bytes)
*Main> foldl (\acc x -> acc + (read [x] :: Int)) 0 (show (factorial 100))
648
(0.00 secs, 0 bytes)
*Main>

The fold option though uses less memory (but surely it doesn’t use no memory whatsoever?!).

Problem 21 – Evaluate the sum of all the amicable numbers under 10000

To calculate the proper divisors, just use the factors function but add a new conditional statement so we don’t add n to the list when calculating for n. We can also add 1 automatically and start the range from 2 since 1 is a proper factor of every integer greater than 0 (except 1 I guess!) then we need to sum the elements:

properFactors :: Int -> [Int]
properFactors n = let s = ceiling (sqrt (fromIntegral n)) :: Int in 1 : (nub (concat [ [x, n `div` x] | x <- [1..s], n `mod` x == 0, n `div` x /= n] ))

sumProperFactors :: Int -> Int
sumProperFactors n = sum (properFactors n)

To be “amicable”, sumProperFactors a needs to equal b and sumProperFactors b needs to equal a with a and b being different numbers:

isAmicable :: Int -> Int -> Bool
isAmicable a b = (a /= b) && (sumProperFactors a == b) && (sumProperFactors b == a)

Next, to get all amicable numbers under 10000:

*Main Data.List> let amics = nub [ (x,y) | x <- [1..10000], y <- [1..x], isAmicable x y ]
*Main Data.List> sum $ concatMap (\(x,y) -> [x,y]) amics

Another way is:

sum [ x | x <- [1..10000], y <- [1..10000], isAmicable x y ]

Problem 24 – What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?

Using the Data.List permutations and sort functions we get lexicographic order:

*Main Data.List> sort (permutations [0,1,2])
[[0,1,2],[0,2,1],[1,0,2],[1,2,0],[2,0,1],[2,1,0]]

The millionth element is at index 999999, so:

*Main Data.List> (sort (permutations [0,1,2,3,4,5,6,7,8,9])) !! 999999
[2,7,8,3,9,1,5,4,6,0]

The rest will be shown in part 3

Solving Project Euler problems with Haskell Part 1 (Haskell)

So I decided to begin learning Haskell. Like many functional programming languages, it isn’t used very often in the software development industry compared to its imperative cousins. However, I still believe it’s good to learn a functional programming language because you get to solve problems from a different perspective. All the problems I solved with Haskell I could’ve also used C++ or C# or anything really but by using a functional language instead, it meant that I had to approach the problems in a different manner and I believe it has strengthened my ability to problem solving since I now have several paths to take and can choose the easier path. Some of the problems were much easier to solve in functional programming than in imperative programming and vice versa. If I had only learned one of the types, I would have fewer options to reach the end goal.

There are other reasons why Haskell is useful but I’ll leave you to see the benefits of it by pointing you to the same learning resource I used — Learn You A Haskell For Great Good!

To test out what I had learned in Haskell I decided to do some of the problems listed on two websites:

I spent most of the time in Project Euler and decided to see how many of the problems I could solve using Haskell in the 2 days I had free. I got through a handful of the 99 Haskell problems before getting a little bored and moved on to complete around 20 of the Project Euler problems.

(note: If you’re a Haskell pro reading this then you might look at some of this code and think it’s terrible. Some of it definitely is(!) but realise I only started learning recently so there will be plenty of times that I miss a feature of Haskell that could’ve greatly helped or some in-built function that I have unknowingly re-invented myself. I also haven’t yet entered the world of monads either as I’m not entirely sure I will need it for my purposes).

So for my “proof” that I do indeed know Haskell, I will show and briefly describe my solutions for the problems on Project Euler. There are some I aren’t happy with performance wise since I genuinely struggled to think about how to solve the problem recursively (a commonly required skill for Haskell, which lacks sequence and iteration constructs) but none-the-less they all gave me the correct answers in just a few lines of code.

In the end I completed around 20 or so problems in the 2 days but that would take up too much space in one post so it’ll be split up into several posts, maybe 3.

Problem 1 – Find all sum of all multiples of 3 or 5 below 1000

sum [x | x <- [1..999], x `mod` 3 == 0 || x `mod` 5 == 0]

Nothing much to say here, generate a range from 1 to 999, grab the ones that satisfy the predicate (if a multiple of 3, then integer division by 3 will leave a remainder of 0, similarly for 5) then sum up all the elements in the resultant list.

Problem 2 – Find the sum of the even valued terms in the sequence of Fibonacci numbers below 4,000,000

Firstly, some people start the sequence as 0,1,1,2… whereas others start 1,1,2… but Project Euler wanted it to start as 1,2,3,5… which I’ve never seen before but oh well. Firstly, a function to generate the Fibonacci sequence:

fibonacci :: Int -> Int
fibonacci 0 = 1
fibonacci 1 = 2
fibonacci n = fibonacci (n - 1) + fibonacci (n - 2)

It uses pattern matching to grab the non-recursive cases. The answer is then found simply with:

sum $ filter even $ takeWhile (<4000000) $ map fibonacci [0..]

It can be read as: keep generating Fibonacci numbers and add to a list until you finally reach one that is at least 4,000,000. Then grab only the even ones and then sum all these even terms up. The problem with this is that if I ask for fibonacci 10, say, and then ask for fibonacci 11, it will recalculate fibonacci 10. I need to store this in some form of cache like so:

let fibonacci = 1 : 2 : zipWith (+) fibonacci (tail fibonacci)

Haskell’s laziness means I can have infinite lists like this with no problem as it’s more of a “promise” that it could produce an infinite list at some point in the future. The solution then simplifies to:

sum $ filter even $ takeWhile (<4000000) $ fibonacci

Problem 3 – What is the largest prime factor of the number 600851475143?

The first problem is finding out if a number n is prime which I did by generating all the greatest common divisors between 1 and the square root of n. If all the greatest common divisors are equal to 1 or n, then n is prime. This was done with the following functions:

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

And finally to generate multiple primes and test whether they are factors of n:

primesR :: Integer -> Integer -> [Integer]
primesR a b = filter isPrime [a..b]

primeFactors :: Integer -> [Integer]
primeFactors n = let r = ceiling (sqrt (fromIntegral n)) :: Integer
in filter (/=1) (map (greatestCommonDivisor n) (primesR 2 r))

The largest one, is simply the last one so the answer becomes:

last $ primeFactors 600851475143

This however is very slow, probably because of the fact that the method of checking if a number is prime is not done the best way but none-the-less it generates the correct answer. So I came up with a faster way that orders the expensive computations to be done as late as possible:

maximum $ filter isPrime $ filter (/=1) (map (greatestCommonDivisor 600851475143 ) [1..ceiling (sqrt (fromIntegral 600851475143)) :: Integer])

Problem 4 – Find the largest palindrome made from the product of two 3-digit numbers

Firstly, a function to detect if something is a palindrome:

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

If you reverse the list and the order of those elements equals the ordering of the initial list, it’s a palindrome. Problem is, this works on lists not numbers so you use the built in show function to turn a number into its string equivalent which in turn is seen as a list of characters. As it’s a list, we can now pass it to the above function.

maximum [ read x :: Integer | x <- filter isPalindrome [ show (x * y) | x <- [100..999], y <- [100..999] ] ]

So when read from right to left, generate all the product combinations for 3 digit numbers, use show to create the string equivalent, then grab those strings that are palindromes and re-extract the number from the string (the read function is sort of the opposite of show). We are no left with a list of palindromic numbers and pass it to the maximum function to find the largest in this list.

Since x * y is equal to y * x we can shorten the y range to make the function faster:

maximum [ read x :: Integer | x <- filter isPalindrome [ show (x * y) | x <- [100..999], y <- [100..x] ] ]

Problem 5 – What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?

This problem comes with the example:

2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.

This can be shown to be true with the following code and its output:

*Main> map (mod 2520) [1..10]
[0,0,0,0,0,0,0,0,0,0]
*Main> map (mod 2520) [1..20]
[0,0,0,0,0,0,0,0,0,0,1,0,11,0,0,8,4,0,12,0]

We basically need to find a number n such that map (mod n) [1..20] produces all zeroes.

This was my first attempt:

(fst $ last $ takeWhile (\(n, r) -> r == False) ([ (x, all (==0) (map (mod x) [1..20])) | x <- [1..] ])) + 1

But it’s laughably slow so I decided to look for another way and did some research into the modulus. It turns out that we can also find this answer by calculating the lowest common multiple between 20 and the lowest common multiple of all the numbers before it. So it’s very similar to how the factorial is calculated in that 5! = 5 * 4! = 5 * 4 * 3! and so on all the way down. It just so happens that there is a built in method that calculates the lowest common multiple, lcm. The next part is to recursively call the function on the entire list to reduce it to a single value…this is a fold! and there’s also a bunch of fold functions built in too so this problem is solved very easily with Haskell:

foldl (lcm) 1 [1..20]

Problem 6 – Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum

This one is really easy!

let sumOfSquares = sum $ map (^2) [1..100]; squareOfSum = sum [1..100] ^ 2
in squareOfSum - sumOfSquares

One map to generate all the squares, and then sum it and another map to generate the sum and then square it and finally a subtraction between the two.

Problem 7 – What is the 10 001st prime number?

Using the isPrime function from an earlier problem, I made a function that generates an infinite list of primes:

primesS :: Integer -> [Integer]
primesS a = filter isPrime [a..]

Then you simply assign a number to each prime and stop when you reach the 10001st one:

let primes = primesS 2
snd $ last $ zip [1..10001] primes

Problem 8 – Find the thirteen adjacent digits in the 1000-digit number that have the greatest product. What is the value of this product?

Making the number a string (char list) is easiest to allow us to go through the digits one at a time. Then using the Data.Char digitToInt function, we turn the char containing a number into an actual number and sum up every 13 numbers.

productNFromString :: [Char] -> Int -> Int -> Int -> Int
productNFromString s x l si
| si >= l = 1
| si < l = digitToInt (s !! x) * productNFromString s (x + 1) l (si + 1)

maximumProductNFromString :: [Char] -> Int -> Int
maximumProductNFromString ns l = maximum [ productNFromString ns x l 0 | x <- [0..(length ns - l)]]

s is the string form of the large number, x is the index to start from, l is the limit to how far ahead of x we need to go (so for example, if x was 10 and l was 4 then we need to use 10, 11, 12, 13 as indices but not any further) and si is just an internal counter keeping track of how far ahead of l we have gone so far (so we know when to stop).

The 1000 digit number itself is well, very large, so I won’t paste it here just grab it from Project Euler!

Problem 9 – There exists exactly one Pythagorean triplet for which a + b + c = 1000. Find the product abc.

Since the condition a + b + c = 1000 is there, then we can immediately limit the search for values of a b and c between 1 and 1000.

isPythaTriplet :: Int -> Int -> Int -> Bool
isPythaTriplet a b c = a^2 + b^2 == c^2

filter (\(a,b,c) -> isPythaTriplet a b c) [ (a, b, c) | a <- [1..1000], b <- [1..1000], c <- [1..1000] ]

The above generates a list of all valid triangles with a b c values between 1 and 1000.

filter (\(a,b,c) -> a + b + c == 1000) $ filter (\(a,b,c) -> isPythaTriplet a b c) [ (a, b, c) | a <- [1..1000], b <- [1..1000], c <- [1..1000] ]

The above filters the list to include only the ones where a + b + c == 1000

Since we know there is only one possible solution, the resultant list should have only one element so we can use the head function to get it

let answer = head $ filter (\(a,b,c) -> a + b + c == 1000) $ filter (\(a,b,c) -> isPythaTriplet a b c) [ (a, b, c) | a <- [1..1000], b <- [1..1000], c <- [1..1000] ]

*Main> answer
(200,375,425)
*Main> (\(a,b,c) -> a * b * c) answer
31875000

A better solution may have been to filter out all the triplets that sum up to 1000, then filter out the ones that are triangles after wards since the pythatriplet test is the most expensive part of the expression by far:

filter (\(a,b,c) -> isPythaTriplet a b c) $ filter (\(a,b,c) -> a + b + c == 1000) [ (a, b, c) | a <- [1..1000], b <- [1..1000], c <- [1..1000] ]

Another optimization is to realise that 3 4 5 and 4 3 5 are the same, the order doesn’t matter for the first two, so we can just take the first ordering of 3 4 5 and ignore the latter one. Also, the last number is always larger than the first two so with these two constraints in place, the first is always smaller than the second which is always smaller than the third. This means instead of having “a” go between 1 and 1000 (and similarly for b) we can have:

filter (\(a,b,c) -> isPythaTriplet a b c) $ filter (\(a,b,c) -> a + b + c == 1000) [ (a, b, c) | c <- [1..1000], b <- [1..c], a <- [1..b] ]

With the optimizations shown in bold in the texas ranges.

Another optimization is that C only needs to be at most 500 because there is no a and b such that a^2 + b^2 == 500^2 AND a + b + 500 <= 1000

In terms of what it’s doing, there isn’t much more to optimize. However, because of the constant tupling and un-tupling of data, we can certainly optimize how it’s doing it. By getting rid of the tuples altogether! And also replacing the (\(a,b,c) -> a * b * c) lambda with the built in product function and moving the filters inside the list comprehension itself so we’re reducing the number of times the list data gets copied:

*Main> product $ head $ [ [a, b, c] | c <- [1..500], b <- [1..c], a <- [1..b], a + b + c == 1000, isPythaTriplet a b c ]
31875000

I then thought of another slight optimization. There’s no point in iterating through a texas range for A. If we know what a + b + c == 1000 and we know the values of b and c, we can rearrange the equation to get a == 1000 – b – c and since we know the values of b and c, we can get the exact value for a:

product $ head $ [ [a, b, c] | c <- [1..500], b <- [1..c], a <- [1000-b-c], isPythaTriplet a b c ]

which is much much faster than any of the above attempts.

Stay tuned for parts 2 and 3 coming up.

Final Fantasy XIV Mini-Cactpot Helper (C++)

Yesterday (24th Feb 2015), the online MMORPG Final Fantasy XIV launched a patch that included, among many other things, the Mini-Cactpot lottery, a sort of scratchcard lottery that isn’t entirely dependent on luck. Here is a short summary of the rules, pasted from the patch notes:

Every ticket has nine spaces, each numbered randomly from one to nine. At the start, however, eight of these nine spaces will be hidden. To begin, select three numbers from the eight hidden on your ticket. Next, select one of eight lines─vertical, horizontal, or diagonal. When selecting a line, the sum of the three numbers in that line will determine the amount of MGP you receive.

Common sums receive smaller amounts of “MGP” (the currency) whereas the rarest sum (6, which can you can only get with a line of 1, 2, 3) gets the grand prize of 10000. As you can see in the rules, 4 of the 9 values will be un-hidden meaning you can calculate all combinations of what each line (column, row, diagonal) can produce and find which line gives the better odds of landing on a sum with a higher payout. It all just depends on where the 4 initial un-hidden numbers were and what numbers they were. After that it’s just a very large amount of sums, finding the payouts for each of these sums and calculating the average payout for each line. Simple to do on paper but very time consuming and tedious.

So I wrote a program that does it all for me.

It asks the user to input the un-hidden numbers and place them into the correct positions and then:

  1. Finds out which numbers weren’t used in the initial un-hiding stage. These are the numbers used to generate all possible combinations with the un-hidden numbers
  2. For each of the 8 lines (3 columns, 3 rows, 2 diagonals), find out how many hidden numbers (denoted by a value of 0) remain.
    1. If there are 0 hidden numbers, there is only 1 combination and the sum & payout are easy to calculate
    2. If there is 1 hidden number, sum the 2 un-hidden ones in that line and find all 5 combinations between the two known numbers and each of the 5 unknown numbers
    3. If there are 2 or 3 hidden numbers, we do practically the same thing but the generation of all possible sums (and their payouts) is a little more complex. 2 hidden values requires a loop within a loop and 3 hidden values requires a loop within a loop within a loop but is still overall not too complex.
  3. Prints out all the sums and payouts for each line along with the average (mean) payout

Note that you can’t guarantee a great win at all, random is still random, luck is still luck but this helps steer you towards the lines which are more likely to give a higher payout.

A picture of it in action. The zeroes correspond to the unknown hidden values and the 4 non-zero values are the 1 value the game gives me and the results of the 3 choices I get to unveil more values.

Click on the image to make it larger and more legible.

Click on the image to make it larger and more legible.

As we can see from the output, there are two lines (row 2 and the diagonal going from top-right to bottom-left) that are much more likely to give me better prizes than the other lines. Row 2 technically has the highest expected payout but it also has a lot of very small payouts (36 is the worst and there are multiple 36 payouts) whereas the diagonal line has a smaller average but at worst will give 72, twice the smallest in row 2. So seeing both the average payout and also all of the possible payouts allows you to reason more easily which line you want to choose to maximise your odds of getting a good payout.

In the future I intend to produce a visual version of the program using C# and WPF but at the moment my time is taken up by work and my studies on Haskell and the Unreal Engine 4. A post about Haskell and some stuff I’ve written with it will hopefully appear soon.

As with all my other projects, if you wish to see the source code then please email me at the address specified on my C.V if and only if I have applied to your company and I would be more than happy to show you.

Procedural World Map Generation (JavaScript, HTML5)

Next in line for JavaScript is an application that can create and draw world maps consisting of several continents.

It is essentially a variant of the fractal Midpoint displacement algorithm and works as so:

For each island:

  • Pick a number of initial points, low numbers like 2 or 3 will form a line shaped or triangle shaped continent and higher numbers will form a circle.
  • Pick a radius, essentially the size of the island
  • Pick an offset, during the tessellation stage, when randomness is added, how much randomness should be used to offset the newly created point?
  • Pick a scale factor, for each level of tessellation the offset needs to be decreased in size and this scale will determine by what % it will decrease (0.5 = 50% for example).
  • With these 4 pieces of data:
    • Generate the initial points using the radius and number of initial points required. For now, the island is simply placed at (0, 0) and generates the points on a circle connect by lines
    • For N levels of tessellation (9 seems to be the most before any more detail added is smaller than 1 pixel):
      • Find the middle of each pair of points
      • Add a random offset to the x and y values, determined by the value set as the “offset” before
      • Add the newly generated point to the list of points
      • Once all points have been subdivided and offset, reduce the offset value by the scale factor

And doing so for M number of islands which each have a position vector that can be used to move them around.

The application also comes with the following features:

  • Regenerate any selected island with new random data without changing the others
  • Reposition any selected island with new x and y coordinates
  • Change any of the following, that will be used the next time an island is regenerated (essentially every variable is changeable):
    • Number of initial points used
    • Radius
    • Offset
    • Scale factor
  • Add new islands to the existing world map, which will also automatically select it as the “currently selected island” when applying changes.
  • Remove selected islands from the existing world map
  • Place all the islands in random positions, large islands may merge into larger islands allowing you to create complex looking continents
  • Choose the draw the islands “number” so when selecting an island with the GUI, you know which one you are modifying
  • Click to select the island you want to change, a circle will be drawn around the current chosen island. Deselect by clicking on the ocean or clicking the Deselect option from the GUI (if you place too many islands and there’s no ocean to click!). Selecting an island will also automatically update the GUI values such as x position, y position and selected island.

The GUI is from the datGUI library.

See this video: I recommend watching in full screen and at a HD resolution if you can in order to see the finer details of the fractal and to also be able to see the GUI properly.

Overall I’m quite pleased with the application but there is one thing I wish I could do with it. At the moment it only shows a blue ocean and green islands, there’s nothing on the islands such as elevation data, river data, etc. Unfortunately since I’m only storing the points of the islands coast and not the points in between, then I would have to go about this application in a very different way if I wanted something on the actual islands. They would have to be split into (and drawn separately as) polygons rather than being outlined and filled in in-place like it is now. Maybe some other day?

As with my other work, if you want to see the source then please contact me via the details on my CV I’ve sent you.

Collision Detection and Resolution Part 2: 3D (JavaScript, HTML5, ThreeJS)

As well as learning JavaScript, I’m also learning how to use the various JavaScript libraries out there. One of the more exciting libraries is the ThreeJS library that allows you to create WebGL applications in JavaScript and use the GPU for rendering to the HTML5 canvas (rather than CPU rendering, also known as Software renderering, which is remarkably slower).

So I decided to create a 3D version of this which in turn is a JavaScript port of this.

Unfortunately, due to Google* Drive’s new “update” under the guise of “making it easier for our users” (read: removing commonly used features in order to save money), I can no longer use it to host my javascript work so I’ll have to use the same method as before: either a video of it in action uploaded onto youtube or a series of pictures. Here’s the video:

If you can, watch it full screen in HD. Also, youtube only shows videos at 30fps as of Aug 2014 which is a shame :( so the video won’t look as smooth as it actually runs.

As with all my work, if you want the original source, please contact me via the details on my CV and also state your name as I will only send to companies I have applied to.

It has the same problems as the 2D version in that I just place the cubes randomly so they might be intersecting from the word go, so give them a few frames to resolve any interpenetration.

Collision Detection & Resolution PORT (JavaScript, HTML5)

(Finally, I get some time to program some of my own stuff — my first bit of spare time in months)

If you asked me a year ago if I liked JavaScript, I would’ve said no but the thing is, I had never really learnt it. There was a single module in my bachelor’s degree (a second year module called Web Server Programming, I think) that had us writing a small amount of JavaScript. But that’s all the JavaScript I knew.

Similarly, if you ask others if they like JS, a seemingly large amount of people will say no too.

For me at least, I was wrong about JS.

I had noticed a large number of companies asking for it so I decided to learn it and to be honest, I actually kind of like it. There are plenty of pitfalls to be sure just as any language but there’s also a lot of really nice features that I like. Closure is absurdly useful and the fact that almost everything, even functions, are first class objects is very cool. I think when people say they dislike JS they mostly mean they dislike the DOM.

So after learning a bit of JS, I decided to port one of my previous projects, specifically the collision detection and resolution from here.

It turns out you need a paid account to host html/js/css/etc. on wordpress so it’s hosted on my google drive account. Hopefully this link actually works:

Click here to view the demo in your browser

There are some things to note however:

  • The physics detection is definitely working but the physics resolution seems to be slightly buggy under certain conditions. Sometimes the boxes turn red (collision detected) but don’t seem to move apart from each other (collision not resolved). I think it’s because the boxes all have 0 acceleration (any velocity change is done as an immediate impulse) and 0 relative acceleration is causing some small amount of imprecision.
  • When the program runs, it just places the boxes in random positions so it’s likely that some boxes will be overlapping from the very beginning, give it a few frames to correct itself!
  • Finally, the source code is minified, you can still technically read it but it’s difficult to do so. If you want the non-minified version that has comments and whitespace, please contact me either by email or phone as listed on my C.V. and please state who you are representing as I will only give out code to those who I have applied to

I want to do more stuff in JavaScript and I think the new JS program I do will be something interactive and something to do with fractals! Perhaps a world map generator? Eventually.