module Drasil.SWHS.IMods (iMods, eBalanceOnWtr, eBalanceOnWtrDerivDesc1,
  eBalanceOnWtrDerivDesc3, eBalanceOnPCM, heatEInWtr, heatEInPCM, instModIntro) where

import Language.Drasil
import Utils.Drasil (weave)
import Theory.Drasil (InstanceModel, im, imNoDeriv, qwC, qwUC, deModel',
  equationalModel, ModelKind)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S
import Control.Lens((^.))

import Data.Drasil.Concepts.Documentation (assumption, condition, constraint,
  goal, input_, solution, output_)
import Data.Drasil.Concepts.Math (change, equation, ode, rightSide, rOfChng, surArea)
import Data.Drasil.Concepts.PhysicalProperties (liquid, mass, solid, vol)
import Data.Drasil.Concepts.Thermodynamics (boilPt, boiling, heat, heatCapSpec,
  heatTrans, htFlux, latentHeat, melting, phaseChange, sensHeat, temp)
import Data.Drasil.Quantities.Physics (energy, time)

import Drasil.SWHS.Assumptions (assumpCTNOD, assumpSITWP, assumpPIS, assumpWAL,
  assumpPIT, assumpNIHGBWP, assumpVCMPN, assumpNGSP, assumpAPT, assumpTHCCoL,
  assumpCWTAT, assumpTPCAV)
import Drasil.SWHS.Concepts (coil, phsChgMtrl, tank, water)
import Drasil.SWHS.DataDefs (ddHtFusion, ddMeltFrac, balanceDecayRate,
  balanceDecayTime, balanceSolidPCM, balanceLiquidPCM)
import Drasil.SWHS.Derivations
import Drasil.SWHS.GenDefs (htFluxWaterFromCoil, htFluxPCMFromWater, rocTempSimp)
import Drasil.SWHS.Goals (waterTempGS, pcmTempGS, waterEnergyGS, pcmEnergyGS)
import Drasil.SWHS.References (koothoor2013)
import Drasil.SWHS.TMods (sensHtE, latentHtE)
import Drasil.SWHS.Unitals (coilHTC, coilSA, eta, htFluxC, htFluxP, htCapLP,
  htCapSP, htCapW, htFusion, latentEP, meltFrac, pcmE, pcmHTC, pcmInitMltE,
  pcmMass, pcmSA, pcmVol, tInitMelt, tauLP, tauSP, tauW, tempC, tempInit,
  tempMeltP, tempPCM, tempW, timeFinal, volHtGen, watE, wMass, wVol)

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

---------
-- IM1 --
---------
eBalanceOnWtr :: InstanceModel
eBalanceOnWtr :: InstanceModel
eBalanceOnWtr = ModelKind Relation
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
im (forall e. RelationConcept -> ModelKind e
deModel' RelationConcept
eBalanceOnWtrRC)
  [forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
wMass, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapW, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilHTC, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmSA, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmHTC, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
coilSA
  ,forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC ConstrConcept
tempPCM, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
timeFinal, forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Relation Relation -> Input
qwC UncertQ
tempC forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, 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]
  -- [sy tempInit $< sy tempC] 
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw ConstrConcept
tempW) []
  -- [0 $<= sy time $<= sy timeFinal]
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
koothoor2013] (forall a. a -> Maybe a
Just Derivation
eBalanceOnWtrDeriv) String
"eBalanceOnWtr" [Sentence]
balWtrDesc

eBalanceOnWtrRC :: RelationConcept
eBalanceOnWtrRC :: RelationConcept
eBalanceOnWtrRC = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC 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) ModelExpr
balWtrRel
  -- eBalanceOnWtrL

-- TODO: Clean this up properly once we have a better way of intermixing Expr & ModelExpr in files
balWtrRel :: ModelExpr
balWtrRel :: ModelExpr
balWtrRel = forall r c. (ModelExprC r, HasUID c, HasSymbol c) => r -> c -> r
deriv (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempW) UnitalChunk
time forall r. ExprC r => r -> r -> r
$= forall c. Express c => c -> ModelExpr
express Relation
balWtrExpr

