Skip to content

Commit

Permalink
Merge pull request #120 from idontgetoutmuch/cleanup
Browse files Browse the repository at this point in the history 
Cleanup
  • Loading branch information
@lehins
lehins authored May 6, 2020
2 parents 41863a2 + 85e6b5c commit a091bfc
Show file tree
Hide file tree
Showing 7 changed files with 269 additions and 315 deletions.
1 change: 0 additions & 1 deletion .ghci
View file

This file was deleted.

1 change: 1 addition & 0 deletions System/Random.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -312,6 +312,7 @@ randomIO = liftIO $ getStdRandom random
--
-- It produces a full 'Word32' of randomness per iteration.
--
-- >>> import Data.Bits
-- >>> :{
-- let stepGen :: PCGen -> (Word32, PCGen)
-- stepGen (PCGen state inc) = let
Expand Down
173 changes: 90 additions & 83 deletions bench-legacy/BinSearch.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@

{-
{-
Binary search over benchmark input sizes.
There are many good ways to measure the time it takes to perform a
Expand All @@ -16,7 +16,7 @@
An alternative approach is to kill the computation after a certain
amount of time and observe how much work it has completed.
-}
module BinSearch
module BinSearch
(
binSearch
)
Expand All @@ -39,81 +39,88 @@ import Prelude hiding (min,max,log)
-- between min and max, then it will then run for N trials and
-- return the median (input,time-in-seconds) pair.
binSearch :: Bool -> Integer -> (Double,Double) -> (Integer -> IO ()) -> IO (Integer, Double)
binSearch verbose trials (min,max) kernel =
do
when(verbose)$ putStrLn$ "[binsearch] Binary search for input size resulting in time in range "++ show (min,max)

let desired_exec_length = 1.0
good_trial t = (toRational t <= toRational max) && (toRational t >= toRational min)

-- At some point we must give up...
loop n | n > ((2::Integer) ^ (100::Integer)) = error "ERROR binSearch: This function doesn't seem to scale in proportion to its last argument."

-- Not allowed to have "0" size input, bump it back to one:
loop 0 = loop 1

loop n =
do
when(verbose)$ putStr$ "[binsearch:"++ show n ++ "] "
time <- timeit$ kernel n
when(verbose)$ putStrLn$ "Time consumed: "++ show time
let rate = fromIntegral n / time

-- [2010.06.09] Introducing a small fudge factor to help our guess get over the line:
let initial_fudge_factor = 1.10
fudge_factor = 1.01 -- Even in the steady state we fudge a little
guess = desired_exec_length * rate

-- TODO: We should keep more history here so that we don't re-explore input space we have already explored.
-- This is a balancing act because of randomness in execution time.

if good_trial time
then do
when(verbose)$ putStrLn$ "[binsearch] Time in range. LOCKING input size and performing remaining trials."
print_trial 1 n time
lockin (trials-1) n [time]

-- Here we're still in the doubling phase:
else if time < 0.100
then loop (2*n)

else do when(verbose)$
putStrLn$ "[binsearch] Estimated rate to be "
++show (round rate::Integer)++" per second. Trying to scale up..."

-- Here we've exited the doubling phase, but we're making our first guess as to how big a real execution should be:
if time > 0.100 && time < 0.33 * desired_exec_length
then do when(verbose)$ putStrLn$ "[binsearch] (Fudging first guess a little bit extra)"
loop (round$ guess * initial_fudge_factor)
else loop (round$ guess * fudge_factor)

-- Termination condition: Done with all trials.
lockin 0 n log = do when(verbose)$ putStrLn$ "[binsearch] Time-per-unit for all trials: "++
(concat $ intersperse " " (map (show . (/ toDouble n) . toDouble) $ sort log))
return (n, log !! ((length log) `quot` 2)) -- Take the median

lockin trials_left n log =
do when(verbose)$ putStrLn$ "[binsearch]------------------------------------------------------------"
time <- timeit$ kernel n
-- hFlush stdout
print_trial (trials - trials_left +1 ) n time
-- when(verbose)$ hFlush stdout
lockin (trials_left - 1) n (time : log)

print_trial :: Integer -> Integer -> NominalDiffTime -> IO ()
print_trial trialnum n time =
let rate = fromIntegral n / time
timeperunit = time / fromIntegral n
in
when(verbose)$ putStrLn$ "[binsearch] TRIAL: "++show trialnum ++
" secPerUnit: "++ showTime timeperunit ++
" ratePerSec: "++ show (rate) ++
" seconds: "++showTime time


binSearch verbose trials (min, max) kernel = do
when verbose $
putStrLn $
"[binsearch] Binary search for input size resulting in time in range " ++
show (min, max)
let desired_exec_length = 1.0
good_trial t =
(toRational t <= toRational max) && (toRational t >= toRational min)
-- At some point we must give up...
loop n
| n > ((2 :: Integer) ^ (100 :: Integer)) =
error
"ERROR binSearch: This function doesn't seem to scale in proportion to its last argument."
-- Not allowed to have "0" size input, bump it back to one:
loop 0 = loop 1
loop n = do
when verbose $ putStr $ "[binsearch:" ++ show n ++ "] "
time <- timeit $ kernel n
when verbose $ putStrLn $ "Time consumed: " ++ show time
let rate = fromIntegral n / time
-- [2010.06.09] Introducing a small fudge factor to help our guess get over the line:
let initial_fudge_factor = 1.10
fudge_factor = 1.01 -- Even in the steady state we fudge a little
guess = desired_exec_length * rate
-- TODO: We should keep more history here so that we don't re-explore input space we
-- have already explored. This is a balancing act because of randomness in
-- execution time.
if good_trial time
then do
when verbose $
putStrLn
"[binsearch] Time in range. LOCKING input size and performing remaining trials."
print_trial 1 n time
lockin (trials - 1) n [time]
else if time < 0.100
then loop (2 * n)
else do
when verbose $
putStrLn $
"[binsearch] Estimated rate to be " ++
show (round rate :: Integer) ++
" per second. Trying to scale up..."
-- Here we've exited the doubling phase, but we're making our
-- first guess as to how big a real execution should be:
if time > 0.100 && time < 0.33 * desired_exec_length
then do
when verbose $
putStrLn
"[binsearch] (Fudging first guess a little bit extra)"
loop (round $ guess * initial_fudge_factor)
else loop (round $ guess * fudge_factor)
-- Termination condition: Done with all trials.
lockin 0 n log = do
when verbose $
putStrLn $
"[binsearch] Time-per-unit for all trials: " ++
concat
(intersperse " " (map (show . (/ toDouble n) . toDouble) $ sort log))
return (n, log !! (length log `quot` 2)) -- Take the median
lockin trials_left n log = do
when verbose $
putStrLn
"[binsearch]------------------------------------------------------------"
time <- timeit $ kernel n
-- hFlush stdout
print_trial (trials - trials_left + 1) n time
-- whenverbose$ hFlush stdout
lockin (trials_left - 1) n (time : log)
print_trial :: Integer -> Integer -> NominalDiffTime -> IO ()
print_trial trialnum n time =
let rate = fromIntegral n / time
timeperunit = time / fromIntegral n
in when verbose $
putStrLn $
"[binsearch] TRIAL: " ++
show trialnum ++
" secPerUnit: " ++
showTime timeperunit ++
" ratePerSec: " ++ show rate ++ " seconds: " ++ showTime time
(n, t) <- loop 1
return (n, fromRational $ toRational t)

(n,t) <- loop 1
return (n, fromRational$ toRational t)

showTime :: NominalDiffTime -> String
showTime t = show ((fromRational $ toRational t) :: Double)
Expand All @@ -125,16 +132,16 @@ toDouble = fromRational . toRational
-- Could use cycle counters here.... but the point of this is to time
-- things on the order of a second.
timeit :: IO () -> IO NominalDiffTime
timeit io =
do strt <- getCurrentTime
io
end <- getCurrentTime
return (diffUTCTime end strt)
timeit io = do
strt <- getCurrentTime
io
end <- getCurrentTime
return (diffUTCTime end strt)
{-
test :: IO (Integer,Double)
test =
test =
binSearch True 3 (1.0, 1.05)
(\n ->
(\n ->
do v <- newIORef 0
forM_ [1..n] $ \i -> do
old <- readIORef v
Expand Down
Loading

0 comments on commit a091bfc

Please sign in to comment.