Programming Praxis – Three List Exercises

May 7, 2013

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

May 3, 2013

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

May 3, 2013

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

April 30, 2013

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

April 23, 2013

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

April 9, 2013

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

March 29, 2013

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

March 22, 2013

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]

Programming Praxis – Buffon’s Needle

March 15, 2013

In today’s Programming Praxis exercise, our goal is to approximate pi by using Georges-Louis Leclerc’s method of dropping needles on a board. Let’s get started, shall we?

import Control.Applicative
import System.Random

We’re going to be needing two sets of random numbers; one for the position and one for the angle of the needles. In order to save some code and to stop Haskell complaining about ambiguous types we make a function to generate an infinite amount of numbers in the [0,1) range.

rnds :: IO [Double]
rnds = fmap randoms newStdGen

We approximate pi by dividing the total amount of needles dropped by the number of needles that hit a line.

buffon :: Int -> IO Double
buffon n = (fromIntegral n /) . sum . take n <$>
    (zipWith (\y t -> if y < sin (t*pi/2) / 2 then 1 else 0) <$> rnds <*> rnds)

Running the simulation reveals that this isn’t a very practical way of approximating pi: after one million needles it generally only has two correct digits.

main :: IO ()
main = print =<< buffon 1000000

Programming Praxis – An Array Of Two Symbols

March 12, 2013

In today’s exercise, our goal is to write a function that, given a list consisting of m of one symbol followed by n of another symbol, returns the starting index of the second group of symbols in O(log m) time. Let’s get started, shall we?

import qualified Data.Vector as V
import Test.QuickCheck

The basis idea is simple: starting at the first element, keep doubling the index until we encounter a symbol from the second group or we run past the end of the array. Repeat the process, only now looking at the subarray from the last m to the first n (or the end of the array). When this array has only two values (by definition an m and an n), we’ve found our answer.

Unlike the provided solution, we don’t use a binary search once we’ve found our bounds. We already have one O(log m) test, so why bother writing another?

search :: V.Vector Char -> Int
search xs = f 0 (V.length xs - 1) where
    f start end = case span ((xs V.! 0 ==) . (xs V.!)) . takeWhile (<= end) .
                       map (start +) $ 0 : iterate (*2) 1
                  of   ([_],[n]) -> n
                       (ms ,[] ) -> f (last ms) end
                       (ms ,n:_) -> f (last ms) n

To test if everything is working correctly, we use a few manual tests and quickCheck for an automated one.

test :: Property
test = forAll (choose (1,100)) $ \i ->
       forAll (choose (1,100)) $ \j ->
       search (V.fromList $ replicate i 'm' ++ replicate j 'n') == i

main :: IO ()
main = do print $ search (V.fromList "mn") == 1
          print $ search (V.fromList "mmmnn") == 3
          print $ search (V.fromList "mmmmmmnnnnnnnnnnn") == 6
          quickCheck test