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 (forall e. DifferentialModel -> ModelKind e
newDEModel' DifferentialModel
eBalanceOnWtrRC)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UncertQ
tempC forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit)
  , forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
tempInit, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
timeFinal, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilSA, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilHTC, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapW, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
wMass]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw ConstrConcept
tempW) []
  --Tw(0) cannot be presented, there is one more constraint Tw(0) = Tinit
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo Citation
koothoor2013 forall a b. (a -> b) -> a -> b
$ String -> RefInfo
RefNote String
"with PCM removed"]
  (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 forall a b. (a -> b) -> a -> b
$ String
"Energy balance on " forall a. [a] -> [a] -> [a]
++ String
"water to find the temperature of the water") 
    (ConstrConcept
tempW forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn)
    where coeffs :: [[Expr]]
coeffs = [[forall r. LiteralC r => Unknown -> r
exactDbl Unknown
1, forall r. (ExprC r, LiteralC r) => r -> r
recip_ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauW)]]
          unknowns :: [Unknown]
unknowns = [Unknown
1, Unknown
0]
          constants :: [Expr]
constants = [forall r. (ExprC r, LiteralC r) => r -> r
recip_ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauW) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC]

balWtrNotes :: [Sentence]
balWtrNotes :: [Sentence]
balWtrNotes = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tauW Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"calculated from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
balanceDecayRate],
  [String -> Sentence
S String
"The above", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"applies as long as the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water,
   String -> Sentence
S String
"is in", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
liquid, String -> Sentence
S String
"form" Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempW forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Unknown -> r
exactDbl Unknown
0) (Inclusive
Exc, forall r. LiteralC r => Unknown -> r
exactDbl Unknown
100)),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW), String -> Sentence
S String
"where", ModelExpr -> Sentence
eS (forall r. LiteralC r => Unknown -> r
exactDbl Unknown
0),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW) Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (forall r. LiteralC r => Unknown -> r
exactDbl Unknown
100),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW), String -> Sentence
S String
"are the", forall n. NounPhrase n => n -> Sentence
pluralNP ((ConceptChunk
melting forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
   ConceptChunk
boilPt) 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 (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 (forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
energy) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"balance on water")
  (forall a. [[a]] -> [a]
weave [[Sentence]
eBalanceOnWtrDerivSentences, 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
+:+ 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", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxWaterFromCoil Sentence -> Sentence -> Sentence
`S.for`
  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 = forall r.
(Referable r, HasShortName r, DefinesQuantity r) =>
[r] -> Sentence
substitute [DataDefinition
balanceDecayRate]

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

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