{-# LANGUAGE PostfixOperators #-}
module Drasil.PDController.GenDefs where

import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.Concepts.Math (equation)
import Drasil.PDController.Assumptions
import Drasil.PDController.Concepts
import Drasil.PDController.References
import Drasil.PDController.TModel
import Language.Drasil
import Theory.Drasil (GenDefn, gd, othModel')
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Drasil.Citations ( pidWiki )
import Drasil.PDController.Unitals

genDefns :: [GenDefn]
genDefns :: [GenDefn]
genDefns = [GenDefn
gdPowerPlant]

----------------------------------------------

gdPowerPlant :: GenDefn
gdPowerPlant :: GenDefn
gdPowerPlant
  = ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (RelationConcept -> ModelKind ModelExpr
forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
gdPowerPlantRC) (Maybe UnitDefn
forall a. Maybe a
Nothing :: Maybe UnitDefn) Maybe Derivation
forall a. Maybe a
Nothing
      [Citation -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
pidWiki, Citation -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
abbasi2015]
      String
"gdPowerPlant"
      [Sentence
gdPowerPlantNote]

gdPowerPlantRC :: RelationConcept
gdPowerPlantRC :: RelationConcept
gdPowerPlantRC
  = String -> NP -> Sentence -> Expr -> RelationConcept
forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"gdPowerPlantRC"
      (ConceptChunk
ccTransferFxn ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
powerPlant)
      Sentence
EmptyS
      Expr
gdPowerPlantEqn

gdPowerPlantEqn :: Expr
gdPowerPlantEqn :: Expr
gdPowerPlantEqn
  = Expr -> Expr
forall r. (ExprC r, LiteralC r) => r -> r
recip_ (Expr -> Expr
forall r. (ExprC r, LiteralC r) => r -> r
square (QuantityDict -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain) Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$+ QuantityDict -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$+ Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
20)

gdPowerPlantNote :: Sentence
gdPowerPlantNote :: Sentence
gdPowerPlantNote
  = [Sentence] -> Sentence
foldlSent
      [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk
ccTransferFxn ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
secondOrderSystem),
         TheoryModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource TheoryModel
tmSOSystem,
         String -> Sentence
S String
"is reduced to this equation by substituting the",
         UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
mass, String -> Sentence
S String
"(m) to 1 Kg", ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
aMass Sentence -> Sentence -> Sentence
`sC`
         NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
ccDampingCoeff), Sentence -> Sentence
sParen (Symbol -> Sentence
P Symbol
symDampingCoeff),
         String -> Sentence
S String
"to 1", ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
aDampingCoeff Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS
         Sentence -> Sentence -> Sentence
`S.andThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
ccStiffCoeff, Sentence -> Sentence
sParen (Symbol -> Sentence
P Symbol
symStifnessCoeff),
         String -> Sentence
S String
"to 20" Sentence -> Sentence -> Sentence
+:+. ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
aStiffnessCoeff,
       NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
equation) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"converted" Sentence -> Sentence -> Sentence
`S.toThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
ccFrequencyDomain,
         String -> Sentence
S String
"by applying the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
ccLaplaceTransform Sentence -> Sentence -> Sentence
+:+. TheoryModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource TheoryModel
tmLaplace,
       String -> Sentence
S String
"Additionally, there" Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"no external disturbances" Sentence -> Sentence -> Sentence
`S.toThe` String -> Sentence
S String
"power plant",
         ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
aExtDisturb]