module Drasil.SWHS.Assumptions where --all of this file is exported

import Language.Drasil
import Control.Lens ((^.))
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (system, simulation, model, 
  problem, assumpDom)

import Data.Drasil.Quantities.PhysicalProperties (vol)
import Data.Drasil.Quantities.Physics (energy, time)
import Data.Drasil.Quantities.Thermodynamics (boilPt, meltPt, temp)

import Data.Drasil.Concepts.Thermodynamics as CT (heat, melting,
  lawConvCooling, heatTrans, thermalEnergy)
import Data.Drasil.Concepts.PhysicalProperties (solid, liquid, gaseous)
import Data.Drasil.Concepts.Math (change)
import Data.Drasil.Concepts.Physics (mechEnergy)

import Drasil.SWHS.Concepts (coil, tank, phsChgMtrl, water, perfectInsul,
  charging, discharging)
import Drasil.SWHS.Unitals (wVol, volHtGen, tempC, tempInit, tempW,
  tempPCM, htCapLP, htCapW, htCapSP, wDensity, pcmDensity, pcmVol)

-------------------------
-- 4.2.1 : Assumptions --
-------------------------

assumptions :: [ConceptInstance]
assumptions :: [ConceptInstance]
assumptions = [ConceptInstance
assumpTEO, ConceptInstance
assumpHTCC, ConceptInstance
assumpCWTAT, ConceptInstance
assumpTPCAV, ConceptInstance
assumpDWPCoV, ConceptInstance
assumpSHECoV,
  ConceptInstance
assumpLCCCW, ConceptInstance
assumpTHCCoT, ConceptInstance
assumpTHCCoL, ConceptInstance
assumpLCCWP, ConceptInstance
assumpCTNOD, ConceptInstance
assumpSITWP,
  ConceptInstance
assumpPIS, ConceptInstance
assumpWAL, ConceptInstance
assumpPIT, ConceptInstance
assumpNIHGBWP, ConceptInstance
assumpVCMPN, ConceptInstance
assumpNGSP,
  ConceptInstance
assumpAPT, ConceptInstance
assumpVCN]

assumpTEO, assumpHTCC, assumpCWTAT, assumpTPCAV, assumpDWPCoV, assumpSHECoV,
  assumpLCCCW, assumpTHCCoT, assumpTHCCoL, assumpLCCWP, assumpCTNOD, assumpSITWP,
  assumpPIS, assumpWAL, assumpPIT, assumpNIHGBWP, assumpVCMPN, assumpNGSP,
  assumpAPT, assumpVCN :: ConceptInstance

