haskell - 使用QuickCheck的平均浮点错误

Mat*_*W-D 13 haskell qa mean quickcheck standard-deviation

我使用QuickCheck-2.5.1.1进行QA.我测试两个纯函数gold :: a -> Floatf :: a -> Float,其中a实例随心所欲.

gold是参考计算,f是我正在优化的变体.

到目前为止,我使用quickcheck的大多数测试都使用了类似的测试\a -> abs (gold a - f a) < 0.0001.

但是,我想收集统计数据并检查阈值,因为知道平均误差和标准偏差对指导我的设计很有用.

有没有办法使用QuickCheck来收集这样的统计数据?


具体例子

为了给出我正在寻找的那种东西的具体例子,假设我有以下两个函数来近似平方根:

-- Heron's method
heron :: Float -> Float
heron x = heron' 5 1
    where
      heron' n est
          | n > 0 = heron' (n-1) $ (est + (x/est)) / 2
          | otherwise = est

-- Fifth order Maclaurin series expansion
maclaurin :: Float -> Float
maclaurin x = 1 + (1/2) * (x - 1) - (1/8)*(x - 1)^2
                + (1/16)*(x - 1)^3 - (5/128)*(x - 1)^4
                + (7/256)*(x - 1)^5
Run Code Online (Sandbox Code Playgroud)

对此的测试可能是:

test = quickCheck
       $ forAll (choose (1,2))
       $ \x -> abs (heron x - maclaurin x) < 0.02
Run Code Online (Sandbox Code Playgroud)

因此,作为测试的副作用,我想知道的是统计数据abs (heron x - maclaurin x)(例如均值和标准差).

Mat*_*W-D 4

感谢 Chris Kuklewicz 和 Ingo 的评论,我想出了以下内容来收集我在示例中想要的统计数据:

resultToWeightList :: Result -> [(Double,Int)]
resultToWeightList r = [ (read s, n) | (s,n) <- labels r]

weightListMuSigma :: [(Double,Int)] -> (Double,Double)
weightListMuSigma wlst = (mu,sigma)  
  where 
    (weightSum,weightSqrSum,entryCount) = foldl addEntry (0,0,0) wlst
    addEntry (s,s2,c) (v,w) = (s + (v * w'), s2 + (v**2 * w'), c + w)
      where w' = fromIntegral w
    entryCount' = fromIntegral entryCount
    mu = weightSum / entryCount'
    var = weightSqrSum / entryCount' - mu**2
    sigma = sqrt var

quietCheckResult :: Testable prop => prop -> IO Result
quietCheckResult p = quickCheckWithResult args p
  where args = stdArgs { chatty = False }

test :: IO ()
test = do { r <- quietCheckResult $ forAll (choose (1,2)) test'
          ; let wlst = resultToWeightList r
          ; let (mu,sigma) = weightListMuSigma wlst 
          ; putStrLn $ "Average: " ++ show mu
          ; putStrLn $ "Standard Deviation: " ++ show sigma
          }
   where
     test' x = collect err (err < 0.1)
       where err = abs $ heron x - maclaurin x
Run Code Online (Sandbox Code Playgroud)