public
Last active

Benchmark of Rope Intranet counting function

  • Download Gist
Rope Intranet benchmark
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
-- | 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.