So I've been trying to get my QuickCheck tests to run in parallel. I did take a look at Don's Parallel QuickCheck library <http://www.cse.unsw.edu.au/~dons/pqc.html>, but I didn't like how much code it had in it and I figured it'd be a good exercise to try to do myself.
After quite a lot of help from the good folk of #haskell, I eventually came up
with this:
module Pcheck (parTest, parCheck) where
import Control.Monad (replicateM_, liftM)
import Control.Concurrent.Chan (newChan, writeChan, getChanContents)
import Control.Concurrent (forkIO)
import Test.QuickCheck (quickCheck', Testable())
-- | Takes a list of functions using parCheck, and returns True iff all return
-- True. Evaluates them in parallel.
parTest :: [IO Bool] -> IO Bool
parTest = andTest . parList
where andTest :: IO [Bool] -> IO Bool
andTest = liftM and
{- | Test in parallel. Forks off a QuickCheck 'n' times; QuickCheck tests
using
the proposition 't'. Returns True if all tests were passed, else
False. Should be run with parallelizing options like with +RTS -N4 -RTS
&etc. -}
parCheck :: (Testable prop) => prop -> Int -> IO Bool
parCheck t n = do chan <- newChan
replicateM_ n $ forkIO $ (writeChan chan) =<< (quickCheck'
t)
liftM (and . take n) $ getChanContents chan
-- | Takes a list of functions (presumably using parCheck) and evaluates all
in parallel.
parList :: [IO a] -> IO [a]
parList fs = do chan <- newChan
mapM_ (\m -> forkIO $ m >>= writeChan chan) fs
liftM (take n) $ getChanContents chan
where n = length fs
I liked how simple the Channels library
<http://haskell.org/ghc/docs/latest/html/libraries/base-3.0.0.0/Control-Concurrent-Chan.html>
seemed to be; I could just pass the channel as an argument and have every
forkIO'd test simply chuck its Boolean result into it when done - which seem'd
much simpler than using MVars and the other techniques for returning stuff from
forkIO threads.
And so it compiles, it runs tests correctly, and so on. But the problem is that
it does so slowly. I have another module of equations about nuclear bombs
called nuke.hs, which has a number of QuickCheck properties defined. Here's
what happens when main is defined as 'parTest [the various tests..]':
./nuke +RTS -N7 -sstderr -RTS 40.57s user 46.55s system 116% cpu 1:14.61 total
./nuke +RTS -N6 -sstderr -RTS 40.72s user 47.66s system 117% cpu 1:15.50 total
./nuke +RTS -N5 -sstderr -RTS 42.33s user 49.08s system 116% cpu 1:18.67 total
./nuke +RTS -N4 -sstderr -RTS 43.71s user 48.41s system 117% cpu 1:18.48 total
./nuke +RTS -N3 -sstderr -RTS 41.51s user 48.25s system 114% cpu 1:18.10 total
./nuke +RTS -N2 -sstderr -RTS 42.28s user 47.18s system 115% cpu 1:17.39 total
./nuke +RTS -N1 -sstderr -RTS 27.87s user 18.40s system 99% cpu 46.498 total
(From <http://hpaste.org/3886#a6>; compiled as "=ghc -v --make -threaded -O2
./nuke.hs".)
For some reason, running the parallel tests with a single thread is faster than
running with 4 threads (I have a quad-core Intel processor)? I find this
counter-intuitive to say the least. the par* functions are indeed operating in
parallel, as evidenced by it using more than 100% CPU time, or, running on
multiple cores, and all the tests are passed as True in both -N1 and -N[2-7]
versions, so -N1 can't be bailing out early due to "and"'s laziness, and in
general everything seems to be written correctly.
I am perplexed by this. Is Chan simply a very inefficient way of parallelizing
things? Is it not as parallel as I think? Or am I missing something else
entirely?
(Attached is the source of nuke.hs and pcheck.hs, as well as some data from
-sstderr.)
--
gwern
.45 GIGN jya. wire ISI SADCC JPL embassy Recon World
-- module Nuke (main)
-- where
-- TODO: work in radiation deaths.
import Pcheck
import Test.QuickCheck
import Monad (liftM3)
{- For many equations and results, it is nonsensical to have negative results, but we don't want
to use solely natural numbers because then we lose precision. So we define a PosReal type which tries
to define the subset of real numbers which are 0 or positive; this way the type system checks for negative
results instead of every other function having conditionals checking for negative input or output. -}
newtype PosReal = MakePosReal Float deriving (Show, Eq, Ord)
-- Basic numerical operations on positive reals
instance Num PosReal where
fromInteger = toPosReal . fromInteger
x + y = MakePosReal (fromPosReal x + fromPosReal y)
x - y = toPosReal ((fromPosReal x) - (fromPosReal y))
x * y = MakePosReal (fromPosReal x * fromPosReal y)
abs x | x >= 0 = x
| otherwise = x * (-1)
signum x | x >= 0 = 1
| otherwise = (-1)
-- Define division on PosReals
instance Fractional PosReal where
x / y = toPosReal ((fromPosReal x) / (fromPosReal y))
fromRational x = MakePosReal (fromRational x)
-- Positive reals are truncated at 0
toPosReal :: Float -> PosReal
toPosReal x
| x < 0 = MakePosReal 0
| otherwise = MakePosReal x
fromPosReal :: PosReal -> Float
fromPosReal (MakePosReal i) = i
-- Define an instance to allow QuickCheck operations
instance Arbitrary PosReal where
arbitrary = liftM3 fraction arbitrary arbitrary arbitrary
where fraction :: Integer -> Integer -> Integer -> PosReal
fraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1))
-- coarbitrary x = coarbitrary (x, x)
type KiloPascal = PosReal
type PSI = PosReal
type Meters = PosReal
type W = PosReal -- Note w is always in kilotons.
type Joule = PosReal
type Time = PosReal
-- Characterizes the output of a nuclear weapon
data Output = Output {
heat :: PosReal,
blast :: PosReal,
nuclear_radiation :: PosReal } deriving (Show, Eq)
main :: IO ()
main = do bool <- parTest [kpaTest, psiTest, energyTest, thermalMaxTest, timeMaxTest]
if bool then print "Success" else print "Failure"
-- Units
kpaTest :: IO Bool
kpaTest = parCheck (\s -> kpa s >= 0) 1000
kpa :: KiloPascal -> PSI
kpa a
| (a > 0) = 0.145 * a
| otherwise = 0
psiTest :: IO Bool
psiTest = parCheck (\s -> psi s >= s) 100
psi :: PSI -> KiloPascal
psi = (6.895 *)
meter :: PosReal -> PosReal
meter = (3.281 *)
foot :: PosReal -> PosReal
foot = (0.3048 *)
-- Find ideal height for an air burst.
height :: W -> Float
--height w = 60 * (1 / (w * w * w)) -- w^3
height w = 60 * ((fromPosReal w)**(1/3))
{- Calculate total energy of a given kilotonnage. Answer in joules.
This works because critical mass gives a lower kilotonnage bound for fission bombs. -}
energyTest :: IO Bool
energyTest = parCheck (\s -> energy s == 0 || energy s >= 2.0929999e12) 100
energy :: W -> Joule
energy s
| s >= 0.5 = 4.186 * joule * s
| otherwise = 0
where joule = 1000000000000 :: PosReal -- 10^12
regularNuke :: W -> Output
regularNuke w = Output { heat=(0.35 * energy w), -- 35% heat
blast=(0.50 * energy w), -- 50% kinetic energy
nuclear_radiation=(0.15 * energy w) -- 15% non-thermal radiation
}
{- A radiation weapon trades off a decreased thermal and blast energy against a considerably
increased radiation yield. It is defined in terms of regularNuke because it just modifies it. -}
radiationNuke :: W -> Output
radiationNuke w = Output {
-- regularNuke w
heat=(0.35 * energy (0.50 * w)),
blast=(0.50 * energy (0.50 * w)),
nuclear_radiation=(0.15 * energy (10.0 * w)) } -- 10x non-thermal radiation!
{- Answer in joules /m^2. r = distance from impact/radius; t = correction factor (1.5^2 for snow & high
clouds, 1.5 for singly either). This is how many joules of heat per square inch at a given distance for
given kilotonnage (weather included). -}
totalPointImpact :: W -> Meters -> PosReal -> PosReal -> Joule
totalPointImpact w r clouds snow
| r /= 0 = (0.35 * (weatherMultiplier snow clouds) * (energy w)) / (4.0 * reducedPrecisionPi * r)
| otherwise = energy w -- If 0, then at ground zero and no diminution b/c of distance
where
weatherMultiplier :: PosReal -> PosReal -> PosReal
weatherMultiplier a b
| a*b > 0 = (a * b)
| a + b > 0 = (a `max` b)
| otherwise = 1
reducedPrecisionPi = 3.141592653589793 :: PosReal
-- Results in kPA
peakOverPressureUnderWater :: W -> Meters -> Joule
peakOverPressureUnderWater w r = 1.07e7 * (1 / (w / 0.37)) * (1 / (r / (-1.18))) -- = 1.07e7 * w^(0.37) * r^(-1.18)
-- thermal deaths - pmax = kJ/m^2
--thermalMax = 270 -- incapacitation
thermalMaxTest :: IO Bool
thermalMaxTest = parCheck (\s -> (thermalMax s s s s) >= 0) 100
thermalMax :: Meters -> Joule -> Joule -> Joule -> Joule
thermalMax w r clouds snow = (0.38 * (totalPointImpact w r clouds snow)) / timeMax w
timeMaxTest :: IO Bool
timeMaxTest = parCheck (\s -> timeMax s >= 0) 100
timeMax :: W -> Time
timeMax w = 0.0417 * (1 / (w / 0.44))
-- TODO: add a test
pressureKilledPerson :: Meters -> Joule -> Joule -> Joule -> Bool
pressureKilledPerson w r clouds snow
| thermalMax w r clouds snow >= 270 = True
| otherwise = False
--radiationDeaths = dose-rate * exposure-time
-- radiationKilled = undefined
-- centigray is 1/10 a gray
--gray joule kg = joule / kg
--450 centigray = 50% fatalities
-- We'll assume the following scales linearly
-- at 10 r, 3billion / 1million major defects 1stgen (1/3000th), /10million (1/300th) cumulative total
-- 3billion / 10million (1/300th) early mortalities 1stgen, /200million (1/15th) cumulative total
{- weapon vital statistics
--
icbms
--
minuteman II
# 450
11 300
1 W56
minuteman III
# 200
13 000
3 W62
minuteman III (MK12A)
# 300
13 000
3 W78
mx
50
11 000
10 W87
--
slbm
--
poseidon
224
4 600
10 w68
trident I
384
7 400
8 w76
--
bombers
--
B-1B
97
9 800
22
FB-111A
59
4 700
6
B-52G/H
193
16 000
b052h/g model: 20 SRAM or
b-52h: 20 ALCM
b-52g: 12 ALCM and 6 bombs
f-4 C/D/E
2 250
1060-2400
3
F-15 A/C
5 W25 or genies
F-16 A/B/C/D
5 B43 or B57
F-111 A/D/E/F
3 b43|b57|b61|b83
--
Missiles
--
pershing II
111
1 790
1 W85
GLCM
250
2 500
1 W84
Pershing IA
72
740
1 W50
lance
100
125
1 W70
nike hercules
27
160
1 W31
tomahawk
200
2 500
1 W80-0
--
bombs
--
W31
75
1-20kt
W56
450
1.2MT
W50
100
60-400
W62
600
170kt
W70
1 282
1-100kt
W78
900
335kt
W87
500
300kt
W68
2 240
40kt
w76
3 072
100kt
w80-0
200
5-150kt
w85
125
.3-80
w84
325
.2-150kt
b28
b28RE
b43
b57
b61
b83 "genie"
"b-52G/H 20 SRAM"
B-52G
B-52H
-}
{-
A list of possible scenarios.
US first strike
USSR first strike
NATO / Warsaw Pact
Far East strategy
US USSR escalation
Middle East war
USSR - China attack
India Pakistan war
Mediterranean war
Hong Kong variant
SEATO decapitating
Cuban provocation
Inadvertent
Atlantic heavy
Cuban paramilitary
Nicaraguan preemptive
Pacific territorial
Burmese theatre-wide
Turkish decoy
NATO first strike
Argentina escalation
Iceland maximum
Arabian theatre-wide
U.S. subversion
Australian maneuver
Iranian diversion
...? limited
Sudan surprise
NATO territorial
Zaire alliance
Iceland incident
English escalation
Zaire sudden
Egypt paramilitary
Middle East heavy
Mexican takeover
Chad alert
Saudi maneuver
African territorial
Ethiopian escalation
Canadian ...?
Turkish heavy
NATO incursion
U.S. defense
Cambodian heavy
Pact medium
Arctic minimal
Mexican domestic
Taiwan theatre-wide
Pacific maneuver
Portugal revolution
Albanian decoy
Palestinian local
Moroccan minimal
Hungarian diversion
Czech option
French alliance
Arabian clandestine
Gabon rebellion
Northern maximum
Syrian surprise
...?sh paramilitary
SEATO takeover
Hawaiian escalation
Iranian maneuver
NATO containment
Swiss incident
Cuban minimal
Chad alert
Iceland escalation
Vietnamese retaliation
Syrian provocation
Libyan local
Gabon takeover
Romanian war
Middle East offensive
Denmark massive
Chile confrontation
S.African subversion
USSR alert
Nicaraguan thrust
Greenland domestic
Iceland heavy
Kenya option
Pacific defense
Uganda maximum
Thai subversion
Romanian strike
Pakistan sovereignty
Afghan misdirection
Thai variation
Northern territorial
Polish paramilitary
S.African offensive
Panama misdirection
Scandinavian domestic
Jordan preemptive
English thrust
Burmese maneuver
Spain counter
Arabian offensive
Chad interdiction
Taiwan misdirection
Bangladesh theatre-wide
Ethiopian local
Italian takeover
Vietnamese incident
English preemptive
Denmark alternate
Thai confrontation
Taiwan surprise
Brazilian strike
Venezuela sudden
Malaysian alert
Israel discretionary
Libyan action
Palestinian tactical
NATO alternate
Cyprus maneuver
Egypt misdirection
Bangladesh thrust
Kenya defense
Bangladesh containment
Vietnamese strike
Albanian containment
Gabon surprise
Iraq sovereignty
Vietnamese sudden
Lebanon interdiction
Taiwan domestic
Algerian sovereignty
Arabian strike
Atlantic sudden
Mongolian thrust
Polish decoy
Alaskan discretionary
Canadian thrust
Arabian light
S.African domestic
Tunisian incident
Malaysian maneuver
Jamaica decoy
Malaysian minimal
Russian sovereignty
Chad option
Bangladesh war
Burmese containment
Asian theatre-wide
Bulgarian clandestine
Greenland incursion
Egypt surgical
Czech heavy
Taiwan confrontation
Greenland maximum
Uganda offensive
Caspian defense
-}
module Pcheck (parTest, parCheck) where
import Control.Monad (replicateM_, liftM)
import Control.Concurrent.Chan (newChan, writeChan, getChanContents)
import Control.Concurrent (forkIO)
import Test.QuickCheck (quickCheck', Testable())
-- | Takes a list of functions using parCheck, and returns True iff all return
-- True. Evaluates them in parallel.
parTest :: [IO Bool] -> IO Bool
parTest = andTest . parList
where andTest :: IO [Bool] -> IO Bool
andTest = liftM and
{- | Test in parallel. Forks off a QuickCheck 'n' times; QuickCheck tests using
the proposition 't'. Returns True if all tests were passed, else
False. Should be run with parallelizing options like with +RTS -N4 -RTS &etc. -}
parCheck :: (Testable prop) => prop -> Int -> IO Bool
parCheck t n = do chan <- newChan
replicateM_ n $ forkIO $ (writeChan chan) =<< (quickCheck' t)
liftM (and . take n) $ getChanContents chan
-- | Takes a list of functions (presumably using parCheck) and evaluates all in parallel.
parList :: [IO a] -> IO [a]
parList fs = do chan <- newChan
mapM_ (\m -> forkIO $ m >>= writeChan chan) fs
liftM (take n) $ getChanContents chan
where n = length fs
4,536,511,400 bytes allocated in the heap 2,318,559,160 bytes copied during GC (scavenged) 69,225,392 bytes copied during GC (not scavenged) 8,597,504 bytes maximum residency (213 sample(s)) 8436 collections in generation 0 ( 9.07s) 213 collections in generation 1 ( 1.98s) 19 Mb total memory in use Task 0 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 1 (worker) : MUT time: 2.78s ( 35.21s elapsed) GC time: 0.03s ( 0.05s elapsed) Task 2 (worker) : MUT time: 31.59s ( 35.21s elapsed) GC time: 11.02s ( 11.52s elapsed) Task 3 (worker) : MUT time: 0.00s ( 35.21s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 4 (worker) : MUT time: 0.12s ( 35.21s elapsed) GC time: 0.00s ( 0.00s elapsed) INIT time 0.00s ( 0.00s elapsed) MUT time 14.91s ( 35.21s elapsed) GC time 11.05s ( 11.57s elapsed) EXIT time 0.00s ( 0.00s elapsed) Total time 25.96s ( 46.79s elapsed) %GC time 42.6% (24.7% elapsed) Alloc rate 304,259,651 bytes per MUT second Productivity 57.4% of total user, 31.9% of total elapsed ./nuke +RTS -N1 -sstderr -RTS 25.96s user 19.73s system 97% cpu 46.790 total
4,537,111,528 bytes allocated in the heap 966,337,104 bytes copied during GC (scavenged) 9,500,416 bytes copied during GC (not scavenged) 7,516,160 bytes maximum residency (53 sample(s)) 4286 collections in generation 0 ( 6.88s) 53 collections in generation 1 ( 0.55s) 19 Mb total memory in use Task 0 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 1 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 2 (worker) : MUT time: 0.07s ( 70.90s elapsed) GC time: 0.00s ( 0.01s elapsed) Task 3 (worker) : MUT time: 0.05s ( 70.91s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 4 (worker) : MUT time: 40.76s ( 70.91s elapsed) GC time: 3.94s ( 3.89s elapsed) Task 5 (worker) : MUT time: 41.12s ( 70.91s elapsed) GC time: 3.49s ( 3.40s elapsed) Task 6 (worker) : MUT time: 0.07s ( 70.91s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 7 (worker) : MUT time: 0.00s ( 70.91s elapsed) GC time: 0.00s ( 0.00s elapsed) INIT time 0.00s ( 0.00s elapsed) MUT time 35.82s ( 70.91s elapsed) GC time 7.43s ( 7.30s elapsed) EXIT time 0.00s ( 0.00s elapsed) Total time 43.25s ( 78.21s elapsed) %GC time 17.2% (9.3% elapsed) Alloc rate 126,664,196 bytes per MUT second Productivity 82.8% of total user, 45.8% of total elapsed ./nuke +RTS -N2 -sstderr -RTS 43.25s user 47.14s system 115% cpu 1:18.22 total
4,536,868,632 bytes allocated in the heap 723,357,976 bytes copied during GC (scavenged) 8,012,832 bytes copied during GC (not scavenged) 7,335,936 bytes maximum residency (44 sample(s)) 2774 collections in generation 0 ( 5.32s) 44 collections in generation 1 ( 0.49s) 20 Mb total memory in use Task 0 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 1 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 2 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 3 (worker) : MUT time: 0.00s ( 0.00s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 4 (worker) : MUT time: 0.07s ( 73.31s elapsed) GC time: 0.01s ( 0.00s elapsed) Task 5 (worker) : MUT time: 0.01s ( 73.31s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 6 (worker) : MUT time: 0.07s ( 73.31s elapsed) GC time: 0.01s ( 0.01s elapsed) Task 7 (worker) : MUT time: 0.11s ( 73.31s elapsed) GC time: 0.02s ( 0.01s elapsed) Task 8 (worker) : MUT time: 28.12s ( 73.31s elapsed) GC time: 4.80s ( 4.61s elapsed) Task 9 (worker) : MUT time: 11.31s ( 73.31s elapsed) GC time: 0.01s ( 0.00s elapsed) Task 10 (worker) : MUT time: 0.05s ( 73.31s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 11 (worker) : MUT time: 0.00s ( 73.31s elapsed) GC time: 0.00s ( 0.00s elapsed) Task 12 (worker) : MUT time: 20.37s ( 73.31s elapsed) GC time: 0.05s ( 0.04s elapsed) Task 13 (worker) : MUT time: 27.27s ( 73.31s elapsed) GC time: 0.91s ( 0.98s elapsed) INIT time 0.00s ( 0.00s elapsed) MUT time 37.41s ( 73.31s elapsed) GC time 5.81s ( 5.66s elapsed) EXIT time 0.00s ( 0.00s elapsed) Total time 43.22s ( 78.98s elapsed) %GC time 13.4% (7.2% elapsed)
pgpcrqGbeNGuM.pgp
Description: PGP signature
_______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