balWtrExpr :: Expr
balWtrExpr :: Relation
balWtrExpr = 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 forall r. ExprC r => r -> r -> r
$- forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time) forall r. ExprC r => r -> r -> r
`addRe`
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
eta forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time forall r. ExprC r => r -> r -> r
$- forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time)))

balWtrDesc :: [Sentence]
balWtrDesc :: [Sentence]
balWtrDesc = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [forall t. Express t => t -> Sentence
eS' ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"defined by", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnPCM],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
input_), forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constraint, ModelExpr -> Sentence
eS forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit forall r. ExprC r => r -> r -> r
$<= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC,
   String -> Sentence
S String
"comes from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpCTNOD],
  [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],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
eta  Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"calculated from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
balanceDecayTime],
  [String -> Sentence
S String
"The initial", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition, String -> Sentence
S String
"for the", CI -> Sentence
getAcc CI
ode Sentence -> Sentence -> Sentence
`S.are`
   ModelExpr -> Sentence
eS (forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply ConstrConcept
tempW [forall r. LiteralC r => Integer -> r
exactDbl Integer
0] forall r. ExprC r => r -> r -> r
$= forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply ConstrConcept
tempPCM [forall r. LiteralC r => Integer -> r
exactDbl Integer
0] forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit) forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` ConceptInstance
assumpSITWP],
  [String -> Sentence
S String
"The", CI -> Sentence
getAcc CI
ode, String -> Sentence
S String
"applies as long as the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water Sentence -> Sentence -> Sentence
`S.is` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.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. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
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 => Integer -> r
exactDbl Integer
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 => Integer -> r
exactDbl Integer
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) Sentence -> Sentence -> Sentence
`S.are` forall n. NounPhrase n => n -> Sentence
pluralNP (NP -> NP
NP.the ((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",
   forall r. (Referable r, HasShortName r) => [r] -> Sentence
fromSources [ConceptInstance
assumpWAL, ConceptInstance
assumpAPT]]]

----------------------------------------------
--    Derivation of eBalanceOnWtr           --
----------------------------------------------
-- type Derivation = [Sentence]
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]
eBalanceOnWtrDerivEqnsIM1])

eBalanceOnWtrDerivSentences :: [Sentence]
eBalanceOnWtrDerivSentences :: [Sentence]
eBalanceOnWtrDerivSentences = [Sentence -> Sentence -> Sentence -> ConceptInstance -> Sentence
eBalanceOnWtrDerivDesc1 Sentence
htTransEnd Sentence
overAreas Sentence
extraAssumps ConceptInstance
assumpNIHGBWP,
  Sentence
eBalanceOnWtrDerivDesc2, Sentence
eBalanceOnWtrDerivDesc3, Sentence
eBalanceOnWtrDerivDesc4,
  Sentence
eBalanceOnWtrDerivDesc5, Sentence
eBalanceOnWtrDerivDesc6, Relation -> Sentence
eBalanceOnWtrDerivDesc7 Relation
eq2]

eBalanceOnWtrDerivDesc1 :: Sentence -> Sentence-> Sentence -> ConceptInstance -> Sentence
eBalanceOnWtrDerivDesc1 :: Sentence -> Sentence -> Sentence -> ConceptInstance -> Sentence
eBalanceOnWtrDerivDesc1 Sentence
htEnd Sentence
oa Sentence
ea ConceptInstance
htA = [Sentence] -> Sentence
foldlSentCol [
  String -> Sentence
S String
"To find the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rOfChng Sentence -> Sentence -> Sentence
`S.of_` forall t. Express t => t -> Sentence
eS' ConstrConcept
tempW Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"we look at the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"balance on" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water, forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
vol),
  String -> Sentence
S String
"being considered" Sentence -> Sentence -> Sentence
`S.isThe` forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
vol forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
water) Sentence -> Sentence -> Sentence
`S.inThe`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank, forall t. Express t => t -> Sentence
eS' UnitalChunk
wVol Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"which has", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
mass Sentence -> Sentence -> Sentence
+:+. (forall t. Express t => t -> Sentence
eS' UnitalChunk
wMass Sentence -> Sentence -> Sentence
`S.and_`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
heatCapSpec Sentence -> Sentence -> Sentence
`sC` forall t. Express t => t -> Sentence
eS' UncertQ
htCapW), forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
heatTrans, String -> Sentence
S String
"occurs in the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water, String -> Sentence
S String
"from the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
coil, String -> Sentence
S String
"as", forall t. Express t => t -> Sentence
eS' UnitalChunk
htFluxC,
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxWaterFromCoil) Sentence -> Sentence -> Sentence
+:+ Sentence
htEnd Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
+:+. Sentence
oa, Sentence
ea, String -> Sentence
S String
"No", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
heatTrans, String -> Sentence
S String
"occurs to", String -> Sentence
S String
"outside" Sentence -> Sentence -> Sentence
`S.the_ofThe`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since it has been assumed to be perfectly insulated" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPIT), String -> Sentence
S String
"Since the", forall n. NamedIdea n => n -> Sentence
phrase CI
assumption,
  String -> Sentence
S String
"is made that no internal heat is generated" Sentence -> Sentence -> Sentence
+:+. (Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
htA) Sentence -> Sentence -> Sentence
`sC`
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
volHtGen forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0)), String -> Sentence
S String
"Therefore" Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation) Sentence -> Sentence -> Sentence
`S.for`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
rocTempSimp, String -> Sentence
S String
"can be written as"]

htTransEnd :: Sentence
htTransEnd :: Sentence
htTransEnd = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"and from the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water, String -> Sentence
S String
"into the",
  CI -> Sentence
getAcc CI
phsChgMtrl, String -> Sentence
S String
"as", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP, Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxPCMFromWater)]

overAreas :: Sentence
overAreas :: Sentence
overAreas = String -> Sentence
S String
"over areas" Sentence -> Sentence -> Sentence
+:+ forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilSA Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
pcmSA Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"respectively"

extraAssumps :: Sentence
extraAssumps :: Sentence
extraAssumps = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The thermal flux is constant over", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilSA Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"since", forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
temp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
coil) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"assumed to not vary along its length",
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpTHCCoL) Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"thermal flux is constant over",
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
pcmSA Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
temp Sentence -> Sentence -> Sentence
`S.the_ofThe` CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.isThe`
  String -> Sentence
S String
"same throughout its", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
vol, Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpTPCAV) Sentence -> Sentence -> Sentence
`S.andThe`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"fully mixed", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpCWTAT)]

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
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxPCMFromWater Sentence -> Sentence -> Sentence
`S.for` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"this can be written as"]

