Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Benchmark of Rope Intranet counting function
-- | This program benchmarks different versions of the counting function for
-- the Rope Intranet problem for Google Code Jam
-- http://code.google.com/codejam/contest/dashboard?c=619102#.
--
-- To compile:
-- >>> ghc -O2 --make bench.hs
--
-- To run (Windows):
-- >>> Bench
module Main where
--import Prelude hiding (init, (++), filter, length, foldr, take, zip, sum, map)
--import Data.List.Stream
import Data.List
import System.Random
import Criterion.Main
-- | This is how I would like to write the check for crossed pairs. I find it
-- clearly expresses what it does and it uses the pairs function we wrote in
-- the first session, unchanged.
--
-- It is easily fast enough for the Code Jam large data set. Using the List
-- Stream module as a replacement for the standard list allows more fusion
-- resulting in a 30% speed improvement.
elegant :: [(Int, Int)] -> Int
elegant = length . filter crossed . pairs
crossed :: ((Int, Int), (Int, Int)) -> Bool
crossed ((l1, r1), (l2, r2)) =
(l1 < l2) /= (r1 < r2)
pairs :: [a] -> [(a, a)]
pairs xs = [(x,y) | (x:ys) <- tails xs, y <- ys]
-- This optimised pairs implementation doesn't seem to be any faster.
--pairs :: [a] -> [(a, a)]
--pairs = foldr pair [] . init . tails
-- where
-- pair (x:xs) ps = foldr ((:) . (,) x) ps xs
-- | This version was hand optimized to be fast. We could also replace the
-- folds with recursion, but it makes almost no difference. I tried
-- explicitly using unboxed ints, but the optimizer already does this for us,
-- so we gain nothing.
--
-- It is not very clear what this version does, but it is about 3 times faster
-- than the elegant solution above.
handCoded :: [(Int, Int)] -> Int
handCoded = foldl' handCoded' 0 . init . tails
where
handCoded' a ((l1, r1):xs) = foldl' test a xs
where
test a (l2, r2)
| (l1 < l2) /= (r1 < r2) = a + 1
| otherwise = a
-- | By combining all the steps into a single list comprehension, we get a
-- function that is easy to follow, if not very descriptive.
--
-- This is only 50% slower than the hand coded version.
compromise :: [(Int, Int)] -> Int
compromise xs = length [ ()
| ((l1,r1):ys) <- tails xs
, (l2,r2) <- ys
, (l1 < l2) /= (r1 < r2)
]
-- | This version shows that choosing an efficient algorithm is more important
-- than micro-optimizing code. At 100 pairs (with random distribution), this
-- version performs about the same as the hand coded version and has not been
-- optimized at all. At 1000 pairs, it is 5x faster.
--
-- I think the overall approach is clear, but the code that counts the swaps
-- could probably be clearer. It uses a modified quick sort to count the
-- number of swaps that would be required to re-sort on the right hand value,
-- rather than actually sorting. A merge sort algorithm would be better as it
-- gives O(n log(n)) worst case whereas quick sort gives O(n^2) worst case.
efficient :: [(Int, Int)] -> Int
efficient = countSwaps . map snd . sort
where
countSwaps [] = 0
countSwaps (x:xs) = countSwaps less + swaps + countSwaps greater
where
(less, greater, swaps) = split 1 xs
split _ [] = ([], [], 0)
split j (x':xs')
| x' < x = let (l, g, s) = split j xs' in (x':l, g, s + j)
| otherwise = let (l, g, s) = split (j+1) xs' in ( l, x':g, s )
-- | We use Criterion to benchmark the different versions. We run each function
-- multiple times with the same random test data.
main :: IO ()
main = do
testData <- genTestData
defaultMain
[ bench "elegant" $ nf elegant testData
, bench "hand coded" $ nf handCoded testData
, bench "compromise" $ nf compromise testData
, bench "efficient" $ nf efficient testData
]
-- | Generates a list of 100 random pairs of integers.
genTestData :: IO [(Int, Int)]
genTestData = do
as <- randomsIO
bs <- randomsIO
return . take 100 $ zip as bs
randomsIO :: Random a => IO [a]
randomsIO = newStdGen >>= return . randoms
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.