assumpTEO :: ConceptInstance
assumpTEO = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpTEO"                  Sentence
assumpS1                   String
"Thermal-Energy-Only"                       ConceptChunk
assumpDom
assumpHTCC :: ConceptInstance
assumpHTCC = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpHTCC"                Sentence
assumpS2                   String
"Heat-Transfer-Coeffs-Constant"             ConceptChunk
assumpDom
assumpCWTAT :: ConceptInstance
assumpCWTAT = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpCWTAT"              Sentence
assumpS3                   String
"Constant-Water-Temp-Across-Tank"           ConceptChunk
assumpDom
assumpTPCAV :: ConceptInstance
assumpTPCAV = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpTPCAV"              Sentence
assumpS4                   String
"Temp-PCM-Constant-Across-Volume"           ConceptChunk
assumpDom
assumpDWPCoV :: ConceptInstance
assumpDWPCoV = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpDWPCoV"            Sentence
assumpS5                   String
"Density-Water-PCM-Constant-over-Volume"    ConceptChunk
assumpDom
assumpSHECoV :: ConceptInstance
assumpSHECoV = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSHECov"            Sentence
assumpS6                   String
"Specific-Heat-Energy-Constant-over-Volume" ConceptChunk
assumpDom
assumpLCCCW :: ConceptInstance
assumpLCCCW = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpLCCCW"              Sentence
assumpS7                   String
"Newton-Law-Convective-Cooling-Coil-Water"  ConceptChunk
assumpDom
assumpTHCCoT :: ConceptInstance
assumpTHCCoT = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpTHCCoT"            Sentence
assumpS8                   String
"Temp-Heating-Coil-Constant-over-Time"      ConceptChunk
assumpDom
assumpTHCCoL :: ConceptInstance
assumpTHCCoL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpTHCCoL"            Sentence
assumpS9                   String
"Temp-Heating-Coil-Constant-over-Length"    ConceptChunk
assumpDom
assumpLCCWP :: ConceptInstance
assumpLCCWP = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpLCCWP"              Sentence
assumpS10                  String
"Law-Convective-Cooling-Water-PCM"          ConceptChunk
assumpDom
assumpCTNOD :: ConceptInstance
assumpCTNOD = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpCTNOD"              Sentence
assumpS11                  String
"Charging-Tank-No-Temp-Discharge"           ConceptChunk
assumpDom
assumpSITWP :: ConceptInstance
assumpSITWP = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSITWP"              Sentence
assumpS12                  String
"Same-Initial-Temp-Water-PCM"               ConceptChunk
assumpDom
assumpPIS :: ConceptInstance
assumpPIS = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpPIS"                  Sentence
assumpS13                  String
"PCM-Initially-Solid"                       ConceptChunk
assumpDom
assumpWAL :: ConceptInstance
assumpWAL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpWAL"                  (Sentence -> Sentence
assumpS14 forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water) String
"Water-Always-Liquid"                       ConceptChunk
assumpDom
assumpPIT :: ConceptInstance
assumpPIT = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpPIT"                  Sentence
assumpS15                  String
"Perfect-Insulation-Tank"                   ConceptChunk
assumpDom
assumpNIHGBWP :: ConceptInstance
assumpNIHGBWP = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpNIHGBWP"          Sentence
assumpS16                  String
"No-Internal-Heat-Generation-By-Water-PCM"  ConceptChunk
assumpDom
assumpVCMPN :: ConceptInstance
assumpVCMPN = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpVCMPN"              Sentence
assumpS17                  String
"Volume-Change-Melting-PCM-Negligible"      ConceptChunk
assumpDom
assumpNGSP :: ConceptInstance
assumpNGSP = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpNGSP"                Sentence
assumpS18                  String
"No-Gaseous-State-PCM"                      ConceptChunk
assumpDom
assumpAPT :: ConceptInstance
assumpAPT = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpAPT"                  Sentence
assumpS19                  String
"Atmospheric-Pressure-Tank"                 ConceptChunk
assumpDom
assumpVCN :: ConceptInstance
assumpVCN = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpVCN"                  Sentence
assumpS20                  String
"Volume-Coil-Negligible"                    ConceptChunk
assumpDom

assumpS1, assumpS2, assumpS3, assumpS4, assumpS5, assumpS6, assumpS7,
  assumpS8, assumpS9, assumpS10, assumpS11, assumpS12, assumpS13,
  assumpS15, assumpS16, assumpS17, assumpS18, assumpS19, assumpS20 :: Sentence

assumpS14 :: Sentence -> Sentence

assumpS1 :: Sentence
assumpS1 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The only form" Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, String -> Sentence
S String
"that" Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"relevant for this" Sentence -> Sentence -> Sentence
+:+. (forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
problem Sentence -> Sentence -> Sentence
`S.is` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.thermalEnergy),
  String -> Sentence
S String
"All other forms" Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"such as",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
mechEnergy Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"are assumed to be negligible"]
assumpS2 :: Sentence
assumpS2 = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"All", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.heatTrans, String -> Sentence
S String
"coefficients" Sentence -> Sentence -> Sentence
`S.are`
                      String -> Sentence
S String
"constant over", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time]
assumpS3 :: Sentence
assumpS3 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
water forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
tank)),
  String -> Sentence
S String
"is fully mixed, so the", forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
tempW Sentence -> Sentence -> Sentence
`S.isThe` 
  String -> Sentence
S String
"same throughout the entire", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank]
assumpS4 :: Sentence
assumpS4 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConstrConcept
tempPCM) Sentence -> Sentence -> Sentence
`S.isThe` String -> Sentence
S String
"same throughout the", forall n. NamedIdea n => n -> Sentence
phrase UncertQ
pcmVol]
  --FIXME `sC` makeRefS likeChg1]
assumpS5 :: Sentence
assumpS5 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (UncertQ
wDensity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UncertQ
pcmDensity)),
  String -> Sentence
S String
"have no spatial variation; that is" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"they are each constant over their entire", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
vol]
assumpS6 :: Sentence
assumpS6 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [forall n. NamedIdea n => n -> Sentence
phrase UncertQ
htCapW, forall n. NamedIdea n => n -> Sentence
phrase UncertQ
htCapSP,
  forall n. NamedIdea n => n -> Sentence
phrase UncertQ
htCapLP], String -> Sentence
S String
"have no spatial variation; that",
  String -> Sentence
