Skip to content

Commit 47929b6

Browse files
ulysses4everulysses4ever
committed
benchrunner: don't pre-allocate all arrays at once (fix #41)
1 parent c66e51d commit 47929b6

File tree

10 files changed

+283
-214
lines changed

10 files changed

+283
-214
lines changed

‎benchrunner/Benchrunner.hs‎

Lines changed: 8 additions & 120 deletions
Original file line numberDiff line numberDiff line change
@@ -2,129 +2,18 @@
22

33
module Main where
44

5-
import Data.Int ( Int64 )
6-
import System.Random ( Random, newStdGen, randoms )
7-
import Data.Proxy ( Proxy(..) )
8-
import Control.DeepSeq ( NFData, force )
95
import Data.List.Split ( splitOn )
106
import System.Environment ( getArgs )
11-
import Control.Monad ( unless, replicateM )
12-
import Text.Read
13-
import Linear.Common
14-
import Types as T
7+
import Control.Monad ( unless )
158

16-
import qualified Data.Primitive.Types as P
9+
import qualified Array as A
10+
import qualified Vector as V
11+
import Input
1712
import qualified Measure as M
18-
import qualified Insertion as I
19-
import qualified QuickSort as Q
20-
import qualified DpsMergeSort4 as DMS
21-
import qualified DpsMergeSort4Par as DMSP
22-
import qualified PiecewiseFallbackSort as PFS
23-
import qualified PiecewiseFallbackSortPar as PFSP
13+
import Sort
14+
import Utils
2415
import qualified Microbench as MB
25-
import qualified Array as A
26-
import qualified Data.Vector.Unboxed as V
27-
import qualified Data.Vector.Algorithms.Insertion as ISDVS
28-
import qualified Data.Vector.Algorithms.Merge as MSDVS
29-
import qualified Data.Vector.Algorithms.Intro as QSDVS
30-
31-
--------------------------------------------------------------------------------
32-
33-
getInput :: Benchmark -> Maybe Int -> IO (Input Int64)
34-
getInput bench mb_size = case bench of
35-
GenerateArray -> pure $ IntIn (mb 10000000)
36-
FillArray -> pure $ EltsIn (mb 10000000) 1024
37-
CopyArray -> pure $ ArrayIn (A.make (mb 10000000) 1)
38-
SumArray -> pure $ ArrayIn (A.make (mb 10000000) 1)
39-
Fib -> pure $ IntIn (mb 45)
40-
OurSort alg -> case alg of
41-
Insertionsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 100)
42-
Quicksort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 1000000)
43-
Mergesort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000)
44-
Optsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000)
45-
_ -> error "getInput: Unexpected Input!"
46-
where
47-
mb x = case mb_size of
48-
Nothing -> x
49-
Just y -> y
50-
51-
getInputAsDataVector :: SortAlgo -> Maybe Int -> IO Vec
52-
getInputAsDataVector bench mb_size = case bench of
53-
Insertionsort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 100)
54-
Quicksort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 1000000)
55-
Mergesort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 8000000)
56-
_ -> error "getInputAsDataVector: TODO sort function not implemented!"
57-
where
58-
mb x = case mb_size of
59-
Nothing -> x
60-
Just y -> y
61-
62-
getInputAsList :: SortAlgo -> Maybe Int -> IO [Int64]
63-
getInputAsList bench mb_size = case bench of
64-
Insertionsort -> randList (Proxy :: Proxy Int64) (mb 100)
65-
Quicksort -> randList (Proxy :: Proxy Int64) (mb 1000000)
66-
Mergesort -> randList (Proxy :: Proxy Int64) (mb 8000000)
67-
_ -> error "getInputAsDataVector: TODO sort function not implemented!"
68-
where
69-
mb x = case mb_size of
70-
Nothing -> x
71-
Just y -> y
72-
73-
copyInput :: (Input Int64) -> IO (Input Int64)
74-
copyInput i = case i of
75-
ArrayIn arr -> pure $ ArrayIn (A.copy arr 0 (A.make (A.size arr) (A.get arr 0)) 0 (A.size arr))
76-
_ -> error "TODO: copyInput not implemented!"
77-
78-
copyInputIterTimes :: Input Int64 -> Int -> IO [A.Array Int64]
79-
copyInputIterTimes inp iters = do
80-
copiedInputs <- replicateM iters (copyInput inp)
81-
return [arr | ArrayIn arr <- copiedInputs]
8216

