Programming Praxis – The Seven Bridges of Königsberg

In today’s Programming Praxis exercise, our goal is to write a function that determines whether a given graph is a eulerian circuit, path, or neither and if so, to produce that path. Let’s get started, shall we?

import Data.List
import qualified Data.Map as M

A graph that has 1 or more than 2 vertices with an odd amount of neighbours will never be a eulerian path. To determine whether a path is a circuit we simply check if it loops around. If possible, we start at a vertex with an odd amount of neighbours, since this is required for paths and optional for circuits.

check :: Ord a => M.Map a [a] -> Maybe (String, [a])
check graph | notElem (length . filter (odd . length) $ M.elems graph) [0,2] = Nothing
            | head path == last path = Just ("Circuit", path)
            | otherwise              = Just ("Path", path)
    where path  = walk [] graph start
          start = maybe (last $ M.keys graph) id $

To actually walk the graph we use the algorithm provided in the problem description.

walk :: Ord a => [(a, [a])] -> M.Map a [a] -> a -> [a]
walk stack g v = case (g M.! v, stack) of
    (n:_,_)        -> walk ((v, g' M.! v):stack) g' n where
                      g' = M.adjust (delete n) v $ M.adjust (delete v) n g
    ([] ,(s,_):ss) -> v : walk ss g s
    ([] ,[])       -> [v]

Some tests to see if everything is working properly:

main :: IO ()
main = do
    let square   = M.fromList [('A',"BC"), ('B',"AD"), ('C',"AD"), ('D',"BC")]
    let envelope = M.fromList [('A',"BCD"), ('B',"ACD"), ('C',"ABDE"), ('D',"ABCE"), ('E',"CD")]
    let seven    = M.fromList [('A',"BBC"), ('B',"AACDD"), ('C',"ABD"), ('D',"BBC")]
    let five     = M.fromList [('A',"BC"), ('B',"ACD"), ('C',"ABD"), ('D',"BC")]
    let star     = M.fromList [('A',"B"), ('B',"ACD"), ('C',"B"), ('D',"B")]
    print $ check square
    print $ check envelope
    print $ check star == Nothing
    print $ check seven == Nothing
    print $ check five

Programming Praxis – Coin Change, Part 1

In today’s Programming Praxis exercise, our goal is to list all of the ways in which a target amount can be reached given a list of coin denominations. Let’s get started, shall we?

import Data.List

We check the first remaining coin to see if it’s not bigger than the remaining target amount. If so, subtract it from the target amount and call the algorithm recursively. If not, delete it from the list of remaining coins and continue. When the remaining amount reaches 0, we have found a valid combination.

coins :: (Num a, Ord a) => [a] -> a -> [[a]]
coins _  0 = [[]]
coins xs n = [c:r | (c:cs) <- tails xs, c <= n, r <- coins (c:cs) (n-c)]

Since the logic for counting the total number of options and generating the options is nigh identical, we simply ask for the length of the resulting list.

count :: (Num a, Ord a) => [a] -> a -> Int
count xs = length . coins xs

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ count [1,5,10,25] 40 == 31
          mapM_ print $ coins [1,5,10,25] 40

Programming Praxis – MindCipher

In today’s Programming Praxis exercise, our goal is to solve two exercises from the MindCipher website (technically three, but the third one can be solved without programming). Let’s get started, shall we?

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

The first exercise is to see which pattern, on average, takes longer to come up when flipping a coin: heads, tails, heads or heads, tails, tails. First, we define a function to simulate single series of flips, counting the number of flips before the desired pattern is produced. Heads and tails are represented as booleans for the sake of convenience.

flipUntil :: [Bool] -> IO Int
flipUntil pattern = fmap (length . takeWhile (not . isPrefixOf pattern) .
                    tails . randomRs (False, True)) newStdGen

Next, we simulate an entire day by repeating this process 10000 times and taking the average.

day :: [Bool] -> IO Double
day pattern = fmap (\cs -> fromIntegral (sum cs) / fromIntegral (length cs)) .
              replicateM 10000 $ flipUntil pattern

For the second exercise, we need to find the first year for which the sum of both groups of two digits is equal to the middle two digits. This is easily achieved via a simple brute-force search.

sumDay :: Maybe Integer
sumDay = find (\d -> div d 100 + mod d 100 == div (mod d 1000) 10) [1979..]

Running our two algorithms shows that monday’s pattern takes longer on average and that the first year that satisfies the criteria is 2307.

main :: IO ()
main = do print =<< liftM2 compare (day [False, True, False])
                                   (day [False, True, True])
          print sumDay

Programming Praxis – Three List Exercises

In today’s Programming Praxis exercise, we need to implement three functions that work on linked lists. Let’s get started, shall we?

The first function removes every nth element from a list.

deleteNth :: Int -> [a] -> [a]
deleteNth _ [] = []
deleteNth n xs = take (n - 1) xs ++ deleteNth n (drop n xs)

For the second function we need to remove all the duplicate elements of a list. This is the basic O(n^2) version, keep a separate Set or Hashtable for O(n log n) or O(n) performance.

nub :: Eq a => [a] -> [a]
nub = foldl (\a x -> if elem x a then a else a ++ [x]) []

And finally a function to split a list into two halves. This implementation is probably a little slower than the tortess and hare algorithm, but the code is shorter and more self-explanatory.

half :: [a] -> ([a], [a])
half xs = splitAt (div (length xs) 2) xs

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ deleteNth 4 [1..10] == [1,2,3,5,6,7,9,10]
          print $ deleteNth 3 [1,2] == [1,2]
          print $ nub [1..5] == [1..5]
          print $ nub [1,1,2,3,4,5] == [1..5]
          print $ nub [1,1,2,3,4,5] == [1..5]
          print $ nub [1,2,1,3,1,4,1,5,1] == [1..5]
          print $ nub [1,2,2,3,3,3,4,4,4,4,5,5,5,5,5] == [1..5]
          print $ half [1] == ([],[1])
          print $ half [1..5] == ([1,2],[3,4,5])
          print $ half [1..6] == ([1,2,3],[4,5,6])

Programming Praxis – Pairing Students, revisited

In my initial attempt of today’s Programming Praxis exercise, I misunderstood the problem. Rather than producing all sets of pairs, I instead produced all pairs. Below is the revised solution. Note that it produces a different output than the provided solution. This is because the provided solution only rotates clockwise and not counterclockwise. However, since the problem asks to produce all possible pairs I feel this is a more correct solution.

import Data.List

Given a list, we produce all possible combinations containing the first element. We combine each of those solutions with all possible pairings of the remaining elements.

pairSets :: Eq a => [a] -> [[(a, a)]]
pairSets [] = [[]]
pairSets (x:xs) = concat [(map ((x,b) : ) . pairSets $ delete b xs) | b <- xs]

Some tests to see if everything is working properly:

main :: IO ()
main = do mapM_ print $ pairSets [1..4]
          mapM_ print $ pairSets [1..6]

Programming Praxis – Pairing Students

In today’s Programming Praxis exercise, our goal is to produce all combinations of two elements of a list, without duplicates. Let’s get started, shall we?

import Data.List

The basic idea is pretty simple: we start with the first element and make all combinations with the other ones. Since that element is now no longer needed, we can remove it and repeat the process for the rest of the list.

pairs :: [a] -> [(a, a)]
pairs xs = [(a,b) | (a:bs) <- tails xs, b <- bs]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ pairs [1..4]
          print $ length (pairs [1..4]) == 6
          print $ pairs [1..6]
          print $ length (pairs [1..6]) == 15
          print $ pairs [1..16]
          print $ length (pairs [1..16]) == 120