ideas-statistics-1.0: src/Domain/Hypothesis/BuggyRules.hs
-----------------------------------------------------------------------------
-- Copyright 2020, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
module Domain.Hypothesis.BuggyRules
( buggyRules
, buggyTValueSided, buggyRValueSided, buggyZValueSided
, buggyTValueTestValue, buggyRValueTestValue, buggyZValueTestValue
, buggyChiValueSided, buggyChiValueTestValue
) where
import Control.Monad
import Data.List
import Domain.Hypothesis.Common
import Domain.Math.Data.Relation
import Domain.Math.Expr hiding ((.*.), (./.))
import Domain.Math.Numeric.Views
import Domain.Hypothesis.Rules
import Domain.Statistics.ComponentSet
import Domain.Statistics.Views
import Ideas.Common.Library
----------------------------------------------------------
-- Buggy rules
-- Transform the steps described below into a rule, the pattern is factored out.
-- The list can be freely appended with new buggy rules
buggyRules:: [Rule ComponentSet]
buggyRules =
let _pat (f, name, descr) = (describe descr . buggyRule name) f
_name_common x = "buggy.component." ++ x
in map _pat
[ ( wrongHARule
, _name_common "ha"
, "Choosing wrong alternative hypothesis"
)
, ( wrongAlphaRule
, _name_common "alpha"
, "Buggy rule for adding the wrong alpha"
)
, ( wrongDf
, _name_common "df"
, "Buggy rule for adding the wrong degrees of freedom"
)
] ++ [buggyHypothesesSampleMean, buggyHASampleMean, buggyH0SampleMean]
++ buggyRulesTest
++ [ buggyTestZValueRule, buggyTestTValueRule
, buggyTValuePositive
, buggyZValueAlpha, buggyZValueSided, buggyZValueTestValue
, buggyTValueAlpha, buggyTValueSided, buggyTValueDf, buggyTValueTestValue
, buggyRValueAlpha, buggyRValueSided, buggyRValueDf, buggyRValueTestValue
, buggyFValueAlpha, buggyFValueDf, buggyFValueTestValue
, buggyChiValueAlpha, buggyChiValueSided, buggyChiValueDf, buggyChiValueTestValue
, buggyTestValueCritical
]
alphaValues :: [Double]
alphaValues = [0.01, 0.05, 0.10]
alphaChiValues :: [Double]
alphaChiValues = [0.10, 0.05, 0.025, 0.01, 0.005]
sidedValues :: [Sided]
sidedValues = [TwoSided, LeftSided, RightSided]
incorrectDf :: Double -> [Double]
incorrectDf correctDf = [correctDf - 1, correctDf + 1, correctDf + 2]
confusingTestValue :: ComponentSet -> [Double]
confusingTestValue cs = do
r <- inferTestValue cs
matchM doubleView (rightHandSide r)
buggyTestValueCritical :: Rule ComponentSet
buggyTestValueCritical =
describe "Buggy rule for confusing the test value with critical value" $
buggyRule "buggy.component.test-value.critical" f
where
f :: ComponentSet -> Maybe ComponentSet
f cs = do
guard (derived cs `doesNotContain` TestValue)
test <- inferTestChoice cs
var <- inferVar cs
alpha <- getExpr SignificanceLevel cs >>= match doubleView
crit <-
case test of
Anova -> do
(dfBetween, dfWithin) <- inferDfBetweenWithin cs
computeCriticalF dfBetween dfWithin alpha
ZTest -> do
sided <- inferSidedness cs
return $ computeCriticalZ sided alpha
RPearson -> do
sided <- inferSidedness cs
df <- inferDf cs >>= match doubleView
return $ computeCriticalR sided alpha df
_ | isTTest test -> do
sided <- inferSidedness cs
df <- inferDf cs >>= match doubleView
return $ computeCriticalT sided alpha df
_ -> Nothing
return $ append TestValue (CRelation $ var .==. toExpr crit) cs
------------------------------------------------------
buggyZValueAlpha :: Rule ComponentSet
buggyZValueAlpha =
describe "Buggy rule for looking up a z-value with wrong alpha" .
buggyRule "buggy.component.critical.z-value.alpha" $
inferCriticalZWith $ \sided alpha ->
[ computeCriticalZ sided a | a <- alphaValues, a /= alpha ]
buggyZValueSided :: Rule ComponentSet
buggyZValueSided =
describe "Buggy rule for looking up a z-value with wrong sidedness" .
buggyRule "buggy.component.critical.z-value.sided" $
inferCriticalZWith $ \sided alpha ->
[ computeCriticalZ s alpha | s <- sidedValues, s /= sided ]
buggyZValueTestValue :: Rule ComponentSet
buggyZValueTestValue =
describe "Buggy rule for confusing z-value with test-value" .
buggyRule "buggy.component.critical.z-value.test-value" $ \cs ->
inferCriticalZWith (\_ _ -> confusingTestValue cs) cs
------------------------------------------------------
buggyTValueAlpha :: Rule ComponentSet
buggyTValueAlpha =
describe "Buggy rule for looking up a t-value with wrong alpha" .
buggyRule "buggy.component.critical.t-value.alpha" $
inferCriticalTWith $ \sided alpha df ->
[ computeCriticalT sided a df | a <- alphaValues, a /= alpha ]
buggyTValueSided :: Rule ComponentSet
buggyTValueSided =
describe "Buggy rule for looking up a t-value with wrong sidedness" .
buggyRule "buggy.component.critical.t-value.sided" $
inferCriticalTWith $ \sided alpha df ->
[ computeCriticalT s alpha df | s <- sidedValues, s /= sided ]
buggyTValueDf :: Rule ComponentSet
buggyTValueDf =
describe "Buggy rule for looking up a t-value with wrong df" .
buggyRule "buggy.component.critical.t-value.df" $
inferCriticalTWith $ \sided alpha df ->
[ computeCriticalT sided alpha dfWrong | dfWrong <- incorrectDf df ]
buggyTValueTestValue :: Rule ComponentSet
buggyTValueTestValue =
describe "Buggy rule for confusing t-value with test-value" .
buggyRule "buggy.component.critical.t-value.test-value" $ \cs ->
inferCriticalTWith (\_ _ _ -> confusingTestValue cs) cs
------------------------------------------------------
buggyRValueAlpha :: Rule ComponentSet
buggyRValueAlpha =
describe "Buggy rule for looking up a r-value with wrong alpha" .
buggyRule "buggy.component.critical.r-value.alpha" $
inferCriticalRWith $ \sided alpha df ->
[ computeCriticalR sided a df | a <- alphaValues, a /= alpha ]
buggyRValueSided :: Rule ComponentSet
buggyRValueSided =
describe "Buggy rule for looking up a r-value with wrong sidedness" .
buggyRule "buggy.component.critical.r-value.sided" $
inferCriticalRWith $ \sided alpha df ->
[ computeCriticalR s alpha df | s <- sidedValues, s /= sided ]
buggyRValueDf :: Rule ComponentSet
buggyRValueDf =
describe "Buggy rule for looking up a r-value with wrong df" .
buggyRule "buggy.component.critical.r-value.df" $
inferCriticalRWith $ \sided alpha df ->
[ computeCriticalR sided alpha dfWrong | dfWrong <- incorrectDf df ]
buggyRValueTestValue :: Rule ComponentSet
buggyRValueTestValue =
describe "Buggy rule for confusing r-value with test-value" .
buggyRule "buggy.component.critical.r-value.test-value" $ \cs ->
inferCriticalRWith (\_ _ _ -> confusingTestValue cs) cs
------------------------------------------------------
buggyFValueAlpha :: Rule ComponentSet
buggyFValueAlpha =
describe "Buggy rule for looking up f-value with wrong alpha" .
buggyRule "buggy.component.critical.f-value.alpha" $
inferCriticalFWith $ \dfBetween dfWithin alpha ->
[ result
| a <- [0.01, 0.05], a /= alpha
, result <- computeCriticalF dfBetween dfWithin a
]
buggyFValueDf :: Rule ComponentSet
buggyFValueDf =
describe "Buggy rule for looking up f-value with wrong df" .
buggyRule "buggy.component.critical.f-value.df" $
inferCriticalFWith $ \dfBetween dfWithin alpha ->
[ result
| dfB <- [dfBetween, 2]
, dfW <- [dfWithin, 40]
, dfBetween /= dfB || dfWithin /= dfW
, result <- computeCriticalF dfB dfW alpha
]
buggyFValueTestValue :: Rule ComponentSet
buggyFValueTestValue =
describe "Buggy rule for confusing f-value with test-value" .
buggyRule "buggy.component.critical.f-value.test-value" $ \cs ->
inferCriticalFWith (\_ _ _ -> confusingTestValue cs) cs
------------------------------------------------------
buggyChiValueSided :: Rule ComponentSet
buggyChiValueSided =
describe "Buggy rule for looking up a chi-value with wrong sidedness" .
buggyRule "buggy.component.critical.chi-value.sided" $
inferCriticalChiWith $ \sided alpha df ->
[ result
| s <- sidedValues
, s /= sided
, result <- computeCriticalChi s alpha df
]
buggyChiValueAlpha :: Rule ComponentSet
buggyChiValueAlpha =
describe "Buggy rule for looking up chi-value with wrong alpha" .
buggyRule "buggy.component.critical.chi-value.alpha" $
inferCriticalChiWith $ \sided alpha df ->
[ result
| a <- alphaChiValues, a /= alpha
, result <- computeCriticalChi sided a df
]
buggyChiValueDf :: Rule ComponentSet
buggyChiValueDf =
describe "Buggy rule for looking up chi-value with wrong df" .
buggyRule "buggy.component.critical.chi-value.df" $
inferCriticalChiWith $ \sided alpha df ->
[ result
| dfWrong <- incorrectDf df
, result <- computeCriticalChi sided alpha dfWrong
]
buggyChiValueTestValue :: Rule ComponentSet
buggyChiValueTestValue =
describe "Buggy rule for confusing chi-value with test-value" .
buggyRule "buggy.component.critical.chi-value.test-value" $ \cs ->
inferCriticalChiWith (\_ _ _ -> confusingTestValue cs) cs
------------------------------------------------------
buggyHypothesesSampleMean :: Rule ComponentSet
buggyHypothesesSampleMean =
describe "Buggy rule for adding one or two hypotheses using sample mean instead of population mean" $
buggyRule "buggy.component.hypotheses-samplemean" f
where
f :: ComponentSet -> [ComponentSet]
f cs = do
guard (derived cs `doesNotContain` NullHypothesis)
guard (derived cs `doesNotContain` AlternativeHypothesis)
ha <- getRelation AlternativeHypothesis cs
let h0 = h0FromHA ha
sm <- getExpr SampleMean cs
rtp <- nub [EqualTo, relationType h0]
let h0' = makeType rtp (leftHandSide h0) (rightHandSide h0)
buggyH0 = makeType rtp (leftHandSide h0) sm
buggyHA = makeType (relationType ha) (leftHandSide ha) sm
results =
[ append AlternativeHypothesis (CRelation buggyHA) $
append NullHypothesis (CRelation buggyH0) cs
, append AlternativeHypothesis (CRelation ha) $
append NullHypothesis (CRelation buggyH0) cs
, append AlternativeHypothesis (CRelation buggyHA) $
append NullHypothesis (CRelation h0') cs
]
results
buggyH0SampleMean :: Rule ComponentSet
buggyH0SampleMean =
describe "Buggy rule for adding h0 using sample mean instead of population mean" $
buggyRule "buggy.component.h0-samplemean" f
where
f :: ComponentSet -> [ComponentSet]
f cs = do
guard (derived cs `doesNotContain` NullHypothesis)
ha <- getRelation AlternativeHypothesis cs
let h0 = h0FromHA ha
sm <- getExpr SampleMean cs
rtp <- nub [EqualTo, relationType h0]
let buggyH0 = makeType rtp (leftHandSide h0) sm
return $ append NullHypothesis (CRelation buggyH0) cs
buggyHASampleMean :: Rule ComponentSet
buggyHASampleMean =
describe "Buggy rule for adding ha using sample mean instead of population mean" $
buggyRule "buggy.component.ha-samplemean" f
where
f :: ComponentSet -> Maybe ComponentSet
f cs = do
guard (derived cs `doesNotContain` AlternativeHypothesis)
ha <- getRelation AlternativeHypothesis cs
sm <- getExpr SampleMean cs
let buggyHA = makeType (relationType ha) (leftHandSide ha) sm
return $ append AlternativeHypothesis (CRelation buggyHA) cs
buggyTestZValueRule :: Rule ComponentSet
buggyTestZValueRule =
describe "Standard error instead of standard deviation" $
buggyRule "buggy.component.test-z-value" f
where
f :: ComponentSet -> Maybe ComponentSet
f cs = do
guard (cs `doesNotContain` TestValue)
let expr = (Var "M" - Var "mu") / Var "sigma"
val <- match doubleView (getSubstitution cs |-> expr)
var <- inferVar cs
return $ append TestValue (CRelation (var .==. toExpr val)) cs
-- see buggyTestZValueRule: only difference is 's' instead of 'sigma'
buggyTestTValueRule :: Rule ComponentSet
buggyTestTValueRule =
describe "Standard error instead of standard deviation" $
buggyRule "buggy.component.test-t-value" f
where
f :: ComponentSet -> Maybe ComponentSet
f cs = do
guard (cs `doesNotContain` TestValue)
let expr = (Var "M" - Var "mu") / Var "s"
val <- match doubleView (getSubstitution cs |-> expr)
var <- inferVar cs
return $ append TestValue (CRelation (var .==. toExpr val)) cs
buggyTValuePositive :: Rule ComponentSet
buggyTValuePositive =
buggyRule "buggy.component.critical.t-value-positive" f
where
f :: ComponentSet -> Maybe ComponentSet
f cs = do
cs' <- apply lookupTValueRule cs
rel <- getRelation Critical cs'
val <- match doubleView (rightHandSide rel)
guard (val < 0)
return $ append Critical (CRelation $ Var "tcrit" .==. toExpr (abs val)) cs
buggyRulesTest :: [Rule ComponentSet]
buggyRulesTest =
[ buggyRule (makeId wrong correct) (wrongTest wrong correct)
| wrong <- types
, correct <- types
, wrong /= correct
]
where
types = [TTestOne, TTestTwo, TTestPaired, ZTest]
makeId t1 t2 = "buggy.component." ++ show t1 ++ ".should-be-" ++ show t2
wrongTest :: TestType -> TestType -> ComponentSet -> Maybe ComponentSet
wrongTest wrong correct cs = do
guard (derived cs `doesNotContain` TestChoice)
let tests = validTests cs
guard (correct `elem` tests)
return $ append TestChoice (CChoice $ TestType wrong) cs
-- Wrong sidedness in alternative hypothesis (due to sample mean)
wrongHARule :: ComponentSet -> Maybe ComponentSet
wrongHARule cs =
let relFromMean :: Double -> Double -> RelationType
relFromMean mean mu
| mean < mu = LessThanOrEqualTo
| otherwise = GreaterThanOrEqualTo
in do
guard (cs `doesNotContain` AlternativeHypothesis)
ha <- getRelation AlternativeHypothesis cs -- used to be Claim
let h0 = h0FromHA ha
h0Rel = relationType h0
guard (h0Rel == EqualTo)
let lhs = leftHandSide ha
rhs = rightHandSide ha
rhs' <- match doubleView rhs
mean <- match doubleView =<< getExpr SampleMean cs
let rel = relFromMean mean rhs'
return . append AlternativeHypothesis
(CRelation (makeType rel lhs rhs)) $ cs
wrongAlphaRule :: ComponentSet -> Maybe ComponentSet
wrongAlphaRule cs = do
guard (cs `doesNotContain` SignificanceLevel)
return $ append SignificanceLevel (CExpr $ Number 0.1) cs
-- | Use the wrong df: t-tests are swapped so n instead of n-1 or n_1 + n_2 - 1
-- instead of n_1 + n_2 - 2
wrongDf :: ComponentSet -> Maybe ComponentSet
wrongDf cs =
let dfWrong :: TestType -> Maybe Expr
dfWrong TTestOne = Just (Var "n")
dfWrong TTestPaired = Just (Var "n")
dfWrong TTestTwo = Just (Var "n1" + Var "n2" - 1)
dfWrong _ = Nothing
in do
guard (cs `doesNotContain` Df)
test <- inferTestChoice cs
df <- dfWrong test
return $ append Df (CExpr df) cs