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

laplaceRC :: RelationConcept
laplaceRC :: RelationConcept
laplaceRC = 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
  = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdLaplaceTransform forall r. ExprC r => r -> r -> r
$=
      forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
negInf) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
posInf) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFxnTDomain 
      forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
DrasilLang.exp (forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain) forall r. ExprC r => r -> r -> r
`mulRe` 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" !.),
       forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. (t -> Sentence) -> t -> NP
theGen forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
ccLaplaceTransform),
         String -> Sentence
S String
"are typically inferred from a pre-computed table of", forall n. NamedIdea n => n -> Sentence
titleize' ConceptChunk
ccLaplaceTransform,
         Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
laplaceWiki)]

--------

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

invlaplaceRC :: RelationConcept
invlaplaceRC :: RelationConcept
invlaplaceRC
  = 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 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFxnTDomain forall r. ExprC r => r -> r -> r
$= 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 of Laplace Transforms",
         Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
laplaceWiki)]

--------

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

tmSOSystemRC :: RelationConcept
tmSOSystemRC :: RelationConcept
tmSOSystemRC
  = 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
  = forall r. LiteralC r => Integer -> r
exactDbl Integer
1 
    forall r. ExprC r => r -> r -> r
$/ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass forall r. ExprC r => r -> r -> r
`mulRe` forall r. (ExprC r, LiteralC r) => r -> r
square (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain) 
    forall r. ExprC r => r -> r -> r
`addRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdDampingCoeff forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdFreqDomain)
    forall r. ExprC r => r -> r -> r
`addRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
qdStiffnessCoeff)

soSystemDesc :: Sentence
soSystemDesc :: Sentence
soSystemDesc
  = [Sentence] -> Sentence
foldlSent
      [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
ccTransferFxn), 
        forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
apwrPlantTxFnx
        Sentence -> Sentence -> Sentence
`S.ofA` 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"]