{- |
The newspaper "Sueddeutsche" asked their readers
what professions 16 persons have,
by only showing the photographies of them and three choices.

Their statistics was:
22% readers had  0 to  5 correct answers   (category 0)
75% readers had  6 to 11 correct answers   (category 1)
 3% readers had 12 to 16 correct answers   (category 2)

Can this statistics be explained with random guessing,
or is there some information in the photographies
that the readers could utilize?

I got 6 correct answers.
-}

module Numeric.Probability.Example.Profession where

import qualified Numeric.Probability.Distribution as Dist


-- type Probability = Rational
type Probability = Double
type Dist a = Dist.T Probability a

correctAnswers :: Dist Int
correctAnswers :: Dist Int
correctAnswers = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
16 forall a b. (a -> b) -> a -> b
$ forall prob a. Fractional prob => [(a, prob)] -> T prob a
Dist.fromFreqs [(Int
0,Probability
2), (Int
1,Probability
1)]

categories :: Dist Int
categories :: Dist Int
categories =
   forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map (\Int
n -> if Int
nforall a. Ord a => a -> a -> Bool
<=Int
5 then Int
0 else if Int
nforall a. Ord a => a -> a -> Bool
<=Int
11 then Int
1 else Int
2) Dist Int
correctAnswers