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

Programming Praxis – First Unrepeated Character In A String

In today’s Programming Praxis exercise, our goal is to find the find the first unrepeated character in a string, along with its index. Let’s get started, shall we?

import Data.Maybe
import Data.List

We traverse the list from right to left, keeping a list of characters we’ve already encountered and a list of possible options. When we check a character, we first check if it’s in the list of duplicate characters. If not, we then check the list of options. If the letter in question is there already, we remove it from the list of options and add it to the list of duplicates. Otherwise, we add the current character to the list of options. At the end, we return the first unique element (if any).

unrepeated :: String -> Maybe (Integer, Char)
unrepeated = listToMaybe . snd . foldr f ([], []) . zip [0..] where
    f (i,c) (ds,us) = if elem c ds then (ds, us) else
        maybe (ds, (i,c):us) (\(fi,fc) -> (fc:ds, delete (fi,fc) us)) $
        find ((== c) . snd) us

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ unrepeated "aaabc"       == Just (3, 'b')
          print $ unrepeated "aaabbbcddd"  == Just (6, 'c')
          print $ unrepeated "aaaebbbcddd" == Just (3, 'e')
          print $ unrepeated "aabbcc"      == Nothing
          print $ unrepeated "aba"         == Just (1, 'b')

Programming Praxis – Correct Horse Battery Staple

In today’s Programming Praxis exercise, our goal is to generate xkcd-style passphrases consisting of four words. Let’s get started, shall we?

import Data.Char
import System.Random.Shuffle

First, we define our criteria for acceptable words, in this case lowercase words between 5 and 9 letters.

valid :: String -> Bool
valid s = length s > 4 && length s < 10 && all isLower s

Generating a passphrase is then a simple matter of loading a dictionary, filtering the valid words, shuffling them and printing the first four chosen words.

main :: IO ()
main = putStrLn . unwords . take 4 =<<
       shuffleM . filter valid . lines =<<
       readFile "en_US.dic"

Programming Praxis – Cyclic Equality

In today’s Programming Praxis exercise, our goal is to determine if one list is cyclically equal to another. Let’s get started, shall we?

import Data.List

Rather than the provided solution which involves keep track of a bunch of pointers, we use a simple fact of cyclical lists: repeating either list twice produces a list that contains the other one if they are indeed cyclically equal. In order to prevent false positives, we also have to check whether the lengths are equal.

cyclic :: Eq a => [a] -> [a] -> Bool
cyclic xs ys = length xs == length ys && isInfixOf xs (ys ++ ys)

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ cyclic [1,2,3,4,5] [3,4,5,1,2]
          print $ cyclic [1,1,2,2] [2,1,1,2]
          print $ cyclic [1,1,1,1] [1,1,1,1]
          print . not $ cyclic [1,2,3,4] [1,2,3,5]          
          print . not $ cyclic [1,1,1] [1,1,1,1]

Programming Praxis – One Million Hits

In today’s Programming Praxis exercise, our goal is to print the number 1000000 in a creative way. Let’s get started, shall we?

I decided on trying to derive the number from a piece of text. I fairly quickly settled on summing the products of the ASCII values of adjacent pairs of characters, since it’s compact code and if you end up in the neighbourhood of one million with a fairly small piece of text. The next step was to find a piece of text that would get me close enough to 1000000 so that only minimal tweaking would be needed. After trying a few dozen quotes about programming, I stumbled on the one below, which gets us to 999965, only 35 short of the target. Now of course we could just add 35 to the result and call it a day, but that didn’t strike me as very elegant; I wanted to avoid numeric literals. After several failed attempts trying to use the number of words, xor-ing all the ASCII values and bunch of others I looked at the difference between the values of the first and last character, which turned out to be 36. Jackpot. Add a pred and we have ourselves a solution.

main :: IO ()
main = print . pred $ sum (zipWith (*) q (tail q)) + head q - last q
    where q = map fromEnum "Real programmers don't comment their code, \
                           \if it was hard to write, it should be hard \
                           \to understand and harder to modify."

Programming Praxis – Jumping Jack

In today’s Programming Praxis exercise, our goal is to determine the smallest amount of sequential numbers (starting from 1) needed to sum up to a given value, using the fact that each term may be either positive or negative. Let’s get started, shall we?

import Data.List
import Text.Printf

We use the same algorithm as the provided solution and the Stackoverflow topic where this exercise originated: find the smallest sum larger than our target number that has the same parity modulo 2 and flip the sign of terms totalling half the difference.

jack :: Int -> [Int]
jack n = snd $ head
  [ mapAccumR (\r x -> if x <= r then (r-x,-x) else (r,x)) (div (t-n) 2) [1..i]
  | (i,t) <- scanl (\(_,s) x -> (x, s+x)) (0,0) [1..]
  , t >= abs n, mod (t+n) 2 == 0]

A test to see if everything is working properly:

main :: IO ()
main = mapM_ putStrLn [printf "%3d %2d  %s" n (length j) (show j)
                      | n <- [-24..24], let j = jack n]