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

import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.Quantities.Physics (time)
import Drasil.PDController.Assumptions
import Drasil.PDController.Concepts
import Drasil.PDController.References
import Language.Drasil
import qualified Language.Drasil as DrasilLang
import Theory.Drasil (TheoryModel, tm, othModel')
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Drasil.Citations(laplaceWiki)
import Drasil.PDController.Unitals
import Data.Drasil.Quantities.Math (posInf, negInf)

theoreticalModels :: [TheoryModel]
theoreticalModels :: [TheoryModel]
theoreticalModels = [TheoryModel
tmLaplace, TheoryModel
tmInvLaplace, TheoryModel
tmSOSystem]

tmLaplace :: TheoryModel
tmLaplace :: TheoryModel
tmLaplace
  = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
tm (RelationConcept -> ModelKind ModelExpr
forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
laplaceRC)
      [QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdLaplaceTransform, QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdFreqDomain, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
time, DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
posInf,
       QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdFxnTDomain]
      ([] :: [ConceptChunk])
      []
      [Relation -> ModelExpr
forall c. Express c => c -> ModelExpr
express Relation
laplaceRel]
      []
      [Citation -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
laplaceWiki]
      String
"laplaceTransform"
      [Sentence
laplaceDesc]

laplaceRC :: RelationConcept
laplaceRC :: RelationConcept
laplaceRC = String -> NP -> Sentence -> Relation -> RelationConcept
forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"laplaceRC" (String -> NP
cn' String
"Laplace Transform") Sentence
EmptyS Relation
laplaceRel

laplaceRel :: Relation
laplaceRel :: Relation
laplaceRel
  = QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdLaplaceTransform Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$=
      Symbol -> Relation -> Relation -> Relation -> Relation
forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
negInf) (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
posInf) (QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFxnTDomain 
      Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$* Relation -> Relation
forall r. ExprC r => r -> r
DrasilLang.exp (Relation -> Relation
forall r. ExprC r => r -> r
neg (QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain) Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$* UnitalChunk -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time))

laplaceDesc :: Sentence
laplaceDesc :: Sentence
laplaceDesc
  = [Sentence] -> Sentence
foldlSent
      [(String -> Sentence
S String
"Bilateral Laplace Transform" !.),
       NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP ((ConceptChunk -> Sentence) -> ConceptChunk -> NP
forall t. (t -> Sentence) -> t -> NP
theGen ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
ccLaplaceTransform),
         String -> Sentence
S String
"are typically inferred from a pre-computed table of", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' ConceptChunk
ccLaplaceTransform,
         Sentence -> Sentence
sParen (Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
laplaceWiki)]

--------

tmInvLaplace :: TheoryModel
tmInvLaplace :: TheoryModel
tmInvLaplace
  = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
tm (RelationConcept -> ModelKind ModelExpr
forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
invlaplaceRC)
      [QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdLaplaceTransform, QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdFreqDomain, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
time, DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
posInf,
       QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdFxnTDomain]
      ([] :: [ConceptChunk])
      []
      [Relation -> ModelExpr
forall c. Express c => c -> ModelExpr
express Relation
invLaplaceRel]
      []
      [Citation -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
laplaceWiki]
      String
"invLaplaceTransform"
      [Sentence
invLaplaceDesc]

invlaplaceRC :: RelationConcept
invlaplaceRC :: RelationConcept
invlaplaceRC
  = String -> NP -> Sentence -> Relation -> RelationConcept
forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"invLaplaceRC" (String -> NP
cn' String
"Inverse Laplace Transform") Sentence
EmptyS Relation
invLaplaceRel

invLaplaceRel :: Relation
invLaplaceRel :: Relation
invLaplaceRel = QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFxnTDomain Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$= QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdInvLaplaceTransform

invLaplaceDesc :: Sentence
invLaplaceDesc :: Sentence
invLaplaceDesc
  = [Sentence] -> Sentence
foldlSent
      [(String -> Sentence
S String
"Inverse Laplace Transform of F(S)" !.),
       String -> Sentence
S String
"The Inverse Laplace transforms are",
         String -> Sentence
S String
"typically inferred from a pre-computed table" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"Laplace Transforms",
         Sentence -> Sentence
sParen (Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
laplaceWiki)]

--------

tmSOSystem :: TheoryModel
tmSOSystem :: TheoryModel
tmSOSystem
  = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
tm (RelationConcept -> ModelKind ModelExpr
forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
tmSOSystemRC)
      [UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass, QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdDampingCoeff, QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdStiffnessCoeff, QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
qdFreqDomain]
      ([] :: [ConceptChunk])
      []
      [Relation -> ModelExpr
forall c. Express c => c -> ModelExpr
express Relation
soSystemRel]
      []
      [Citation -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
abbasi2015]
      String
"tmSOSystem"
      [Sentence
soSystemDesc]

tmSOSystemRC :: RelationConcept
tmSOSystemRC :: RelationConcept
tmSOSystemRC
  = String -> NP -> Sentence -> Relation -> RelationConcept
forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"tmSOSystemRC" (String -> NP
cn' String
"Second Order Mass-Spring-Damper System") Sentence
EmptyS
      Relation
soSystemRel

soSystemRel :: Relation
soSystemRel :: Relation
soSystemRel
  = Integer -> Relation
forall r. LiteralC r => Integer -> r
exactDbl Integer
1 
    Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$/ (UnitalChunk -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$* Relation -> Relation
forall r. (ExprC r, LiteralC r) => r -> r
square (QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain) 
    Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$+ (QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdDampingCoeff Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$* QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain)
    Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$+ QuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdStiffnessCoeff)

soSystemDesc :: Sentence
soSystemDesc :: Sentence
soSystemDesc
  = [Sentence] -> Sentence
foldlSent
      [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
ccTransferFxn), 
        ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
apwrPlantTxFnx
        Sentence -> Sentence -> Sentence
`S.ofA` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
secondOrderSystem,
        Sentence -> Sentence
sParen (String -> Sentence
S String
"mass-spring-damper"), 
        String -> Sentence
S String
"is characterized by this equation"]