module Drasil.SglPend.DataDefs (dataDefs, positionIY, positionIX, angFrequencyDD,
         frequencyDD, periodSHMDD) where

import Prelude hiding (sin, cos, sqrt)
import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Drasil.SI_Units (second)
import Theory.Drasil (DataDefinition, ddENoRefs)
import Drasil.SglPend.Figures (figMotion)
import qualified Data.Drasil.Quantities.Physics as QP (ixPos, iyPos,
      frequency, period, angularFrequency)
import Drasil.SglPend.Unitals (lenRod, initialPendAngle)
--import Data.Drasil.Concepts.Physics (pendulum)
import qualified Data.Drasil.Quantities.Math as QM (pi_)
import Drasil.DblPend.Concepts (horizontalPos, verticalPos)


dataDefs :: [DataDefinition]
dataDefs :: [DataDefinition]
dataDefs = [DataDefinition
positionIX, DataDefinition
positionIY, DataDefinition
frequencyDD, DataDefinition
angFrequencyDD, DataDefinition
periodSHMDD]


------------------------------------------------------
positionIX :: DataDefinition
positionIX :: DataDefinition
positionIX = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionIXQD forall a. Maybe a
Nothing String
"positionIX" [Sentence
positionRef, Sentence
figRef]

positionIXQD :: SimpleQDef
positionIXQD :: SimpleQDef
positionIXQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
QP.ixPos Expr
positionIXEqn

positionIXEqn :: Expr
positionIXEqn :: Expr
positionIXEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
initialPendAngle)

figRef :: Sentence
figRef :: Sentence
figRef = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.ixPos Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionRef :: Sentence
positionRef :: Sentence
positionRef = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.ixPos Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalPos

------------------------------------------------------
positionIY :: DataDefinition
positionIY :: DataDefinition
positionIY = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionIYQD forall a. Maybe a
Nothing String
"positionIY" [Sentence
positionReff, Sentence
figReff]

positionIYQD :: SimpleQDef
positionIYQD :: SimpleQDef
positionIYQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
QP.iyPos Expr
positionIYEqn

positionIYEqn :: Expr
positionIYEqn :: Expr
positionIYEqn = forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
cos (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
initialPendAngle))

figReff :: Sentence
figReff :: Sentence
figReff = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.iyPos Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionReff :: Sentence
positionReff :: Sentence
positionReff = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.iyPos Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalPos

------------------------------------------------------

frequencyDD :: DataDefinition
frequencyDD :: DataDefinition
frequencyDD = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
frequencyDDQD forall a. Maybe a
Nothing String
"frequencyDD" [Sentence
frequencyRef]

frequencyDDQD :: SimpleQDef
frequencyDDQD :: SimpleQDef
frequencyDDQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
QP.frequency Expr
frequencyDDEqn

frequencyDDEqn :: Expr
frequencyDDEqn :: Expr
frequencyDDEqn = forall r. (ExprC r, LiteralC r) => r -> r
recip_ forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.period


frequencyRef :: Sentence
frequencyRef :: Sentence
frequencyRef = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.frequency Sentence -> Sentence -> Sentence
`S.isThe` String -> Sentence
S String
"number of back and forth swings in one" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitDefn
second

------------------------------------------------------

angFrequencyDD :: DataDefinition
angFrequencyDD :: DataDefinition
angFrequencyDD = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
angFrequencyDDQD forall a. Maybe a
Nothing String
"angFrequencyDD" [Sentence
angFrequencyRef]

angFrequencyDDQD :: SimpleQDef
angFrequencyDDQD :: SimpleQDef
angFrequencyDDQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
QP.angularFrequency Expr
angFrequencyDDEqn

angFrequencyDDEqn :: Expr
angFrequencyDDEqn :: Expr
angFrequencyDDEqn = forall r. LiteralC r => Integer -> r
exactDbl Integer
2 forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
QM.pi_ forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.period

angFrequencyRef :: Sentence
angFrequencyRef :: Sentence
angFrequencyRef = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.period Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
periodSHMDD

------------------------------------------------------

periodSHMDD :: DataDefinition
periodSHMDD :: DataDefinition
periodSHMDD = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
periodSHMDDQD forall a. Maybe a
Nothing String
"periodSHMDD" [Sentence
periodSHMRef]

periodSHMDDQD :: SimpleQDef
periodSHMDDQD :: SimpleQDef
periodSHMDDQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
QP.period Expr
periodSHMDDEqn

periodSHMDDEqn :: Expr
periodSHMDDEqn :: Expr
periodSHMDDEqn = forall r. (ExprC r, LiteralC r) => r -> r
recip_ forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.frequency

periodSHMRef :: Sentence
periodSHMRef :: Sentence
periodSHMRef = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
QP.period Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
frequencyDD