83-
randArray :: forall a. (Random a, NFData a, P.Prim a) => Proxy a -> Int -> IO (A.Array a)
84-
randArray _ty size = do
85-
rng <- newStdGen
86-
let ls :: [a]
87-
ls = take size $ randoms rng
88-
!arr = force (A.fromList ls)
89-
pure arr
90-
91-
randList :: forall a. (Random a, NFData a) => Proxy a -> Int -> IO [a]
92-
randList _ty size = do
93-
rng <- newStdGen
94-
let ls :: [a]
95-
ls = take size $ randoms rng
96-
pure (force ls)
97-
98-
sortFn :: (Show a, A.HasPrimOrd a, NFData a) => SortAlgo -> ParOrSeq -> (A.Array a -. A.Array a)
99-
sortFn bench parorseq = case (bench,parorseq) of
100-
(Insertionsort, Seq) -> I.isort_top'
101-
(Quicksort, Seq) -> Q.quickSort'
102-
(Mergesort, Seq) -> DMS.msort
103-
(Mergesort, Par) -> DMSP.msort
104-
(Optsort, Seq) -> PFS.pfsort
105-
(Optsort, Par) -> PFSP.pfsort
106-
oth -> error $ "sortFn: unknown configuration: " ++ show oth
107-
108-
vectorSortFn :: SortAlgo -> ParOrSeq -> VecSort
109-
vectorSortFn bench parorseq = case (bench,parorseq) of
110-
(Insertionsort, Seq) -> ISDVS.sort
111-
(Mergesort, Seq) -> MSDVS.sort
112-
(Quicksort, Seq) -> QSDVS.sort
113-
oth -> error $ "sortFn: unknown configuration: " ++ show oth
114-
115-
--------------------------------------------------------------------------------
116-
117-
isSorted :: Ord a => [a] -> Bool
118-
isSorted [] = True
119-
isSorted [_] = True
120-
isSorted (x:y:xs) = x <= y && isSorted (y:xs)
121-
122-
readBench :: String -> Benchmark
123-
readBench s = case readMaybe s of
124-
Just b -> b
125-
Nothing -> case readMaybe s of
126-
Just srt -> OurSort srt
127-
Nothing -> read s
12817

12918
-- dobench :: Benchmark -> ParOrSeq -> Maybe Int -> IO ()
13019
dobench :: Benchmark -> ParOrSeq -> Maybe Int -> Int -> IO ()
@@ -204,11 +93,10 @@ dobench bench parorseq mb_size iters = do
20493
putStrLn "Sorted: OK"
20594
pure (V.length inPutVec, V.length res0, tmed0, tall0)
20695
OurSort alg -> do
207-
ArrayIn arr <- getInput bench mb_size
208-
arrs <- copyInputIterTimes (ArrayIn arr) iters
96+
(ArrayIn arr) <- getInput bench mb_size
20997
let fn = sortFn alg parorseq
21098
putStrLn $ "array size = " ++ show (A.size arr)
211-
(res0, tmed0, tall0) <- M.benchOnArrays fn arrs
99+
(res0, tmed0, tall0) <- M.benchOnArrays fn arr iters
212100
unless (isSorted (A.toList res0)) (error $ show bench ++ ": result not sorted.")
213101
putStrLn "Sorted: OK"
214102
pure (A.size arr, A.size res0, tmed0, tall0)