eBalanceOnWtrDerivDesc3 :: Sentence
eBalanceOnWtrDerivDesc3 :: Sentence
eBalanceOnWtrDerivDesc3 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Dividing", Int -> Sentence
eqN Int
2, String -> Sentence
S String
"by", forall t. Express t => t -> Sentence
eS' Relation
eq1 Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we obtain"]

eBalanceOnWtrDerivDesc4 :: Sentence
eBalanceOnWtrDerivDesc4 :: Sentence
eBalanceOnWtrDerivDesc4 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Factoring the negative sign out" Sentence -> Sentence -> Sentence
`S.of_`
  (String -> Sentence
S String
"second term" Sentence -> Sentence -> Sentence
`S.the_ofThe` (forall n. NamedIdea n => n -> Sentence
phrase CI
rightSide Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
rightSide)))
  Sentence -> Sentence -> Sentence
`S.of_` Int -> Sentence
eqN Int
3 Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"multiplying it by", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilHTC, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilSA, String -> Sentence
S String
"/", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilHTC,
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
coilSA, String -> Sentence
S String
"yields"]

-- TODO: Typo. Not fixing immediately because I want to keep stable diffs empty for this PR.
eBalanceOnWtrDerivDesc5 :: Sentence
eBalanceOnWtrDerivDesc5 :: Sentence
eBalanceOnWtrDerivDesc5 = String -> Sentence
S String
"Rearranging this" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation Sentence -> Sentence -> Sentence
+: String -> Sentence
S String
"gives us"

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

