module Task.Matryoshka.Assess where
import Data.Monoid
import Domain.Math.Expr
import Ideas.Utils.Uniplate
import Recognize.Data.Approach
import Bayes.Evidence
import Recognize.Data.Attribute hiding (Other)
import Recognize.Data.Diagnosis as S
import Recognize.Data.Step
import Recognize.Model.Assess
import Recognize.Model.Connectives
import Recognize.Model.Constraint
import Recognize.Model.EvidenceBuilder
import Recognize.Expr.Normalform
import Recognize.Expr.Symbols
import Task.Network.Matryoshka
import Bayes.Network
assess' :: Diagnosis -> Evidence
assess' sd =
stringNode (apprtostring appr) ans1Strat <>
answerCorrect 5 attrs ans1 <>
generateEvidence buildStepsEvidence appr attrs
where attrs = map (snd . getValue) $ steps sd
appr = approach sd
apprtostring Algebraic = Just "Algebraic"
apprtostring Numerical = Just "Numerical1"
apprtostring (Other "Numerical2") = Just "Numerical2"
apprtostring _ = Nothing
buildStepsEvidence :: Approach -> EvBuilder ()
buildStepsEvidence Algebraic = stepsAGBuilder
buildStepsEvidence Numerical = stepsN1Builder
buildStepsEvidence (Other "Numerical2") = stepsN2Builder
buildStepsEvidence _ = return ()
stepsAGBuilder :: EvBuilder ()
stepsAGBuilder = do
giveNodeAndCollect ans1Strat1Step2 (withoutFailure $ exists1 (Label "Def"))
let ev3_0 = withoutFailure $ exists [Label "F", LabelE "N" (approx 0 0)]
let ev3_1 = withoutFailure $ exists [Label "F", LabelE "N" (approx 0 1)]
let ev3_2 = withoutFailure $ exists [Label "F", LabelE "N" (approx 0 2)]
let ev3_3 = withoutFailure $ exists [Label "F", LabelE "N" (approx 0 3)]
let ev3_4 = withoutFailure $ exists [Label "F", LabelE "N" (approx 0 4)]
giveNodeAndCollectAllKnown ans1Strat1Step3 [ev3_0, ev3_1, ev3_2, ev3_3, ev3_4]
giveNodeAndCollect ans1Strat1Step4 $ withoutFailure $ exists [Label "F", LabelE "N" (approx 0 5)]
var5_a <- newVar "var5a"
let ev5_a = exists1 (LabelE "L" var5_a)
var5_b <- newVar "var5b"
let ev5_b = exists1 (FinalAnswer var5_b)
giveNodeAndCollectAll ans1Strat1Step5 [ev5_a, ev5_b, normalform var5_a <~> normalform var5_b]
isStepN1 :: Constraint EvBuilder [Attribute]
isStepN1 = exists1 (Label "N1")
stepsN1Builder :: EvBuilder ()
stepsN1Builder = do
n1_1 <- newVar "N1_1"
stepBuilder ans1Strat2Step1 n1_1 (32 * 0.75) isStepN1
n1_2 <- newVar "N1_2"
stepBuilder ans1Strat2Step2 n1_2 (n1_1 * 0.75) isStepN1
n1_3 <- newVar "N1_3"
stepBuilder ans1Strat2Step3 n1_3 (n1_2 * 0.75) isStepN1
n1_4 <- newVar "N1_4"
stepBuilder ans1Strat2Step4 n1_4 (n1_3 * 0.75) isStepN1
n1_5 <- newVar "N1_5"
stepBuilder ans1Strat2Step5 n1_5 (n1_4 * 0.75) isStepN1
giveNodeAndCollect ans1Strat2Step6 (exists1 (FinalAnswer 5))
isStepN2a :: Constraint EvBuilder [Attribute]
isStepN2a = exists1 (Label "N2a")
isStepN2b :: Constraint EvBuilder [Attribute]
isStepN2b = exists1 (Label "N2b")
stepsN2Builder :: EvBuilder ()
stepsN2Builder = do
n2_1 <- newVar "N2_1a"
stepBuilder ans1Strat3Step1 n2_1 8 isStepN2a
n2_2 <- newVar "N2_2b"
stepBuilder ans1Strat3Step2 n2_2 24 isStepN2b
n2_3 <- newVar "N2_3a"
stepBuilder ans1Strat3Step3 n2_3 (n2_2 * 0.25) isStepN2a
n2_4 <- newVar "N2_4b"
stepBuilder ans1Strat3Step4 n2_4 (n2_2 - n2_3) isStepN2b
n2_5 <- newVar "N2_5a"
stepBuilder ans1Strat3Step5 n2_5 (n2_4 * 0.25) isStepN2a
n2_6 <- newVar "N2_6b"
stepBuilder ans1Strat3Step6 n2_6 (n2_4 - n2_5) isStepN2b
n2_7 <- newVar "N2_7a"
stepBuilder ans1Strat3Step7 n2_7 (n2_6 * 0.25) isStepN2a
n2_8 <- newVar "N2_8b"
stepBuilder ans1Strat3Step8 n2_8 (n2_6 - n2_7) isStepN2b
n2_9 <- newVar "N2_9a"
stepBuilder ans1Strat3Step9 n2_9 (n2_8 * 0.25) isStepN2a
n2_10 <- newVar "N2_10b"
stepBuilder ans1Strat3Step10 n2_10 (n2_8 - n2_9) isStepN2b
giveNodeAndCollect ans1Strat3Step11 (exists1 (FinalAnswer 5))
stepBuilder :: Node (Maybe Bool) -> Expr -> Expr -> Constraint EvBuilder [Attribute] -> EvBuilder ()
stepBuilder n var expr c = do
let constraint = c ==> exists1 (MatchedBy var (normalform expr))
==> (failOnAnyMistake <?>> success)
exp' <- nf <$> transformM getValueOf expr
giveNodeAndCollectDefault n constraint var exp'