‎benchrunner/Input.hs‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
-- | Benchmarks and inputs
2+
3+
module Input where
4+
5+
import Sort
6+
import Utils
7+
8+
import qualified Array as A
9+
import qualified Vector as V
10+
11+
import Data.Proxy (Proxy (..))
12+
import Data.Int (Int64)
13+
import Text.Read
14+
15+
data Benchmark
16+
= GenerateArray
17+
| FillArray
18+
| CopyArray
19+
| SumArray
20+
| Fib
21+
| OurSort SortAlgo
22+
| VectorSort SortAlgo
23+
| CSort SortAlgo
24+
| CxxSort SortAlgo
25+
deriving (Eq, Show, Read)
26+
27+
readBench :: String -> Benchmark
28+
readBench s = case readMaybe s of
29+
Just b -> b
30+
Nothing -> case readMaybe s of
31+
Just srt -> OurSort srt
32+
Nothing -> read s
33+
34+
data Input a
35+
= EltsIn
36+
Int {- number of elements -}
37+
a {- element -}
38+
| ArrayIn (A.Array a)
39+
| IntIn Int
40+
deriving Show
41+
42+
getInput :: Benchmark -> Maybe Int -> IO (Input Int64)
43+
getInput bench mb_size = case bench of
44+
GenerateArray -> pure $ IntIn (mb 10000000)
45+
FillArray -> pure $ EltsIn (mb 10000000) 1024
46+
CopyArray -> pure $ ArrayIn (A.make (mb 10000000) 1)
47+
SumArray -> pure $ ArrayIn (A.make (mb 10000000) 1)
48+
Fib -> pure $ IntIn (mb 45)
49+
OurSort alg -> case alg of
50+
Insertionsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 100)
51+
Quicksort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 1000000)
52+
Mergesort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000)
53+
Optsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000)
54+
_ -> error "getInput: Unexpected Input!"
55+
where
56+
mb x = case mb_size of
57+
Nothing -> x
58+
Just y -> y
59+
60+
getInputAsDataVector :: SortAlgo -> Maybe Int -> IO Vec
61+
getInputAsDataVector bench mb_size = case bench of
62+
Insertionsort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 100)
63+
Quicksort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 1000000)
64+
Mergesort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 8000000)
65+
_ -> error "getInputAsDataVector: TODO sort function not implemented!"
66+
where
67+
mb x = case mb_size of
68+
Nothing -> x
69+
Just y -> y
70+
71+
getInputAsList :: SortAlgo -> Maybe Int -> IO [Int64]
72+
getInputAsList bench mb_size = case bench of
73+
Insertionsort -> randList (Proxy :: Proxy Int64) (mb 100)
74+
Quicksort -> randList (Proxy :: Proxy Int64) (mb 1000000)
75+
Mergesort -> randList (Proxy :: Proxy Int64) (mb 8000000)
76+
_ -> error "getInputAsDataVector: TODO sort function not implemented!"
77+
where
78+
mb x = case mb_size of
79+
Nothing -> x
80+
Just y -> y

‎benchrunner/MVector.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
-- | Reexport of the right kind of mutable vectors
2+
3+
module MVector
4+
(
5+
module Data.Vector.Unboxed.Mutable
6+
)
7+
where
8+
9+
import Data.Vector.Unboxed.Mutable

‎benchrunner/Measure.hs‎

Lines changed: 35 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Measure (benchAndRunCSorts, benchAndRunCxxSorts, benchAndRunDataVecSorts, benchOnArrays, bench, benchPar, dotrialIO, benchIO, benchParIO) where
1+
module Measure where
22

33
import Control.Exception (evaluate)
44
import Control.Monad.Par hiding (runParIO)
@@ -8,20 +8,13 @@ import Data.Int
88
import System.Mem (performMajorGC)
99
import Data.Time.Clock (getCurrentTime, diffUTCTime)
1010

11-
import Foreign as F
1211
import qualified Array as A
13-
import Types as T (SortAlgo(..), Vec, VecSort)
14-
import qualified Data.List as L
15-
import qualified Data.Vector.Unboxed as V
16-
import qualified ForeignFunctionImports as FFI
17-
import qualified Data.Vector.Unboxed.Mutable as MV
18-
19-
--------------------------------------------------------------------------------
12+
import Foreign as F
13+
import Sort
14+
import Utils
15+
import qualified Vector as V
16+
import qualified MVector as MV
2017

21-
median :: [Double] -> Double
22-
median ls = (L.sort ls) !! (length ls `div` 2)
23-
24-
--------------------------------------------------------------------------------
2518

2619
benchPar :: (NFData a, NFData b) =>
2720
(a -> Par b) -> a -> Int -> IO (b, Double, Double)
@@ -57,7 +50,6 @@ benchIO f arg iters = do
5750
batchtime = sum times
5851
return $! (last results, selftimed, batchtime)
5952