eBalanceOnWtrDerivDesc7 :: Expr -> Sentence
eBalanceOnWtrDerivDesc7 :: Relation -> Sentence
eBalanceOnWtrDerivDesc7 Relation
eq22 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Finally, factoring out", forall t. Express t => t -> Sentence
eS' Relation
eq22 Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"we are left with the governing", CI -> Sentence
getAcc CI
ode Sentence -> Sentence -> Sentence
`S.for` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr]

eq1, eq2 :: Expr
eq1 :: Relation
eq1 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
wMass forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htCapW
eq2 :: Relation
eq2 = forall r. (ExprC r, LiteralC r) => r -> r
recip_ forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauW

---------
-- IM2 --
---------
eBalanceOnPCM :: InstanceModel
eBalanceOnPCM :: InstanceModel
eBalanceOnPCM = ModelKind Relation
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
im (forall e. RelationConcept -> ModelKind e
deModel' RelationConcept
eBalanceOnPCMRC) [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Relation Relation -> Input
qwC UncertQ
tempMeltP forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit)
  , forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
timeFinal, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
tempInit, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmSA
  , forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmHTC, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
pcmMass, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapSP, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapLP]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw ConstrConcept
tempPCM) []
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
koothoor2013] (forall a. a -> Maybe a
Just Derivation
eBalanceOnPCMDeriv) String
"eBalanceOnPCM" [Sentence]
balPCMNotes

eBalanceOnPCMRC :: RelationConcept
eBalanceOnPCMRC :: RelationConcept
eBalanceOnPCMRC = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"eBalanceOnPCMRC" (String -> NP
nounPhraseSP
  String
"Energy Balance on PCM to find temperature of PCM")
  (ConstrConcept
tempPCM forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) ModelExpr
balPCMRel -- eBalanceOnPCML

balPCMRel :: ModelExpr
balPCMRel :: ModelExpr
balPCMRel = forall r c. (ModelExprC r, HasUID c, HasSymbol c) => r -> c -> r
deriv (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM) UnitalChunk
time forall r. ExprC r => r -> r -> r
$= PExpr
balPCMExpr

balPCMExpr :: PExpr
balPCMExpr :: PExpr
balPCMExpr = forall r. ExprC r => [(r, r)] -> r
completeCase [(r, r)
case1, (r, r)
case2, (r, r)
case3]
  where case1 :: (r, r)
case1 = (forall r. (ExprC r, LiteralC r) => r -> r
recip_ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauSP) forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time forall r. ExprC r => r -> r -> r
$-
          forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time), forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempPCM (forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP)))
        case2 :: (r, r)
case2 = (forall r. (ExprC r, LiteralC r) => r -> r
recip_ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
tauLP) forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time forall r. ExprC r => r -> r -> r
$-
          forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time), forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempPCM (forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc,forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP)))
        case3 :: (r, r)
case3 = (forall r. LiteralC r => Integer -> r
exactDbl Integer
0, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP forall r. ExprC r => r -> r -> r
$&& forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval DefinedQuantityDict
meltFrac (forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
1)))

balPCMNotes :: [Sentence]
balPCMNotes :: [Sentence]
balPCMNotes = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempW Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"defined by", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
input_), forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constraint, ModelExpr -> Sentence
eS forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit forall r. ExprC r => r -> r -> r
$<= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP,
   String -> Sentence
S String
"comes from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPIS],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
temp), String -> Sentence
S String
"remains constant at", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
tempMeltP Sentence -> Sentence -> Sentence
`sC`
   String -> Sentence
S String
"even with the heating", Sentence -> Sentence
sParen (String -> Sentence
S String
"or cooling") Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"until the",
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
phaseChange, String -> Sentence
S String
"has occurred for all" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the material; that" Sentence -> Sentence -> Sentence
`S.is`
   String -> Sentence
S String
"as long as" Sentence -> Sentence -> Sentence
+:+. ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval DefinedQuantityDict
meltFrac forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
1)), forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
meltFrac,
   forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
ddMeltFrac Sentence -> Sentence -> Sentence
`S.is`
   String -> Sentence
S String
"determined as part" Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
heat, forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy Sentence -> Sentence -> Sentence
`S.inThe`
   CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"as given" Sentence -> Sentence -> Sentence
