{-# LANGUAGE PostfixOperators #-}
module Drasil.SglPend.IMods (iMods, angularDisplacementIM) where

import Prelude hiding (cos, sin)

import Language.Drasil
import Theory.Drasil
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import qualified Language.Drasil.NounPhrase.Combinators as NP
import Data.Drasil.Quantities.Physics (gravitationalAccel,
         angularAccel, momentOfInertia,
         time, angularDisplacement, angularFrequency, torque, angularDisplacement, time)
import Data.Drasil.Concepts.Math (constraint, equation, amplitude, iAngle, angle)
import Data.Drasil.Concepts.Physics (pendulum, motion, shm)
import Data.Drasil.Theories.Physics (newtonSLR)
import Drasil.SglPend.GenDefs (angFrequencyGD)

import Drasil.SglPend.Derivations (angularDisplacementDerivEqns)
import Drasil.SglPend.Expressions (angularDisplacementExpr)
import Drasil.SglPend.Unitals (lenRod, pendDisplacementAngle, initialPendAngle)

iMods :: [InstanceModel]
iMods :: [InstanceModel]
iMods = [InstanceModel
angularDisplacementIM]

-- Angular Displacement
angularDisplacementIM :: InstanceModel
angularDisplacementIM :: InstanceModel
angularDisplacementIM = ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs ModelKind Expr
angularDisplacementMK
  [UnitalChunk -> RealInterval Expr Expr -> Input
forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
lenRod (RealInterval Expr Expr -> Input)
-> RealInterval Expr Expr -> Input
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> RealInterval Expr Expr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,UnitalChunk -> RealInterval Expr Expr -> Input
forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
initialPendAngle (RealInterval Expr Expr -> Input)
-> RealInterval Expr Expr -> Input
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> RealInterval Expr Expr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , UnitalChunk -> RealInterval Expr Expr -> Input
forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
gravitationalAccel (RealInterval Expr Expr -> Input)
-> RealInterval Expr Expr -> Input
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> RealInterval Expr Expr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (UnitalChunk -> Output
forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw UnitalChunk
pendDisplacementAngle) [(Inclusive, Expr) -> RealInterval Expr Expr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
angularDisplacementDeriv) String
"calOfAngularDisplacement" [Sentence
angularDispConstraintNote]

angularDisplacementMK :: ModelKind Expr
angularDisplacementMK :: ModelKind Expr
angularDisplacementMK = String -> NP -> QDefinition Expr -> ModelKind Expr
forall e. String -> NP -> QDefinition e -> ModelKind e
equationalModel String
"angularDisplacementIM"
  (String -> NP
nounPhraseSP String
"calculation of angular displacement") QDefinition Expr
angularDisplacementFD

angularDisplacementFD :: SimpleQDef
angularDisplacementFD :: QDefinition Expr
angularDisplacementFD = UnitalChunk -> [UnitalChunk] -> Expr -> QDefinition Expr
forall c i e.
(Quantity c, MayHaveUnit c, HasSpace c, Quantity i, HasSpace i) =>
c -> [i] -> e -> QDefinition e
mkFuncDefByQ UnitalChunk
pendDisplacementAngle
  [UnitalChunk
time] Expr
angularDisplacementExpr

angularDisplacementDeriv :: Derivation
angularDisplacementDeriv :: Derivation
angularDisplacementDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
angularDisplacement) ([[Sentence]] -> [Sentence]
forall a. [[a]] -> [a]
weave [[Sentence]
angularDisplacementDerivSents, (ModelExpr -> Sentence) -> [ModelExpr] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
angularDisplacementDerivEqns])

angularDisplacementDerivSents :: [Sentence]
angularDisplacementDerivSents :: [Sentence]
angularDisplacementDerivSents = [Sentence
angularDisplacementDerivSent1, Sentence
angularDisplacementDerivSent2, Sentence
angularDisplacementDerivSent3,
                             Sentence
angularDisplacementDerivSent4, Sentence
angularDisplacementDerivSent5]

angularDisplacementDerivSent1, angularDisplacementDerivSent2, angularDisplacementDerivSent3,
  angularDisplacementDerivSent4, angularDisplacementDerivSent5 :: Sentence
angularDisplacementDerivSent1 :: Sentence
angularDisplacementDerivSent1 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"When", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"displaced to an", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
iAngle Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"released" Sentence -> Sentence -> Sentence
`sC`
                                       NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum), String -> Sentence
S String
"swings back and forth with periodic" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion,
                                       String -> Sentence
S String
"By applying", TheoryModel -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef TheoryModel
newtonSLR (TheoryModel -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase TheoryModel
newtonSLR) Sentence -> Sentence -> Sentence
`sC`
                                       NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
motion) NP -> NP -> NP
`NP.for` ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum), String -> Sentence
S String
"may be obtained"]
angularDisplacementDerivSent2 :: Sentence
angularDisplacementDerivSent2 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Where", UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
torque Sentence -> Sentence -> Sentence
`S.denotes` UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
torque Sentence -> Sentence -> Sentence
`sC`
                                    UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
momentOfInertia Sentence -> Sentence -> Sentence
`S.denotes` UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momentOfInertia Sentence -> Sentence -> Sentence
`S.and_` UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
angularAccel Sentence -> Sentence -> Sentence
`S.denotes`
                                    (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
angularAccel !.), String -> Sentence
S String
"This implies"]
angularDisplacementDerivSent3 :: Sentence
angularDisplacementDerivSent3 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"And rearranged as" ]
angularDisplacementDerivSent4 :: Sentence
angularDisplacementDerivSent4 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"If", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
amplitude ConceptChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
angularDisplacement)), String -> Sentence
S String
"is small enough" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"we can approximate", ModelExpr -> Sentence
eS (ModelExpr -> ModelExpr
forall r. ExprC r => r -> r
sin (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisplacementAngle) ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisplacementAngle), String -> Sentence
S String
"for the purpose of a simple", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
pendulum,
  String -> Sentence
S String
"at very small" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
angle,
  String -> Sentence
S String
"Then", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
motion)), String -> Sentence
S String
"reduces to", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
shm))]                                       
angularDisplacementDerivSent5 :: Sentence
angularDisplacementDerivSent5 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Thus the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
shm, String -> Sentence
S String
"is" ]

angularDispConstraintNote :: Sentence
angularDispConstraintNote :: Sentence
angularDispConstraintNote = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint),
     ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
initialPendAngle ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$> Integer -> ModelExpr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.is` (String -> Sentence
S String
"required" !.),
     NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
angularFrequency) Sentence -> Sentence -> Sentence
`S.is` GenDefn -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' GenDefn
angFrequencyGD]