----------------------------------------------------------------------------- -- 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.Examples {- ( hypothesisExamples , ex_dwo2 , ex_dwo3 , ex_simple ) -} where import Domain.Math.Data.Relation import Domain.Math.Expr import Domain.Statistics.ComponentSet import Ideas.Common.Exercise import Prelude hiding ((^)) hypothesisExamples :: Examples ComponentSet hypothesisExamples = examplesWithDifficulty $ [ (Easy, ex_simple) , (Easy, ex_omi1) , (Easy, ex_omi2) , (Easy, ex_omi3) , (Medium, ex_econ) , (Medium, ex_dwo1) , (Medium, ex_dwo2) , (Medium, ex_dwo3) , (Medium, ex_dwo4) , (Medium, ex_dwo5) , (Medium, ex_dwo6) , (Medium, ex_dwo7) , (Medium, sietske_1) , (Medium, sietske_2) , (Medium, sietske_3) , (Difficult, ex_bio') ] ++ [ (Medium, cs) | cs <- [mayPilotA, mayPilotB, mayPilotC, mayPilotD] ] cExprDouble :: Double -> Component cExprDouble = CExpr . fromDouble -------------------------------------------------------------------------------- -- * Pilot exercises (May 2017) * -- -------------------------------------------------------------------------------- {- Montarello and Martins (2005) discovered that children from the 7th group were able to solve more difficult maths exercises if very simple exercises were added to the exam. To research this phenomenon a researcher picks a standardised exam of which the scores have a gaussian distribution with mu = 50, sigma = 8, and adds very easy exercises to it. They give the exam to 40 children. The mean outcome of the test is M = 52. Is this result enough to conclude that adding the easy exercises improves the childrens prestation? Assume a significance level of alpha = 0.05 -} -- Note: Claim assumed that `improvement' means mu_after - mu_before > 0 mayPilotA :: ComponentSet mayPilotA = initialSet [ -- ( Claim , CRelation $ Var "mu" .>. fromDouble 50 ) ( AlternativeHypothesis, CRelation $ Var "mu" .>. fromDouble 50) , ( SampleMean , cExprDouble 52 ) , ( PopulationMean , cExprDouble 50 ) -- I think that different means will , ( PopulationSdev , cExprDouble 8 ) -- cause all sorts of trouble with , ( SampleSize , CExpr 40 ) -- the strategy. , ( SignificanceLevel , cExprDouble 0.05 ) ] {- It has been showed by Evans, Pelham, Smith et al. (2001) that the Ritalin medicin improves the attention span of children with ADHD and that their school results improve. A researcher draws a sample of N = 16 children that have been diagnosed with ADHD to demonstrate that the medicine truly works. Their attention span is measured before and after the medicine has been used. The results show an average improvement of the attention span of M = 3.13 minutes with a standard deviation of s = 5.39. Are the results of this experiment enough to conclude that the the medicine improves the attention span of children with ADHD? Assume a significance level of alpha = 0.01. -} -- Note: mu_d means mu_after - mu_before mayPilotB :: ComponentSet mayPilotB = initialSet [ -- ( Claim , CRelation $ Var "mu" .>. fromDouble 0) ( AlternativeHypothesis, CRelation $ Var "mu" .>. fromDouble 0) , ( SampleSize , CExpr 16 ) , ( SampleMean , cExprDouble 3.13 ) , ( SampleSdev , cExprDouble 5.39 ) , ( SignificanceLevel , cExprDouble 0.01 ) , ( TestChoice , CChoice (TestType TTestPaired)) ] {- A researcher compares two treatments during a design with independent groups. Group A has 18 participants and group V has 16 participants. The means for the groups are found to be M = 12.14 for group A and M = 16.17 for group B. The pooled variance s^2 is approximated to be 7.74. The researcher wants to know if the treatments will leaad to a different result. Assume a significance level of alpha = 0.05. -} mayPilotC :: ComponentSet mayPilotC = initialSet [ -- ( Claim , CRelation $ Var "mu1" ./=. Var "mu2") ( AlternativeHypothesis, CRelation $ Var "mu1" ./=. Var "mu2") , ( One SampleSize , CExpr 18 ) , ( Two SampleSize , CExpr 16 ) , ( One SampleMean , cExprDouble 12.14 ) , ( Two SampleMean , cExprDouble 16.70 ) , ( PooledVariance , cExprDouble 7.74 ) , ( SignificanceLevel , cExprDouble 0.05 ) ] {- The mean annual income for a randomised sample of 51 househoulds turns out to be 23 613 euros. The standard deviation of the sample is 658 euros. You may assume that annual income is normally distributed. Research the claim that mean annual income in the population is lower than 24000. Assume a significance level of alpha = 0.10. -} mayPilotD :: ComponentSet mayPilotD = initialSet [ -- ( Claim , CRelation $ Var "mu" .<. fromDouble 24000) ( AlternativeHypothesis, CRelation $ Var "mu" .<. fromDouble 24000) , ( SampleSize , CExpr 51 ) , ( SampleMean , cExprDouble 23613 ) , ( PopulationMean , cExprDouble 24000 ) , ( SampleSdev , cExprDouble 658 ) , ( SignificanceLevel , cExprDouble 0.10 ) ] -- Example from an exam ex_econ :: ComponentSet ex_econ = initialSet [ (SampleSize, CExpr 61) , (SampleMean, CExpr $ fromDouble 21023.0) , (SampleSdev, CExpr $ fromDouble 634.0) , (AlternativeHypothesis, CRelation $ Var "mu" .<=. 22000) ] -- Example for an hypothesis test ex_simple :: ComponentSet ex_simple = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" .>=. fromDouble 98.6), (SampleSize, CExpr 101), (SampleMean, CExpr $ fromDouble 98.9), (SampleSdev, CExpr $ fromDouble 0.6)] -- Examples from the OMI course ex_omi1 :: ComponentSet ex_omi1 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" ./=. fromDouble 20.0), (SampleSize, CExpr 10), (SampleMean, CExpr $ fromDouble 22.3), (SampleSdev, CExpr $ fromDouble 3.65) ] ex_omi2 :: ComponentSet ex_omi2 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" .>=. fromDouble 20.0), (SampleSize, CExpr 10), (SampleMean, CExpr $ fromDouble 22.3), (SampleSdev, CExpr $ fromDouble 3.65) ] ex_omi3 :: ComponentSet ex_omi3 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" .==. Var "mu2"), (One SampleSize, CExpr 46), (Two SampleSize, CExpr 56), (One SampleMean, CExpr $ fromDouble 3.8698), (Two SampleMean, CExpr $ fromDouble 4.5819), (One SampleSdev, CExpr $ fromDouble 1.6714), (Two SampleSdev, CExpr $ fromDouble 1.5216), (PooledVariance, CExpr $ fromDouble 2.531) ] -- Example from an exam simplified ex_bio' :: ComponentSet ex_bio' = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" .==. Var "mu2"), (One SampleSize, CExpr 9), (Two SampleSize, CExpr 9), (One SampleMean, CExpr $ fromDouble 19.189), (Two SampleMean, CExpr $ fromDouble 28.067), (One SampleSdev, CExpr $ fromDouble 6.36), (Two SampleSdev, CExpr $ fromDouble 6.12), (PooledVariance, CExpr $ fromDouble 38.843)] -- Examples from the DWO ex_dwo1 :: ComponentSet ex_dwo1 = ex_econ ex_dwo2 :: ComponentSet ex_dwo2 = initialSet [ (SampleSize, CExpr 68), (SampleMean, CExpr $ fromDouble 23035.0), (SampleSdev, CExpr $ fromDouble 658.0), (AlternativeHypothesis, CRelation $ Var "mu" .>=. 24000), (SignificanceLevel, CExpr $ fromDouble 0.10)] ex_dwo3 :: ComponentSet ex_dwo3 = initialSet [ (SampleSize, CExpr 61), (SampleMean, CExpr $ fromDouble 21023.0), (SampleSdev, CExpr $ fromDouble 634.0), (AlternativeHypothesis, CRelation $ Var "p" ./=. fromDouble 0.25), (Proportion, CExpr $ fromDouble 0.21) -- fix me (TestStatistic "t", CExpr $ (Var "p" - Var "p0") / sqrt ((Var "p0") * (1.0 - Var "p0") / (Var "n"))) ] ex_dwo4 :: ComponentSet ex_dwo4 = initialSet [ (SampleSize, CExpr 72), (SampleMean, CExpr $ fromDouble 24061.0), (SampleSdev, CExpr $ fromDouble 663.0), (AlternativeHypothesis, CRelation $ Var "p" ./=. fromDouble 0.3), (Proportion, CExpr $ fromDouble 0.22), --(TestStatistic "t", CExpr $ (Var "p" - Var "p0") / sqrt ((Var "p0") * (1.0 - Var "p0") / (Var "n"))), (SignificanceLevel, CExpr $ fromDouble 0.01)] ex_dwo5 :: ComponentSet ex_dwo5 = initialSet [ (SampleSize, CExpr 100), (SampleMean, CExpr $ fromDouble 24061.0), (SampleSdev, CExpr $ fromDouble 663.0), (AlternativeHypothesis, CRelation $ Var "p1" .>=. Var "p2"), (One Proportion, CExpr $ fromDouble 0.3), (Two Proportion, CExpr $ fromDouble 0.1), (Other "p0", CExpr $ (Var "p1" + Var "p2") / 2), (Other "d0", CExpr $ fromDouble 0.0) -- fix me (TestStatistic "t", CExpr $ (Var "p1" - Var "p2" - Var "d0") / (sqrt $ (Var "p0") * (1.0 - Var "p0") / ((Var "n") / 2))) ] ex_dwo6 :: ComponentSet ex_dwo6 = initialSet [ (SampleSize, CExpr 100), (SampleMean, CExpr $ fromDouble 24061.0), (SampleSdev, CExpr $ fromDouble 663.0), (AlternativeHypothesis, CRelation $ Var "p1" ./=. Var "p2"), (One Proportion, CExpr $ fromDouble 0.3), (Two Proportion, CExpr $ fromDouble 0.1), (Other "p0", CExpr $ (Var "p1" + Var "p2") / 2), (Other "d0", CExpr $ fromDouble 0.0) -- fix me (TestStatistic "t", CExpr $ (Var "p1" - Var "p2" - Var "d0") / (sqrt $ (Var "p0") * (1.0 - Var "p0") / ((Var "n") / 2))) ] ex_dwo7 :: ComponentSet ex_dwo7 = initialSet [ (SampleSize, CExpr 490), (SampleMean, CExpr $ fromDouble 83.0), (Correlation, CExpr $ fromDouble (-0.557)), (Df, CExpr $ Var "n" - 2), (AlternativeHypothesis, CRelation $ Var "r" .>=. fromDouble 0.0) ] {- "Average income" example - - Steekproefgrootte n = 61 - Steekproefgemiddelde m = 21023 - Steekproefstandaardafwijking s = 634 - “Je mag aannemen dat inkomen normaal is verdeeld” - Significantieniveau α = 0,05. - Claim: Het populatiegemiddelde μ is kleiner dan 22000. -} sietske_1 :: ComponentSet sietske_1 = initialSet [ (SampleSize, CExpr 61), (SampleMean, CExpr 21023), (SampleSdev, CExpr 634), (SignificanceLevel, CExpr $ fromDouble 0.05), (AlternativeHypothesis, CRelation $ Var "mu" .<=. 22000) ] {- "Car factory" example - - Steekproefgrootte: n_1 = 100, n_2 = 100 - Steekproefproportie 1: p_A = 0.3 - Steekproefproportie 2: p_B = 0.1 - Significantieniveau: alpha = 0.05. - p_0 = (p_A + p_B) / 2 - Verschil tussen populatieproporties onder nulhypothese D_0 = 0 - Toetsingsgrootheid - Claim: Populatieproportie P_A is groter dan populatieproportie P_B -} sietske_2 :: ComponentSet sietske_2 = initialSet [ (SampleSize , CExpr 100) , (One Proportion , CExpr $ fromDouble 0.3) , (Two Proportion , CExpr $ fromDouble 0.1) , (SignificanceLevel, CExpr $ fromDouble 0.05) , (Other "p0" , CExpr $ (Var "p1" + Var "p2") / 2) , (Other "d0" , CExpr $ fromDouble 0.0) -- fix me -- , (TestStatistic "t", -- CExpr $ (Var "p1" - Var "p2" - Var "d0") / (sqrt $ (Var "p0") * -- (1.0 - Var "p0") / ((Var "n") / 2))) , (AlternativeHypothesis , CRelation $ Var "p1" .>=. Var "p2") ] {- "Shop owner" example - - Steekproefgrootte n_x=20 en n_y=20 - Steekproefgemiddelde 1: = 85 - Steekproefgemiddelde 2: = 63 - Steekproefstandaardafwijking 1: s_x = 11 - Steekproefstandaardafwijking 2: s_y = 11 - Aanname dat normaal verdeeld - Verschil tussen populatiegrootheden onder nulhypothese D_0=0 - Toetsingsgrootheid - Significantieniveau α = 0,05. - Aantal vrijheidsgraden DF=n_x+n_y-2 - Claim: Populatiegemiddelde mu_A is ongelijk aan populatiegemiddelde mu_B. -} sietske_3 :: ComponentSet sietske_3 = initialSet [ (SampleSize, CExpr 100), (One SampleMean, CExpr 85), (Two SampleMean, CExpr 63), (One SampleSdev, CExpr 11), (Two SampleSdev, CExpr 11), -- fix me(TestStatistic "t", CExpr $ (mean1 - mean2 - (Var "d0")) / (sqrt((sd1 ^ 2 / (Var "n")) + (sd2 ^ 2 / (Var "n")))) ), (SignificanceLevel, CExpr $ fromDouble 0.05), -- (Df, CExpr $ (Var "n1) + (Var "n2") - 2), (AlternativeHypothesis, CRelation $ Var "muA" ./=. Var "muB") ] {- where mean1 = toExpr (One SampleMean) mean2 = toExpr (Two SampleMean) sd1 = toExpr (One SampleSdev) sd2 = toExpr (Two SampleSdev) -} -------------------------------------------------------------------------------- -- Opgaven Sociale Wetenschappen opgavenSW :: [ComponentSet] opgavenSW = [ -- december 2017 opgave_3_4, opgave_3_6, opgave_4_10, opgave_4_11, opgave_5_3, opgave_5_6 -- februari 2018 , opgave_1_5, opgave_3_5, opgave_5_4 ] -------------------------------------------------------------------------------- -- Opgaven Sociale Wetenschappen (december 2017) opgave_3_4 :: ComponentSet opgave_3_4 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" .>. 100) , (PopulationSdev, CRelation $ Var "sigma" .==. 18) , (SampleMean, CExpr 104) , (SampleSize, CExpr 36) , (SignificanceLevel, CExpr 0.01) ] opgave_3_6 :: ComponentSet opgave_3_6 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" .<. 4.9) , (PopulationSdev, CRelation $ Var "sigma" .==. 0.84) , (SampleMean, CExpr 4.4) , (SampleSize, CExpr 16) , (SignificanceLevel, CExpr 0.05) ] opgave_4_10 :: ComponentSet opgave_4_10 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" ./=. 0) , (SampleSdev, CRelation $ Var "s" .==. 1.50) , (SampleMean, CExpr 1.28) , (SampleSize, CExpr 25) , (TestChoice, CChoice $ TestType TTestPaired) , (SignificanceLevel, CExpr 0.05) ] opgave_4_11 :: ComponentSet opgave_4_11 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu" ./=. 0) , (SampleSdev, CRelation $ Var "s" .==. 2.45) , (SampleMean, CExpr 2) , (SampleSize, CExpr 6) , (TestChoice, CChoice $ TestType TTestPaired) , (SignificanceLevel, CExpr 0.05) ] opgave_5_3 :: ComponentSet opgave_5_3 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" ./=. Var "mu2") , (Df, CExpr 30) , (TestValue, CRelation $ Var "t" .==. 2.085) , (TestChoice, CChoice $ TestType TTestTwo) , (SignificanceLevel, CExpr 0.05) ] opgave_5_6 :: ComponentSet opgave_5_6 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" ./=. Var "mu2") , (Df, CExpr 119.50) , (TestValue, CRelation $ Var "t" .==. 3.379) , (TestChoice, CChoice $ TestType TTestTwo) , (SignificanceLevel, CExpr 0.05) ] -------------------------------------------------------------------------------- -- Opgaven Sociale Wetenschappen (februari 2018) opgave_1_5 :: ComponentSet opgave_1_5 = initialSet [ (AlternativeHypothesis, CRelation $ Var "rho" ./=. 0) , (SignificanceLevel, CExpr 0.01) , (TestValue, CRelation $ Var "r" .==. 0.835) , (SampleSize, CExpr 9) , (TestChoice, CChoice $ TestType RPearson) ] opgave_3_5 :: ComponentSet opgave_3_5 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" ./=. Var "mu2") , (TestValue, CRelation $ Var "F" .==. 4.00) , (SignificanceLevel, CExpr 0.05) , (SampleSize, CExpr 40) , (TestChoice, CChoice $ TestType Anova) ] opgave_5_4 :: ComponentSet opgave_5_4 = initialSet [ (SignificanceLevel, CExpr 0.01) , (TestChoice, CChoice $ TestType ChiSquared) , (ObservedFrequencies, CExpr $ toExpr [[18 :: Int, 4, 2], [4, 17, 15]]) ] -------------------------------------------------------------------------------- -- Opgaven Economie (februari 2018) opgavenEconomie :: [ComponentSet] opgavenEconomie = [opgave_4_18] opgave_4_18 :: ComponentSet opgave_4_18 = initialSet [ (AlternativeHypothesis, CRelation $ Var "mu1" ./=. Var "mu2") , (SignificanceLevel, CExpr 0.05) , (One SampleSize, CExpr 20) , (Two SampleSize, CExpr 20) , (One SampleMean, CExpr 85) , (Two SampleMean, CExpr 63) , (One SampleSdev, CExpr 11) , (Two SampleSdev, CExpr 11) , (TestFormula, CRelation $ Var "t" .==. (Var "samplemean1" - Var "samplemean2") / sqrt ((Var "samplesd1" ^ 2) / Var "n1" + (Var "samplesd2" ^ 2) / Var "n2")) ]