`S.in_` Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
heatEInPCM)],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tauSP Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"calculated" Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
balanceSolidPCM],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tauLP Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"calculated" Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
balanceLiquidPCM],
  [String -> Sentence
S String
"The initial", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition, String -> Sentence
S String
"for the", CI -> Sentence
getAcc CI
ode Sentence -> Sentence -> Sentence
`S.are`
   ModelExpr -> Sentence
eS (forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply ConstrConcept
tempW [forall r. LiteralC r => Integer -> r
exactDbl Integer
0] forall r. ExprC r => r -> r -> r
$= forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply ConstrConcept
tempPCM [forall r. LiteralC r => Integer -> r
exactDbl Integer
0] forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit) forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` ConceptInstance
assumpSITWP]] -- TODO: fix typing

 ----------------------------------------------
--    Derivation of eBalanceOnPCM          --
----------------------------------------------
eBalanceOnPCMDeriv :: Derivation
eBalanceOnPCMDeriv :: Derivation
eBalanceOnPCMDeriv = 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 the PCM during sensible heating phase")
  (forall a. [[a]] -> [a]
weave [[Sentence]
eBalanceOnPCMDerivSentences, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
eBalanceOnPCMDerivEqnsIM2]
  forall a. [a] -> [a] -> [a]
++ [Sentence
eBalanceOnPCMDerivDesc5, Sentence
eBalanceOnPCMDerivDesc6, Sentence
eBalanceOnPCMDerivDesc7])

eBalanceOnPCMDerivSentences :: [Sentence]
eBalanceOnPCMDerivSentences :: [Sentence]
eBalanceOnPCMDerivSentences = [Sentence
eBalanceOnPCMDerivDesc1, Sentence
eBalanceOnPCMDerivDesc2,
  Sentence
eBalanceOnPCMDerivDesc3, Sentence
eBalanceOnPCMDerivDesc4]

eBalanceOnPCMDerivDesc1 :: Sentence
eBalanceOnPCMDerivDesc1 :: Sentence
eBalanceOnPCMDerivDesc1 = [Sentence] -> Sentence
foldlSentCol [
  String -> Sentence
S String
"To find the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rOfChng Sentence -> Sentence -> Sentence
`S.of_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we look at the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"balance on the" Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
getAcc CI
phsChgMtrl, String -> Sentence
S String
"The", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
vol,
  String -> Sentence
S String
"being considered" Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase UncertQ
pcmVol Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
pcmVol),
  String -> Sentence
S String
"The derivation that follows is initially for the solid" Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
getAcc CI
phsChgMtrl,
  String -> Sentence
S String
"The" Sentence -> Sentence -> Sentence
+:+. (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pcmMass Sentence -> Sentence -> Sentence
`S.is` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
pcmMass Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase UncertQ
htCapSP Sentence -> Sentence -> Sentence
`S.is` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
htCapSP),
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
htFluxP) Sentence -> Sentence -> Sentence
`S.is` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP, Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxPCMFromWater),
  String -> Sentence
