Archive for October, 2012

Programming Praxis – Pandigital Numbers

October 30, 2012

In today’s Programming Praxis exercise, our goal is to find all possible combinations in which two 3-digit sum up to a 4-digit number, with the condition that no digit is repeated in the three numbers. Let’s get started, shall we?

A quick import:

import Data.List

We’re going for the simple though somewhat inefficient approach of simply taking all possible combinations and filtering on the conditions we have. Checking for repeated digits is done by checking whether the string representation is equal to the string representation minus duplicate characters. Again, there are certainly quicker methods but since the whole program runs in 0.2 seconds anyway I personally prefer the short and easy to understand version.

pandigital :: [(Int, Int, Int)]
pandigital = [(a, b, a+b) | a <- d3, b <- d3, b > a, a+b > 999, unique [a, b, a+b]]
    where d3 = filter (unique . return) [100..999]
          unique = (\x -> x == nub x) . (show =<<)

Finding the smallest triplet of numbers is a separate task, but it’s a trivial one because our function returns all of them in ascending order, so we can simply take the first element.

main :: IO ()
main = do print $ head pandigital == (246,789,1035)
          print pandigital

Programming Praxis – Prime Partitions

October 19, 2012

In today’s Programming Praxis exercise, our goal is to calculate the number of prime partitions for a given number. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.Map as M
import Data.Numbers.Primes

First we need to calculate the sum of the unique prime factors of a given number. The trivial way is to to take the list of prime factors, filter out the unique numbers and sum those. In the provided solution this is marked as the wrong way since there is a more efficient solution. On the other hand, we only need to this once each for the numbers 1 through 1000, so it’s not like it’s a massive performance bottleneck. Since performance doesn’t matter much, I personally prefer the straightforward, easy to understand implementation.

sopf :: Integer -> Integer
sopf = sum . nub . primeFactors

At first glance, the algorithm for the amount of prime partitions bears some resemblance to the Fibonacci function. The difference here is that each term refers to all of its predecessors instead of a fixed number, which means the typical zipWith solution won’t work. Instead, we build op a dictionary where for each number we store sopf(n) and k(n) so we don’t have to recalculate them.

k :: Integer -> Integer
k n = snd $ foldl' calc M.empty [1..n] M.! n where
    calc dict i = M.insert i (s, div (s + sum (map (\j -> (fst $ dict M.! j) *
        (snd $ dict M.! (i - j))) [1..i-1])) i) dict where s = sopf i

A test to see if everything is working properly:

:: IO ()
main = print $ k 1000 == 48278613741845757

Programming Praxis – Birthday Paradox

October 12, 2012

In today’s Programming Praxis exercise, our goal is to simulate the well-known birthday paradox. Let’s get started, shall we?

Some imports:

import Control.Monad
import Data.List
import System.Random

A single run consists of assigning each person a birthday (assuming they are distributed uniformly throughout the year) and checking whether there are any duplicates.

paradox :: Int -> IO Bool
paradox n = fmap (\g -> or [elem h t | (h:t) <- tails . take n $
            randomRs (1, 365 :: Int) g]) newStdGen

Determining the chance that a given population shares a birthday is a matter of running the test a large number of times and returning the percentage of cases in which a birthday is shared.

trial :: Int -> IO Float
trial = fmap ((/ 100) . genericLength . filter id) . replicateM 10000 . paradox

We have to run the test for a group of 23 people (50% chance) and 57 people (99% chance).

main :: IO ()
main = do print =<< trial 23
          print =<< trial 57

A random trial run produces 50.38% and 99.03%, respectively, which are close enough to confirm the birthday paradox.

Programming Praxis – Two Word Games

October 9, 2012

In today’s Programming Praxis exercise, our goal is to find all the words in a dictionary that satisfy two different criteria. Let’s get started, shall we?

First we have to find the words that have the five vowels in ascending order. To do this we simply check if the vowels in the words are equal to the five vowels in order.

ascVowels :: String -> Bool
ascVowels = (== "aeiou") . filter (`elem` "aeiou")

The second game is to find all the six-letter words whose letters are ascending. All we need to check is check the length and whether the first letter of each pair of subsequent letters comes before the second one.

sixAsc :: Ord b => [b] -> Bool
sixAsc s = length s == 6 && and (zipWith (<) s $ tail s)

All that’s left to do is to load the dictionary and print the appropriate words:

main :: IO ()
main = do ws <- fmap lines $ readFile "354984si.ngl"
          mapM_ putStrLn $ filter ascVowels ws
          putStrLn "---"
          mapM_ putStrLn $ filter sixAsc ws