master -> v1.1

.darcs-boring

@@ -0,0 +1,5 @@
+^dist(/|$)
+^setup(/|$)
+^GNUmakefile$
+^Makefile.local$
+^.depend(.bak)?$

.gitignore

@@ -1 +1,12 @@
-cabal.project.local
+*~
+
+Thumbs.db
+.DS_Store
+
+GNUmakefile
+dist-install/
+ghc.mk
+
+dist
+.cabal-sandbox
+cabal.sandbox.config

.travis.yml

@@ -1,103 +1,5 @@
-# This Travis job script has been generated by a script via
-#
-#   make_travis_yml_2.hs 'random.cabal'
-#
-# For more information, see https://github.com/hvr/multi-ghc-travis
-#
-language: c
-sudo: false
-
-git:
-  submodules: false  # whether to recursively clone submodules
-
-cache:
-  directories:
-    - $HOME/.cabal/packages
-    - $HOME/.cabal/store
-
-before_cache:
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
-  # remove files that are regenerated by 'cabal update'
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
-
-matrix:
-  include:
-
-
-    - compiler: "ghc-7.10.3"
-      env:
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
-    - compiler: "ghc-8.0.1"
-      env:
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.1], sources: [hvr-ghc]}}
-    - compiler: "ghc-8.0.2"
-      env:
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
-    - compiler: "ghc-8.2.1"
-      env:
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
-    - compiler: "ghc-head"
-      env:
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}
-
-  allow_failures:
-    - compiler: "ghc-head"
-
-before_install:
- - HC=${CC}
- - unset CC
- - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
- - PKGNAME='random'
-
-install:
- - cabal --version
- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
- - BENCH=${BENCH---enable-benchmarks}
- - TEST=${TEST---enable-tests}
- - travis_retry cabal update -v
- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- - rm -fv cabal.project.local
- - "echo 'packages: .' > cabal.project"
- - rm -f cabal.project.freeze
- - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2
- - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2
-
-# Here starts the actual work to be performed for the package under test;
-# any command which exits with a non-zero exit code causes the build to fail.
-script:
- - if [ -f configure.ac ]; then autoreconf -i; fi
- - rm -rf dist/
- - cabal sdist # test that a source-distribution can be generated
- - cd dist/
- - SRCTAR=(${PKGNAME}-*.tar.gz)
- - SRC_BASENAME="${SRCTAR/%.tar.gz}"
- - tar -xvf "./$SRC_BASENAME.tar.gz"
- - cd "$SRC_BASENAME/"
-## from here on, CWD is inside the extracted source-tarball
- - rm -fv cabal.project.local
- - "echo 'packages: .' > cabal.project"
- # this builds all libraries and executables (without tests/benchmarks)
- - rm -f cabal.project.freeze
- - cabal new-build -w ${HC} --disable-tests --disable-benchmarks
- # this builds all libraries and executables (including tests/benchmarks)
- # - rm -rf ./dist-newstyle
- - cabal new-build -w ${HC} ${TEST} ${BENCH}
-
- # there's no 'cabal new-test' yet, so let's emulate for now
- - TESTS=( $(awk 'tolower($0) ~ /^test-suite / { print $2 }' *.cabal) )
- - if [ "$TEST" != "--enable-tests" ]; then TESTS=(); fi
- - shopt -s globstar;
-   RC=true; for T in ${TESTS[@]}; do echo "== $T ==";
-   if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK =";
-   else echo "= $T FAILED ="; RC=false; fi; done; $RC
-
-# EOF
+language: haskell
+ghc:
+  - 7.4
+  - 7.6
+  - 7.8

Benchmark/BinSearch.hs

@@ -0,0 +1,142 @@
+
+{- 
+ Binary search over benchmark input sizes.
+
+ There are many good ways to measure the time it takes to perform a
+ certain computation on a certain input.  However, frequently, it's
+ challenging to pick the right input size for all platforms and all
+ compilataion modes.
+
+ Sometimes for linear-complexity benchmarks it is better to measure
+ /throughput/, i.e. elements processed per second.  That is, fixing
+ the time of execution and measuring the amount of work done (rather
+ than the reverse).  This library provides a simple way to search for
+ an appropriate input size that results in the desired execution time.
+
+ An alternative approach is to kill the computation after a certain
+ amount of time and observe how much work it has completed.
+ -}
+module BinSearch 
+    (
+      binSearch
+    )
+where
+
+import Control.Monad
+import Data.Time.Clock -- Not in 6.10
+import Data.List
+import System.IO
+import Prelude hiding (min,max,log)
+
+
+
+-- | Binary search for the number of inputs to a computation that
+--   results in a specified amount of execution time in seconds.  For example:
+--
+-- > binSearch verbose N (min,max) kernel
+--
+--   ... will find the right input size that results in a time
+--   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
+
+
+
+     (n,t) <- loop 1
+     return (n, fromRational$ toRational t)
+
+showTime ::  NominalDiffTime -> String
+showTime t = show ((fromRational $ toRational t) :: Double)
+
+toDouble :: Real a => a -> Double
+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)
+{-
+test :: IO (Integer,Double)
+test = 
+  binSearch True 3 (1.0, 1.05)
+   (\n -> 
+    do v <- newIORef 0
+       forM_ [1..n] $ \i -> do
+         old <- readIORef v
+         writeIORef v (old+i))
+-}

Benchmark/Makefile

@@ -0,0 +1,24 @@
+
+
+#OPTS= -O2 -Wall -XCPP
+OPTS= -O2 -Wall -XCPP -Werror
+
+all: lib bench
+
+lib:
+	(cd .. && ghc $(OPTS) --make System/Random.hs)
+
+bench:
+	ghc $(OPTS) -i.. --make SimpleRNGBench.hs 
+
+# When benchmarking against other packages installed via cabal it is
+# necessary to IGNORE the System/Random.hs files in the current directory.
+# (Otherwise instances of RandomGen are confused.)
+bench2:
+	ghc $(OPTS) -DTEST_COMPETITORS --make SimpleRNGBench.hs 
+
+clean:
+	rm -f *.o *.hi SimpleRNGBench
+#	cabal clean
+#	(cd Benchmark/ && rm -f *.o *.hi SimpleRNGBench)
+#	(cd System/    && rm -f *.o *.hi SimpleRNGBench)