S String
"over", forall n. NamedIdea n => n -> Sentence
phrase UncertQ
pcmSA Sentence -> Sentence -> Sentence
+:+. forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
pcmSA, String -> Sentence
S String
"The thermal flux is constant over",
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
pcmSA Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
temp Sentence -> Sentence -> Sentence
`S.the_ofThe` CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.isThe`
  String -> Sentence
S String
"same throughout its", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
vol, Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpTPCAV) Sentence -> Sentence -> Sentence
`S.andThe`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"fully mixed" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpCWTAT),
  String -> Sentence
S String
"There is no", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
htFlux, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_, String -> Sentence
S String
"from the" Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
getAcc CI
phsChgMtrl,
  String -> Sentence
S String
"Assuming no volumetric", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
heat, String -> Sentence
S String
"generation per unit", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
vol,
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpNIHGBWP) Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
volHtGen forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the equation for", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
rocTempSimp, String -> Sentence
S String
"can be written as"]

eBalanceOnPCMDerivDesc2 :: Sentence
eBalanceOnPCMDerivDesc2 :: Sentence
eBalanceOnPCMDerivDesc2 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Using", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
htFluxPCMFromWater Sentence -> Sentence -> Sentence
`S.for`
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"this", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"can be written as"]

eBalanceOnPCMDerivDesc3 :: Sentence
eBalanceOnPCMDerivDesc3 :: Sentence
eBalanceOnPCMDerivDesc3 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Dividing by", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
pcmMass, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
htCapSP, String -> Sentence
S String
"we obtain"]

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

eBalanceOnPCMDerivDesc5 :: Sentence
eBalanceOnPCMDerivDesc5 :: Sentence
eBalanceOnPCMDerivDesc5 = [Sentence] -> Sentence
foldlSent [
  Int -> Sentence
eqN Int
4, String -> Sentence
S String
"applies for the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
solid Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
getAcc CI
phsChgMtrl, String -> Sentence
S String
"In the case where all of the",
  CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"melted" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the same derivation applies" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"except that",
  UncertQ
htCapSP forall {c} {c}.
(HasUID c, HasUID c, HasSymbol c, HasSymbol c) =>
c -> c -> Sentence
`isReplacedBy` UncertQ
htCapLP Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and thus" Sentence -> Sentence -> Sentence
+:+. (UnitalChunk
tauSP forall {c} {c}.
(HasUID c, HasUID c, HasSymbol c, HasSymbol c) =>
c -> c -> Sentence
`isReplacedBy` UnitalChunk
tauLP),
  String -> Sentence
S String
"Although a small change in", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
surArea, String -> Sentence
S String
"would be expected with", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"this is not included" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
vol, String -> Sentence
S String
"change of the", CI -> Sentence
getAcc CI
phsChgMtrl,
  String -> Sentence
S String
"with", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting, String -> Sentence
S String
"is assumed to be negligible", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpVCMPN)]
  where isReplacedBy :: c -> c -> Sentence
isReplacedBy c
a c
b = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch c
a Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"replaced by" Sentence -> Sentence -> Sentence
+:+ forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch c
b

eBalanceOnPCMDerivDesc6 :: Sentence
eBalanceOnPCMDerivDesc6 :: Sentence
eBalanceOnPCMDerivDesc6 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"In the case where", forall t. Express t => t -> Sentence
eS' Relation
eq6_1 Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"not all of the", CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"melted" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the", forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"does not change", String -> Sentence
S String
"Therefore" Sentence -> Sentence -> Sentence
`sC` Sentence
eq6_2]

eBalanceOnPCMDerivDesc7 :: Sentence
eBalanceOnPCMDerivDesc7 :: Sentence
eBalanceOnPCMDerivDesc7 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"This derivation does not consider", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
boiling Sentence -> Sentence -> Sentence
`S.the_ofThe` CI -> Sentence
getAcc CI
phsChgMtrl Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"as the PCM is assumed to either be in a", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
solid, String -> Sentence
S String
"state or a",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
liquid, String -> Sentence
S String
"state", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpNGSP)]

eq6_1 :: Expr
eq6_1 :: Relation
eq6_1 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP
eq6_2 :: Sentence
eq6_2 :: Sentence
eq6_2 = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"d", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempPCM, String -> Sentence
S String
"/ d", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time, String -> Sentence
S String
"= 0"]
{-
eq6_2 :: Expr
eq6_2 = (deriv (sy tempPCM) time) $= 0
-}

---------
-- IM3 --
---------
heatEInWtr :: InstanceModel
heatEInWtr :: InstanceModel
heatEInWtr = ModelKind Relation
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> String
-> [Sentence]
-> InstanceModel
imNoDeriv ModelKind Relation
heatEInWtrMK
  [forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
tempInit, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
wMass, 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
watE) [] [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
koothoor2013]
  String
"heatEInWtr" [Sentence]
htWtrNotes

heatEInWtrMK :: ModelKind Expr
heatEInWtrMK :: ModelKind Relation
heatEInWtrMK = forall e. String -> NP -> QDefinition e -> ModelKind e
equationalModel String
"heatEInWtrIM"
  (String -> NP
nounPhraseSP String
"Heat energy in the water") SimpleQDef
heatEInWtrFD

heatEInWtrFD :: SimpleQDef
heatEInWtrFD :: SimpleQDef
heatEInWtrFD = forall c i e.
(Quantity c, MayHaveUnit c, HasSpace c, Quantity i, HasSpace i) =>
c -> [i] -> e -> QDefinition e
mkFuncDefByQ ConstrConcept
watE [UnitalChunk
time] Relation
htWtrExpr

htWtrExpr :: Expr
htWtrExpr :: Relation
htWtrExpr = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htCapW forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
wMass forall r. ExprC r => r -> r -> r
`mulRe`
  (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time forall r. ExprC r => r -> r -> r
$- forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit)

htWtrNotes :: [Sentence]
htWtrNotes :: [Sentence]
htWtrNotes = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [String -> Sentence
S String
"The above", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is derived using", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
sensHtE],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
change forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`in_`ConceptChunk
temp)) Sentence -> Sentence -> Sentence
`S.isThe` String -> Sentence
S String
"difference between the",
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
temp, String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time, Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
tInitMelt) Sentence -> Sentence -> Sentence
`sC`
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempW Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase UncertQ
tempInit Sentence -> Sentence -> Sentence
`sC` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
tempInit, Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UncertQ
tempInit)],
  [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"applies as long as",
   ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempW (forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
100))) Sentence -> Sentence -> Sentence
:+:
  Maybe UnitDefn -> Sentence
unwrap (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit ConstrConcept
tempW), Sentence -> Sentence
sParen forall a b. (a -> b) -> a -> b
$ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWAL Sentence -> Sentence -> Sentence
`sC` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpAPT]]

---------
-- IM4 --
---------
heatEInPCM :: InstanceModel
heatEInPCM :: InstanceModel
heatEInPCM = ModelKind Relation
-> Inputs
-> Output
-> OutputConstraints
-> [DecRef]
-> String
-> [Sentence]
-> InstanceModel
imNoDeriv (forall e. RelationConcept -> ModelKind e
deModel' RelationConcept
heatEInPCMRC) [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Relation Relation -> Input
qwC UncertQ
tempMeltP forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit)
  , forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
timeFinal, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
tempInit, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmSA, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
pcmHTC
  , forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
pcmMass, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapSP, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htCapLP, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC ConstrConcept
tempPCM, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UncertQ
htFusion, forall q. (Quantity q, MayHaveUnit q) => q -> Input
qwUC UnitalChunk
tInitMelt]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw ConstrConcept
pcmE)
  [] [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
koothoor2013]
  String
"heatEInPCM" [Sentence]
htPCMNotes

heatEInPCMRC :: RelationConcept
heatEInPCMRC :: RelationConcept
heatEInPCMRC = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"heatEInPCMRC" (String -> NP
nounPhraseSP String
"Heat energy in the PCM")
  (ConstrConcept
pcmE forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) Relation
htPCMRel

htPCMRel :: Relation
htPCMRel :: Relation
htPCMRel = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
pcmE forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => [(r, r)] -> r
completeCase [(Relation, Relation)
case1, (Relation, Relation)
case2, (Relation, Relation)
case3]
  where case1 :: (Relation, Relation)
case1 = (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htCapSP forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmMass forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time forall r. ExprC r => r -> r -> r
$-
          forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempInit), forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempPCM (forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP)))

        case2 :: (Relation, Relation)
case2 = (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmInitMltE forall r. ExprC r => r -> r -> r
`addRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htFusion forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmMass) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htCapLP forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmMass forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time forall r. ExprC r => r -> r -> r
$-
          forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP)), forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
