module Drasil.SWHSNoPCM.IMods (eBalanceOnWtr, iMods, instModIntro, eBalanceOnWtrRC) where

import Language.Drasil
import Theory.Drasil (InstanceModel, im, qwC, qwUC, newDEModel')
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Control.Lens ((^.))

import Data.Drasil.Concepts.Documentation (goal)
import Data.Drasil.Concepts.Math (equation)
import Data.Drasil.Concepts.PhysicalProperties (liquid)
import Data.Drasil.Concepts.Thermodynamics (melting, boilPt)

import Data.Drasil.Quantities.Physics (energy, time)

import Drasil.SWHS.Concepts (water)
import Drasil.SWHS.DataDefs (balanceDecayRate)
import Drasil.SWHS.GenDefs (htFluxWaterFromCoil)
import Drasil.SWHS.IMods (eBalanceOnWtrDerivDesc1, eBalanceOnWtrDerivDesc3, heatEInWtr)
import Drasil.SWHS.References (koothoor2013)
import Drasil.SWHS.Unitals (coilHTC, coilSA, htCapW, htFluxC, tauW, tempC,
  tempInit, tempW, timeFinal, wMass)

import Drasil.SWHSNoPCM.Assumptions (assumpNIHGBW, assumpWAL)
import Drasil.SWHSNoPCM.Goals (waterTempGS, waterEnergyGS)
import Drasil.SWHSNoPCM.Derivations (eBalanceOnWtrDerivEqns)

iMods :: [InstanceModel]
iMods :: [InstanceModel]
iMods = [InstanceModel
eBalanceOnWtr, InstanceModel
heatEInWtr]

---------
-- IM1 --
---------
-- FIXME: comment on reference?
eBalanceOnWtr :: InstanceModel
eBalanceOnWtr :: InstanceModel
eBalanceOnWtr = ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
im (DifferentialModel -> ModelKind Expr
forall e. DifferentialModel -> ModelKind e
newDEModel' DifferentialModel
eBalanceOnWtrRC)
  [UncertQ -> RealInterval Expr Expr -> Input
forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UncertQ
tempC (RealInterval Expr Expr -> Input)
-> RealInterval Expr Expr -> Input
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> RealInterval Expr Expr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, UncertQ -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit)
  , UncertQ -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
tempInit, UncertQ -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
timeFinal, UncertQ -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilSA, UncertQ -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilHTC, UncertQ -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapW, UnitalChunk -> Input
forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
wMass]
  (ConstrConcept -> Output
forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw ConstrConcept
tempW) []
  --Tw(0) cannot be presented, there is one more constraint Tw(0) = Tinit
  [Citation -> RefInfo -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo Citation
koothoor2013 (RefInfo -> DecRef) -> RefInfo -> DecRef
forall a b. (a -> b) -> a -> b
$ String -> RefInfo
RefNote String
"with PCM removed"]
  (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
eBalanceOnWtrDeriv) String
"eBalanceOnWtr" [Sentence]
balWtrNotes

eBalanceOnWtrRC :: DifferentialModel 
eBalanceOnWtrRC :: DifferentialModel
eBalanceOnWtrRC = 
  UnitalChunk
-> ConstrConcept
-> [[Expr]]
-> [Unknown]
-> [Expr]
-> String
-> NP
-> Sentence
-> DifferentialModel
makeASystemDE
    UnitalChunk
time
    ConstrConcept
tempW
    [[Expr]]
coeffs
    [Unknown]
unknowns
    [Expr]
constants
    String
