Archive for June, 2013

Programming Praxis – A Programming Puzzle

June 28, 2013

In today’s Programming Praxis exercise, our goal is to write a function such that f (f n) = -n. Let’s get started, shall we?

My first instinct was to define f as a 90 degree rotation using the complex plane, but decided that that was against the spirit of the exercise. The input is plain integers, so the output shouldn’t consist of complex numbers. After that I mucked around for a good while with doubling and halving numbers, which worked on everything except multiples of four. The basic idea (reversing parity and/or signs) was correct, but halving numbers always produced cases where the same condition holds for n and f(n). About an hour and a half after starting on the exercise the solution finally hit me: simply swap each pair of adacent numbers and reverse the sign for the even ones. I replaced the first draft of the correct solution, which had the four conditions written out, with the following more elegant formula.

f :: Integer -> Integer
f n = n * (2 * mod n 2 - 1) + signum n

A test to see if everything is working properly:

main :: IO ()
main = print $ all (\n -> f (f n) == -n) [-1000..1000]

Programming Praxis – 3SUM

June 18, 2013

In today’s Programming Praxis exercise, our goal is to find all groups of three numbers in a given list that sum up to 0, and to do so in O(n2). Let’s get started, shall we?

import Data.List
import qualified Data.IntSet as I

The naive O(n3) version can be modified fairly easily to be more efficient. The first two loops can remain unchanged. In the final loop, we already know the number we’re looking for (the complement of the other two and all we need to know is whether it exists in the list. This can be done in O(1) using an IntSet. Unfortunately, this returns every triple thrice, so we sort the triples (O(1)) and remove the duplicates (I used the rather inefficient nub function here for the sake of brevity; in practive you’ll probably want to use a Set to reduce this part from O(k2) to O(k log k)).

sum3 :: [Int] -> [[Int]]
sum3 xs = nub [sort [a,b,-a-b] | (a:bs) <- tails xs, b <- bs, I.member (-a-b) s]
          where s = I.fromList xs

A test to see if everything is working properly:

main :: IO ()
main = print $ sum3 [8,-25,4,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

To check whether the function is indeed O(n2) I ran some timings by using list of consecutive numbers:

Input list
Time taken
1 to 8000 0.4s
1 to 16000 1.4s
1 to 32000 5.2s
1 to 64000 20.6s

As you can see, doubling the input size leads to a quadrupling of execution time, give or take a few tenths of a second, which means the algorithm is indeed O(n2).

Programming Praxis – Longest Substring Of Two Unique Characters

June 11, 2013

In today’s Programming Praxis exercise, our goal is to find the longest substring consisting of only two characters in a string. Let’s get started, shall we?

import Data.List

First, we group identical characters together and then take all the tails so that each tail starts with two unique groups of characters. This is to eliminate the need for special logic for cases where a substring starts with two identical characters. For each tail, we discard everything starting from the third unique letter. Of the remaining groups, we look for the longest one, giving preference to ones on the right.

lstuc :: Eq a => [a] -> [a]
lstuc xs = foldr (\x a -> if length x > length a then x else a) []
           [concat $ a:b:takeWhile (flip elem [head a, head b] . head) cs
           | (a:b:cs) <- tails $ group xs]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ lstuc "abcabcabcbcbc" == "bcbcbc"
          print $ lstuc "abababcabc"    == "ababab"
          print $ lstuc "abcacacabc"    == "cacaca"
          print $ lstuc "acacbdbd"      == "bdbd"
          print $ lstuc "aaccbdb"       == "aacc"
          print $ lstuc ""              == ""

Programming Praxis – Sets

June 7, 2013

In today’s Programming Praxis exercise, our goal is to implement a Set data structure. Let’s get started, shall we?

import Data.Hashable
import qualified Data.HashTable.IO as H
import Data.List (sort)

The data structure underlying our Set will be a hashtable. This does have the downside that all operations will be monadic, but has the advantage that Set elements do not need to implement Ord. Initially I used the HashTable from Data.HashTable.ST.Basic, but I decided that having everything operate in the IO monad would be more convenient when using it.

data Set a = Set (H.BasicHashTable a ())

new, member, adjoin and delete are thin wrappers around the existing hashtable functions. Since we only care about the keys in the hashtable, we simply insert Unit as values. Additionally, we make adjoin and delete return the modified set to make chaining operations easier.

new :: IO (Set a)
new = fmap Set H.new

member :: (Eq a, Hashable a) => a -> Set a -> IO Bool
member x (Set s) = fmap (maybe False $ const True) $ H.lookup s x

adjoin :: (Eq a, Hashable a) => a -> Set a -> IO (Set a)
adjoin x (Set s) = H.insert s x () >> return (Set s)

delete :: (Eq a, Hashable a) => a -> Set a -> IO (Set a)
delete x (Set s) = H.delete s x >> return (Set s)

fold is a convenience function that reorders the parameters of the existing fold on hashtables and ignores the values, which results in significantly cleaner code in some of the functions below.

fold :: (a -> b -> IO b) -> Set a -> b -> IO b
fold f (Set s) x = H.foldM (\a (k,_) -> f k a) x s

For a union, we simply insert all the keys of both sets in a new one. Thanks to the fold function we can chain everything together nice and neat.

union :: (Eq a, Hashable a) => Set a -> Set a -> IO (Set a)
union s1 s2 = fold adjoin s2 =<< fold adjoin s1 =<< new

Since intersect and minus are virtually identical, I’ve refactored the common code into a combine function.

combine :: (Eq a, Hashable a) => (Bool -> Bool) -> Set a -> Set a -> IO (Set a)
combine cond s1 s2 = fold (\k a -> member k s2 >>= \b ->
    if cond b then adjoin k a else return a) s1 =<< new 

The insersect function takes the elements from the first set that do exist in the other one…

intersect :: (Eq a, Hashable a) => Set a -> Set a -> IO (Set a)
intersect = combine id

and the minus functions takes the ones that don’t.

minus :: (Eq a, Hashable a) => Set a -> Set a -> IO (Set a)
minus = combine not

To convert the hashtable to a list we just cons all the elements together. Note that since the order is determined by the hashing algorithm, the resulting list is not guaranteed to be ordered. Hence you will see calls to sort in the tests when the results are checked.

toList :: Set a -> IO [a]
toList s = fold ((return .) . (:)) s []

We could calculate the size of the set with another fold, but this is shorter, more intuitive and works just as well.

size :: Set a -> IO Int
size = fmap length . toList

Some tests to see if everything is working correctly:

main :: IO ()
main = do s <- adjoin 1 =<< adjoin 2 =<< adjoin 3 =<< new
          t <- adjoin 3 =<< adjoin 4 =<< adjoin 5 =<< new
          print . (== [1..3]) . sort =<< toList s
          print . (== 3) =<< size s
          print . (== [3..5]) . sort =<< toList t
          print . (== 3) =<< size t
          print . (== [3 :: Int]) =<< toList =<< intersect s t
          print . (== [1..5]) . sort =<< toList =<< union s t
          print . (== [1..2]) . sort =<< toList =<< minus s t

Programming Praxis – Egyptian Fractions

June 4, 2013

In today’s Programming Praxis exercise, our goal is to convert a given fraction to a sum of fractions with numerator 1. Let’s get started, shall we?

import Data.Ratio

The implementation is fairly similar to the provided one. The main difference is that the ceiling of the fraction is performed via a div, eliminating potential problems with floating point inaccuracies.

egypt :: Integer -> Integer -> [Integer]
egypt 1 d = [d]
egypt n d = e : egypt (numerator r) (denominator r)
            where (e,r) = (div (d+n-1) n, n%d - 1%e)

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ egypt 5 6 == [2,3]
          print $ egypt 7 15 == [3,8,120]
          print $ egypt 5 121 == [25,757,763309,873960180913
                                 ,1527612795642093418846225]