tempPCM (forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP)))

        case3 :: (Relation, Relation)
case3 = (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmInitMltE forall r. ExprC r => r -> r -> r
`addRe` forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 UnitalChunk
latentEP UnitalChunk
time,
          forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP forall r. ExprC r => r -> r -> r
$&& forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval DefinedQuantityDict
meltFrac (forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
1)))

htPCMNotes :: [Sentence]
htPCMNotes :: [Sentence]
htPCMNotes = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [String -> Sentence
S String
"The above", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"derived using",
   forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
sensHtE Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
latentHtE],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
pcmE, String -> Sentence
S String
"for the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
solid, forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"is found using",
   forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
sensHtE Sentence -> Sentence -> Sentence
`S.for` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
sensHeat Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"ing, with",
   forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
heatCapSpec forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
solid), forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
`sC` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
htCapSP,
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UncertQ
htCapSP) Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
change Sentence -> Sentence -> Sentence
`S.inThe`
   forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
temp, String -> Sentence
S String
"from the", forall n. NamedIdea n => n -> Sentence
phrase UncertQ
tempInit, Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UncertQ
tempInit)],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
pcmE, String -> Sentence
S String
"for the melted", forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM forall r. ExprC r => r -> r -> r
$> forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmInitMltE)),
   String -> Sentence
