{-# 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
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
lenRod forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
initialPendAngle forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
gravitationalAccel forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw UnitalChunk
pendDisplacementAngle) [forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall a. a -> Maybe a
Just Derivation
angularDisplacementDeriv) String
"calOfAngularDisplacement" [Sentence
angularDispConstraintNote]

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

angularDisplacementFD :: SimpleQDef
angularDisplacementFD :: SimpleQDef
angularDisplacementFD = 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 (forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
angularDisplacement) (forall a. [[a]] -> [a]
weave [[Sentence]
angularDisplacementDerivSents, 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", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"displaced to an", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
iAngle Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"released" Sentence -> Sentence -> Sentence
`sC`
                                       forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum), String -> Sentence
S String
"swings back and forth with periodic" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion,
                                       String -> Sentence
S String
"By applying", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef TheoryModel
newtonSLR (forall n. NamedIdea n => n -> Sentence
phrase TheoryModel
newtonSLR) Sentence -> Sentence -> Sentence
`sC`
                                       forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
motion) NP -> NP -> NP
`NP.for` 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", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
torque Sentence -> Sentence -> Sentence
`S.denotes` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
torque Sentence -> Sentence -> Sentence
`sC`
                                    forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
momentOfInertia Sentence -> Sentence -> Sentence
`S.denotes` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momentOfInertia Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
angularAccel Sentence -> Sentence -> Sentence
`S.denotes`
                                    (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", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
amplitude 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 (forall r. ExprC r => r -> r
sin (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisplacementAngle) forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisplacementAngle), String -> Sentence
S String
"for the purpose of a simple", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
pendulum,
  String -> Sentence
S String
"at very small" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
angle,
  String -> Sentence
S String
"Then", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
motion)), String -> Sentence
S String
"reduces to", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation 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", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
shm, String -> Sentence
S String
"is" ]

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