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

import Control.Lens ((^.))

import Language.Drasil
import qualified Language.Drasil as DrasilLang
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Development as D
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Citations(laplaceWiki)
import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.Quantities.Physics (time)
import Data.Drasil.Quantities.Math (posInf, negInf)

import Theory.Drasil (TheoryModel, tm, othModel')

import Drasil.PDController.Assumptions
import Drasil.PDController.Concepts
import Drasil.PDController.References
import Drasil.PDController.Unitals

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

tmLaplace :: TheoryModel
tmLaplace :: TheoryModel
tmLaplace
  = ModelKind ModelExpr
-> [DefinedQuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept 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)
      ([] :: [DefinedQuantityDict])
      ([] :: [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
  = DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdLaplaceTransform 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) (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdFxnTDomain
      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 (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdFreqDomain) 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" !.),
       NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
atStartNP ((ConceptChunk -> NPStruct) -> ConceptChunk -> NP
forall t. (t -> NPStruct) -> t -> NP
theGen (\ ConceptChunk
x -> NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
atStartNP' (ConceptChunk
x ConceptChunk -> Getting NP ConceptChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP ConceptChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' ConceptChunk NP
term)) 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
-> [DefinedQuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept 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)
      ([] :: [DefinedQuantityDict])
      ([] :: [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 = DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdFxnTDomain Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$= DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdInvLaplaceTransform

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
-> [DefinedQuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> [DecRef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept 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)
      ([] :: [DefinedQuantityDict])
      ([] :: [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 (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdFreqDomain)
    Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$+ (DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdDampingCoeff Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$* DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdFreqDomain)
    Relation -> Relation -> Relation
forall r. ExprC r => r -> r -> r
$+ DefinedQuantityDict -> Relation
forall c. (HasUID c, HasSymbol c) => c -> Relation
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
dqdStiffnessCoeff)

soSystemDesc :: Sentence
soSystemDesc :: Sentence
soSystemDesc
  = [Sentence] -> Sentence
foldlSent
      [NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
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"]