60-
6153
{-# NOINLINE dotrialPar #-}
6254
dotrialPar :: (NFData a, NFData b) =>
6355
(a -> Par b) -> a -> IO (b, Double)
@@ -96,24 +88,6 @@ dotrialIO f arg = do
9688

9789
--------------------------------------------------------------------------------
9890

99-
bench :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> Int -> IO (b, Double, Double)
100-
bench f arg iters = do
101-
let !arg2 = force arg
102-
!tups <- mapM (\_ -> dotrial f arg2) [1..iters]
103-
let (results, times) = unzip tups
104-
let selftimed = median times
105-
batchtime = sum times
106-
return $! (last results, selftimed, batchtime)
107-
108-
benchOnArrays :: (NFData a, Show b, NFData b, Show a) => (A.Array a %p -> b) -> [A.Array a] -> IO (b, Double, Double)
109-
benchOnArrays f arrArgs = do
110-
let !arg2s = force arrArgs
111-
!tups <- mapM (\arg2' -> dotrial f (force arg2')) arg2s
112-
let (results, times) = unzip tups
113-
let selftimed = median times
114-
batchtime = sum times
115-
return $! (last results, selftimed, batchtime)
116-
11791
{-# NOINLINE dotrial #-}
11892
dotrial :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> IO (b, Double)
11993
dotrial f arg = do
@@ -125,13 +99,40 @@ dotrial f arg = do
12599
putStrLn ("iter time: " ++ show delt)
126100
return $! (a,delt)
127101

102+
103+
bench :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> Int -> IO (b, Double, Double)
104+
bench f arg iters = do
105+
let !arg2 = force arg
106+
!tups <- mapM (\_ -> dotrial f arg2) [1..iters]
107+
let (results, times) = unzip tups
108+
let selftimed = median times
109+
batchtime = sum times
110+
return $! (last results, selftimed, batchtime)
111+
112+
benchOnArrays ::
113+
(NFData a, Show b, NFData b, Show a, A.HasPrim a) =>
114+
(A.Array a %p -> b) -> A.Array a -> Int -> IO (b, Double, Double)
115+
benchOnArrays f arr iters = do
116+
let go (i, a)
117+
| i == 0 = pure Nothing
118+
| otherwise = do
119+
!b <- copyArrayInplaceIO arr a
120+
res <- dotrial f b
121+
pure $ Just (res, (i - 1, b))
122+
!tups <- unfoldrM go (iters, A.make (A.size arr) (A.get arr 0))
123+
124+
let (results, times) = unzip tups
125+
selftimed = median times
126+
batchtime = sum times
127+
pure (last results, selftimed, batchtime)
128+
128129
benchAndRunDataVecSorts :: VecSort -> Vec -> Int -> IO (Vec, Double, Double)
129-
benchAndRunDataVecSorts sortFn inVec iters = do
130+
benchAndRunDataVecSorts sortfn inVec iters = do
130131
!tups <- mapM (\_ -> do
131132
mvec <- V.thaw inVec
132133
mvecCopy <- MV.new (MV.length mvec)
133134
MV.copy mvecCopy mvec
134-
res <- dotrialLocal sortFn mvecCopy
135+
res <- dotrialLocal sortfn mvecCopy
135136
pure res
136137
) [1..iters]
137138
let (results, times) = unzip tups
@@ -150,20 +151,6 @@ benchAndRunDataVecSorts sortFn inVec iters = do
150151
arg' <- V.freeze arg
151152
return $! (arg', delt)
152153

153-
sortFnC :: SortAlgo -> FFI.SortFn
154-
sortFnC alg = case alg of
155-
Insertionsort -> FFI.c_insertionsort
156-
Mergesort -> FFI.c_mergesort
157-
Quicksort -> FFI.c_quicksort
158-
_ -> error "sortFnC: Csort not implemented!"
159-
160-
sortFnCxx :: SortAlgo -> FFI.SortFnCxx
161-
sortFnCxx alg = case alg of
162-
Insertionsort -> FFI.cxx_int_insertionsort
163-
Mergesort -> FFI.cxx_int_mergesort
164-
Quicksort -> FFI.cxx_int_quicksort
165-
_ -> error "sortFnCxx: Csort not implemented!"
166-
167154
-- return type : IO ([Int64], Double, Double)
168155
-- [Int64]: sorted output array from the last iteration that was run
169156
-- Double: median runtime from the iterations that were run (selftimed)

0 commit comments

Comments
 (0)