S String
"is found using", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
sensHtE Sentence -> Sentence -> Sentence
`S.for` forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
sensHeat forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
liquid),
   forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"plus the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"when", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting, String -> Sentence
S String
"starts" Sentence -> Sentence -> Sentence
`sC`
   String -> Sentence
S String
"plus", (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"required to melt all") Sentence -> Sentence -> Sentence
`S.the_ofThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
energy), String -> Sentence
S String
"required to melt all of the", forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.is`
   ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
htFusion forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pcmMass), Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
pcmInitMltE),
   forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
ddHtFusion],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
change forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`in_` ConceptChunk
temp)) Sentence -> Sentence -> Sentence
`S.is` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
tempPCM forall r. ExprC r => r -> r -> r
$- forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempMeltP),
   Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UncertQ
tempMeltP)],
  [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
pcmE, String -> Sentence
S String
"during", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting Sentence -> Sentence -> Sentence
`S.ofThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl,
   String -> Sentence
S String
"is found using the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"required at", String -> Sentence
S String
"instant" Sentence -> Sentence -> Sentence
+:+
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting Sentence -> Sentence -> Sentence
`S.the_ofThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"begins" Sentence -> Sentence -> Sentence
`sC` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
pcmInitMltE, String -> Sentence
S String
"plus the",
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
latentHeat, forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"added" Sentence -> Sentence -> Sentence
`S.toThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
`sC`
   forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
latentEP, Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
latentEP), String -> Sentence
S String
"since the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time, String -> Sentence
S String
"when",
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
melting, String -> Sentence
S String
"began", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tInitMelt, Sentence -> Sentence
sParen (Maybe UnitDefn -> Sentence
unwrap forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
tInitMelt)],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
heat UnitalChunk
energy)) Sentence -> Sentence -> Sentence
`S.for` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
boiling Sentence -> Sentence -> Sentence
`S.ofThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl,
   String -> Sentence
S String
"is not detailed" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since the", forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"is assumed to either be in a",
   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
solid Sentence -> Sentence -> Sentence
`S.or_` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
liquid, String -> Sentence
S String
"state", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpNGSP),
   Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPIS)]]

-----------
-- 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), SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
  (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [ConceptInstance
waterTempGS, ConceptInstance
pcmTempGS, ConceptInstance
waterEnergyGS, ConceptInstance
pcmEnergyGS]) Sentence -> Sentence -> Sentence
`S.are`
  String -> Sentence
S String
"solved by" Sentence -> Sentence -> Sentence
+:+. SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS
  [InstanceModel
eBalanceOnWtr, InstanceModel
eBalanceOnPCM, InstanceModel
heatEInWtr, InstanceModel
heatEInPCM]), forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the IdeaDict
solution)
  Sentence -> Sentence -> Sentence
`S.for` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr Sentence -> Sentence -> Sentence
`S.and_`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnPCM Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"coupled since the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
solution
  Sentence -> Sentence -> Sentence
`S.for` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempW Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"depend on one another",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
heatEInWtr, String -> Sentence
S String
"can be solved once", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnWtr Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"has been solved", forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the IdeaDict
solution) Sentence -> Sentence -> Sentence
`S.of_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
eBalanceOnPCM Sentence -> Sentence -> Sentence
`S.and_`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
heatEInPCM Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"also coupled" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"since the",
  forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
pcmE,String -> Sentence
S String
"depend on the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
phaseChange]