S String
"is" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"they are each constant over their entire",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
vol]
assumpS7 :: Sentence
assumpS7 = [Sentence] -> Sentence
foldlSent [
  ConceptChunk
CT.lawConvCooling forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn, String -> Sentence
S String
"applies between the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
coil Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water]
assumpS8 :: Sentence
assumpS8 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UncertQ
tempC) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"constant over", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time]
assumpS9 :: Sentence
assumpS9 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UncertQ
tempC), String -> Sentence
S String
"does not vary along its length"]
assumpS10 :: Sentence
assumpS10 = [Sentence] -> Sentence
foldlSent [
  ConceptChunk
CT.lawConvCooling forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn, String -> Sentence
S String
"applies between the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water Sentence -> Sentence -> Sentence
`S.andThe` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl]
assumpS11 :: Sentence
assumpS11 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
model), String -> Sentence
S String
"only accounts for", (ConceptChunk
charging forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"not" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
discharging, forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConstrConcept
tempW forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
  ConstrConcept
tempPCM)), String -> Sentence
S String
"can only increase, or remain",
  String -> Sentence
S String
"constant; they do not decrease. This implies that the",
  forall n. NamedIdea n => n -> Sentence
phrase UncertQ
tempInit, forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSITWP, String -> Sentence
S String
"is less than (or equal)"
  Sentence -> Sentence -> Sentence
`S.toThe` forall n. NamedIdea n => n -> Sentence
phrase UncertQ
tempC]
assumpS12 :: Sentence
assumpS12 = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (UncertQ
tempInit forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
water) Sentence -> Sentence -> Sentence
`S.andThe`
  forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.isThe` String -> Sentence
S String
"same"]
assumpS13 :: Sentence
assumpS13 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
simulation), String -> Sentence
S String
"will start with the",
  forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"in a", ConceptChunk
solid forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn]
assumpS14 :: Sentence -> Sentence
assumpS14 Sentence
mat = [Sentence] -> Sentence
foldlSent [
  (String -> Sentence
S String
"operating" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
temp Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"range") Sentence -> Sentence -> Sentence
`S.the_ofTheC` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system,
  String -> Sentence
S String
"is such that the", Sentence
mat,
  String -> Sentence
S String
"is always in" Sentence -> Sentence -> Sentence
+:+. (ConceptChunk
liquid forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn), String -> Sentence
S String
"That is" Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
temp), String -> Sentence
S String
"will not drop below the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
meltPt forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
water) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"or rise above its",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
boilPt]
assumpS15 :: Sentence
assumpS15 = [Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
tank forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`is` ConceptChunk
perfectInsul)),
  String -> Sentence
S String
"so that there is no", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.heat, String -> Sentence
S String
"loss from the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank]
assumpS16 :: Sentence
assumpS16 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"No internal", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.heat, String -> Sentence
S String
"is generated by either the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
water Sentence -> Sentence -> Sentence
`S.or_` String -> Sentence
S String
"the", forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
:+:
  String -> Sentence
S String
"; therefore" Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
volHtGen), String -> Sentence
S String
"is zero"]
assumpS17 :: Sentence
assumpS17 = [Sentence] -> Sentence
foldlSent [
  (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
vol Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
change) Sentence -> Sentence -> Sentence
`S.the_ofTheC` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl,
  String -> Sentence
S String
"due to", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.melting, String -> Sentence
S String
"is negligible"]
assumpS18 :: Sentence
assumpS18 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The", forall c. Idea c => c -> Sentence
short CI
phsChgMtrl Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"either in a", ConceptChunk
liquid forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn,
  String -> Sentence
S String
"or a", ConceptChunk
solid forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn, String -> Sentence
S String
"but not a", ConceptChunk
gaseous forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn]
assumpS19 :: Sentence
assumpS19 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The pressure in the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank, String -> Sentence
S String
"is atmospheric" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
meltPt forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
boilPt) Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S (forall a. Show a => a -> String
show (Integer
0 :: Integer)) Sentence -> Sentence -> Sentence
:+:
  USymb -> Sentence
Sy (forall c. Unitary c => c -> USymb
unit_symb UnitalChunk
temp) Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S (forall a. Show a => a -> String
show (Integer
100 :: Integer)) Sentence -> Sentence -> Sentence
:+:
  USymb -> Sentence
Sy (forall c. Unitary c => c -> USymb
unit_symb UnitalChunk
temp) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"respectively"]
assumpS20 :: Sentence
assumpS20 = [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"When considering the", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
wVol forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
tank)
  Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
vol forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
coil),
  String -> Sentence
S String
"is assumed to be negligible"]
  --FIXME , sSqBr $ makeRefS req2]

--- Again, list structure is same between all examples.
-- Can booktabs colored links be used? The box links completely cover nearby
-- punctuation.