"eBalanceOnWtrRC" 
    (String -> NP
nounPhraseSP (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"Energy balance on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"water to find the temperature of the water") 
    (ConstrConcept
tempW ConstrConcept
-> Getting Sentence ConstrConcept Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConstrConcept Sentence
forall c. Definition c => Lens' c Sentence
Lens' ConstrConcept Sentence
defn)
    where coeffs :: [[Expr]]
coeffs = [[Unknown -> Expr
forall r. LiteralC r => Unknown -> r
exactDbl Unknown
1, Expr -> Expr
forall r. (ExprC r, LiteralC r) => r -> r
recip_ (UnitalChunk -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauW)]]
          unknowns :: [Unknown]
unknowns = [Unknown
1, Unknown
0]
          constants :: [Expr]
constants = [Expr -> Expr
forall r. (ExprC r, LiteralC r) => r -> r
recip_ (UnitalChunk -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauW) Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$* UncertQ -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC]

balWtrNotes :: [Sentence]
balWtrNotes :: [Sentence]
balWtrNotes = ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tauW Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"calculated from", DataDefinition -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
balanceDecayRate],
  [String -> Sentence
S String
"The above", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"applies as long as the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water,
   String -> Sentence
S String
"is in", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
liquid, String -> Sentence
S String
"form" Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (ConstrConcept -> RealInterval ModelExpr ModelExpr -> ModelExpr
forall c.
HasUID c =>
c -> RealInterval ModelExpr ModelExpr -> ModelExpr
forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempW (RealInterval ModelExpr ModelExpr -> ModelExpr)
-> RealInterval ModelExpr ModelExpr -> ModelExpr
forall a b. (a -> b) -> a -> b
$ (Inclusive, ModelExpr)
-> (Inclusive, ModelExpr) -> RealInterval ModelExpr ModelExpr
forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, Unknown -> ModelExpr
forall r. LiteralC r => Unknown -> r
exactDbl Unknown
0) (Inclusive
Exc, Unknown -> ModelExpr
forall r. LiteralC r => Unknown -> r
exactDbl Unknown
100)),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap (Maybe UnitDefn -> Sentence) -> Maybe UnitDefn -> Sentence
forall a b. (a -> b) -> a -> b
$ ConstrConcept -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW), String -> Sentence
S String
"where", ModelExpr -> Sentence
eS (Unknown -> ModelExpr
forall r. LiteralC r => Unknown -> r
exactDbl Unknown
0),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap (Maybe UnitDefn -> Sentence) -> Maybe UnitDefn -> Sentence
forall a b. (a -> b) -> a -> b
$ ConstrConcept -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW) Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (Unknown -> ModelExpr
forall r. LiteralC r => Unknown -> r
exactDbl Unknown
100),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap (Maybe UnitDefn -> Sentence) -> Maybe UnitDefn -> Sentence
forall a b. (a -> b) -> a -> b
$ ConstrConcept -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW), String -> Sentence
S String
"are the", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP ((ConceptChunk
melting ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
   ConceptChunk
boilPt) NP -> ConceptChunk -> NP
forall c d. (NounPhrase c, NamedIdea d) => c -> d -> NP
`of_PSNPNI` ConceptChunk
water) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"respectively", Sentence -> Sentence
sParen (ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWAL)]]

----------------------------------------------
--    Derivation of eBalanceOnWtr           --
----------------------------------------------
eBalanceOnWtrDeriv :: Derivation
eBalanceOnWtrDeriv :: Derivation
eBalanceOnWtrDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
energy) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"balance on water")
  ([[Sentence]] -> [Sentence]
forall a. [[a]] -> [a]
weave [[Sentence]
eBalanceOnWtrDerivSentences, (ModelExpr -> Sentence) -> [ModelExpr] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
eBalanceOnWtrDerivEqns])

eBalanceOnWtrDerivSentences :: [Sentence]
eBalanceOnWtrDerivSentences :: [Sentence]
eBalanceOnWtrDerivSentences = [Sentence -> Sentence -> Sentence -> ConceptInstance -> Sentence
eBalanceOnWtrDerivDesc1 Sentence
EmptyS (String -> Sentence
S String
"over area" Sentence -> Sentence -> Sentence
+:+ UncertQ -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilSA) Sentence
EmptyS ConceptInstance
assumpNIHGBW,
  Sentence
eBalanceOnWtrDerivDesc2, Sentence
eBalanceOnWtrDerivDesc3, Sentence
eBalanceOnWtrDerivDesc4]

eBalanceOnWtrDerivDesc2 :: Sentence
eBalanceOnWtrDerivDesc2 :: Sentence
eBalanceOnWtrDerivDesc2 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Using", GenDefn -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxWaterFromCoil Sentence -> Sentence -> Sentence
`S.for`
  UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxC Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"this can be written as"]

eBalanceOnWtrDerivDesc4 :: Sentence
eBalanceOnWtrDerivDesc4 :: Sentence
eBalanceOnWtrDerivDesc4 = [DataDefinition] -> Sentence
forall r.
(Referable r, HasShortName r, DefinesQuantity r) =>
[r] -> Sentence
substitute [DataDefinition
balanceDecayRate]

-----------
-- Intro --
-----------

instModIntro :: Sentence
instModIntro :: Sentence
instModIntro = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
goal), ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
waterTempGS,
  String -> Sentence
S String
"is met by", InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr Sentence -> Sentence -> Sentence
`S.andThe` IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
goal,
  ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
waterEnergyGS, String -> Sentence
S String
"is met by", InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
heatEInWtr]