{-# LANGUAGE PostfixOperators #-}
module Drasil.DblPend.GenDefs (genDefns, velXGD_1, velYGD_1,
         accelXGD_1, accelYGD_1, accelXGD_2, accelYGD_2, xForceGD_1, yForceGD_1,
         xForceGD_2, yForceGD_2) where

import Prelude hiding (cos, sin, sqrt)
import qualified Data.List.NonEmpty as NE

import Language.Drasil
import Utils.Drasil (weave)
import Theory.Drasil
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.Concepts.Math (xComp, yComp)
import Data.Drasil.Quantities.Physics (velocity, acceleration, force)
import Drasil.DblPend.DataDefs
import qualified Drasil.DblPend.Expressions as E
import qualified Drasil.DblPend.Derivations as D
import Drasil.DblPend.Unitals (lenRod_1, xVel_1, xVel_2,
    yVel_1, yVel_2, xAccel_1, yAccel_1, xAccel_2, yAccel_2)
import Drasil.DblPend.Concepts (horizontalPos,
    verticalPos, horizontalVel, verticalVel, horizontalForce, verticalForce, firstObject, secondObject)
import Control.Lens ((^.))

genDefns :: [GenDefn]
genDefns :: [GenDefn]
genDefns = [GenDefn
velXGD_1, GenDefn
velYGD_1, GenDefn
velXGD_2, GenDefn
velYGD_2, GenDefn
accelXGD_1, GenDefn
accelYGD_1, GenDefn
accelXGD_2, GenDefn
accelYGD_2,
       GenDefn
xForceGD_1, GenDefn
yForceGD_1, GenDefn
xForceGD_2, GenDefn
yForceGD_2]

------------------------------------------------
-- Velocity in X Direction in the First Object--
------------------------------------------------
velXGD_1 :: GenDefn
velXGD_1 :: GenDefn
velXGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
velXQD_1) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
velocity) (forall a. a -> Maybe a
Just Derivation
velXDeriv_1) String
"velocityX1" [{-Notes-}]
-- general definiton block, with equation, unit, refinement explanation

velXQD_1 :: ModelQDef
velXQD_1 :: ModelQDef
velXQD_1 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
xVel_1 (forall t. NamedIdea t => t -> NP
the ConceptChunk
xComp NP -> NP -> NP
`NP.of_` (UnitalChunk
velocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)) PExpr
E.velXExpr_1
-- lable and equation

velXDeriv_1 :: Derivation
velXDeriv_1 :: Derivation
velXDeriv_1 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
velocity))) (forall a. [[a]] -> [a]
weave [[Sentence]
velXDerivSents_1, [Sentence]
velXDerivEqns_1])
-- title paragraph and weave the explained words and refined equation

velXDerivSents_1 :: [Sentence]
velXDerivSents_1 :: [Sentence]
velXDerivSents_1 = [Sentence
velDerivSent1,Sentence
velXDerivSent2_1,Sentence
velDerivSent3,Sentence
velDerivSent4, Sentence
velDerivSent5]
-- words used to explain the equation refinement

velXDerivEqns_1 :: [Sentence]
velXDerivEqns_1 :: [Sentence]
velXDerivEqns_1 = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.velDerivEqn1, ModelExpr
D.velXDerivEqn2_1, ModelExpr
D.velXDerivEqn3_1, ModelExpr
D.velXDerivEqn4_1] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
velXQD_1]
-- refinement equation after explained words

velDerivSent1, velXDerivSent2_1, velDerivSent3, velDerivSent4, velDerivSent5 :: Sentence
velDerivSent1 :: Sentence
velDerivSent1 = String -> Sentence
S String
"At a given point in time" Sentence -> Sentence -> Sentence
`sC` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
velocity Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' DataDefinition
positionGDD
velXDerivSent2_1 :: Sentence
velXDerivSent2_1 = String -> Sentence
S String
"We also know the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalPos Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that" Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' DataDefinition
positionXDD_1
velDerivSent3 :: Sentence
velDerivSent3 = String -> Sentence
S String
"Applying this,"
velDerivSent4 :: Sentence
velDerivSent4 = forall t. Express t => t -> Sentence
eS' UnitalChunk
lenRod_1 Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"constant" Sentence -> Sentence -> Sentence
`S.wrt` String -> Sentence
S  String
"time, so"
velDerivSent5 :: Sentence
velDerivSent5 = String -> Sentence
S String
"Therefore, using the chain rule,"

------------------------------------------------
-- Velocity in Y Direction in the First Object--
------------------------------------------------
velYGD_1 :: GenDefn
velYGD_1 :: GenDefn
velYGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
velYQD_1) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
velocity) (forall a. a -> Maybe a
Just Derivation
velYDeriv_1) String
"velocityY1" []

velYQD_1 :: ModelQDef
velYQD_1 :: ModelQDef
velYQD_1 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
yVel_1 (forall t. NamedIdea t => t -> NP
the ConceptChunk
yComp NP -> NP -> NP
`NP.of_` (UnitalChunk
velocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)) PExpr
E.velYExpr_1
 
velYDeriv_1 :: Derivation
velYDeriv_1 :: Derivation
velYDeriv_1 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
yComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
velocity))) (forall a. [[a]] -> [a]
weave [[Sentence]
velYDerivSents_1, [Sentence]
velYDerivEqns_1])

velYDerivSents_1 :: [Sentence]
velYDerivSents_1 :: [Sentence]
velYDerivSents_1 = [Sentence
velDerivSent1, Sentence
velYDerivSent2_1, Sentence
velDerivSent3, Sentence
velDerivSent4, Sentence
velDerivSent5]

velYDerivEqns_1 :: [Sentence]
velYDerivEqns_1 :: [Sentence]
velYDerivEqns_1 = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.velDerivEqn1, ModelExpr
D.velYDerivEqn2_1, ModelExpr
D.velYDerivEqn3_1, ModelExpr
D.velYDerivEqn4_1] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
velYQD_1]

velYDerivSent2_1 :: Sentence
velYDerivSent2_1 :: Sentence
velYDerivSent2_1 = String -> Sentence
S String
"We also know the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalPos Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that" Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' DataDefinition
positionYDD_1

-------------------------------------------------
-- Velocity in X Direction in the Second Object--
-------------------------------------------------
velXGD_2 :: GenDefn
velXGD_2 :: GenDefn
velXGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
velXQD_2) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
velocity) (forall a. a -> Maybe a
Just Derivation
velXDeriv_2) String
"velocityX2" []

velXQD_2 :: ModelQDef
velXQD_2 :: ModelQDef
velXQD_2 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
xVel_2 (forall t. NamedIdea t => t -> NP
the ConceptChunk
xComp NP -> NP -> NP
`NP.of_` (UnitalChunk
velocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)) PExpr
E.velXExpr_2

velXDeriv_2 :: Derivation
velXDeriv_2 :: Derivation
velXDeriv_2 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
velocity))) (forall a. [[a]] -> [a]
weave [[Sentence]
velXDerivSents_2, [Sentence]
velXDerivEqns_2])

velXDerivSents_2 :: [Sentence]
velXDerivSents_2 :: [Sentence]
velXDerivSents_2 = [Sentence
velDerivSent1, Sentence
velXDerivSent2_2, Sentence
velDerivSent3, Sentence
velDerivSent4]

velXDerivEqns_2 :: [Sentence]
velXDerivEqns_2 :: [Sentence]
velXDerivEqns_2 = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.velDerivEqn1, ModelExpr
D.velXDerivEqn2_2, ModelExpr
D.velXDerivEqn3_2] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
velXQD_2] 

velXDerivSent2_2 :: Sentence
velXDerivSent2_2 :: Sentence
velXDerivSent2_2 = String -> Sentence
S String
"We also know the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalPos Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that" Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' DataDefinition
positionXDD_2

-------------------------------------------------
-- Velocity in Y Direction in the Second Object--
-------------------------------------------------
velYGD_2 :: GenDefn
velYGD_2 :: GenDefn
velYGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
velYQD_2) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
velocity) (forall a. a -> Maybe a
Just Derivation
velYDeriv_2) String
"velocityY2" []

velYQD_2 :: ModelQDef
velYQD_2 :: ModelQDef
velYQD_2 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
yVel_2 (forall t. NamedIdea t => t -> NP
the ConceptChunk
yComp NP -> NP -> NP
`NP.of_` (UnitalChunk
velocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)) PExpr
E.velYExpr_2

velYDeriv_2 :: Derivation
velYDeriv_2 :: Derivation
velYDeriv_2 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
yComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
velocity))) (forall a. [[a]] -> [a]
weave [[Sentence]
velYDerivSents_2, [Sentence]
velYDerivEqns_2])

velYDerivSents_2 :: [Sentence]
velYDerivSents_2 :: [Sentence]
velYDerivSents_2 = [Sentence
velDerivSent1,Sentence
velYDerivSent2_2,Sentence
velDerivSent3,Sentence
velDerivSent5]

velYDerivEqns_2 :: [Sentence]
velYDerivEqns_2 :: [Sentence]
velYDerivEqns_2 = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.velDerivEqn1, ModelExpr
D.velYDerivEqn2_2, ModelExpr
D.velYDerivEqn3_2] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
velYQD_2]

velYDerivSent2_2 :: Sentence
velYDerivSent2_2 :: Sentence
velYDerivSent2_2 = String -> Sentence
S String
"We also know the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalPos Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that" Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' DataDefinition
positionYDD_2

----------------------------------------------------
-- Acceleration in X direction in the First Object--
----------------------------------------------------
accelXGD_1 :: GenDefn
accelXGD_1 :: GenDefn
accelXGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
accelXQD_1) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
acceleration) (forall a. a -> Maybe a
Just Derivation
accelXDeriv_1) String
"accelerationX1" []

accelXQD_1 :: ModelQDef
accelXQD_1 :: ModelQDef
accelXQD_1 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
xAccel_1 (forall t. NamedIdea t => t -> NP
the ConceptChunk
xComp NP -> NP -> NP
`NP.of_` (UnitalChunk
acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)) PExpr
E.accelXExpr_1

accelXDeriv_1:: Derivation
accelXDeriv_1 :: Derivation
accelXDeriv_1= Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
acceleration))) (forall a. [[a]] -> [a]
weave [[Sentence]
accelXDerivSents_1, [Sentence]
accelXDerivEqns_1])

accelXDerivSents_1:: [Sentence]
accelXDerivSents_1 :: [Sentence]
accelXDerivSents_1= [Sentence
accelDerivSent1, Sentence
accelXDerivSent2_1, Sentence
accelDerivSent3, Sentence
accelDerivSent4, Sentence
accelDerivSent5]

accelXDerivEqns_1 :: [Sentence]
accelXDerivEqns_1 :: [Sentence]
accelXDerivEqns_1 = ModelExpr -> Sentence
eS ModelExpr
D.accelDerivEqn1 forall a. a -> [a] -> [a]
: forall t. Express t => t -> Sentence
eS' ModelQDef
velXQD_1 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.accelXDerivEqn3_1, ModelExpr
D.accelXDerivEqn4_1] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
accelXQD_1]

accelDerivSent1, accelXDerivSent2_1, accelDerivSent3, accelDerivSent4, accelDerivSent5 :: Sentence

accelDerivSent1 :: Sentence
accelDerivSent1 = String -> Sentence
S String
"Our" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
acceleration Sentence -> Sentence -> Sentence
+: String -> Sentence
S String
"is"
accelXDerivSent2_1 :: Sentence
accelXDerivSent2_1 = String -> Sentence
S String
"Earlier" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we found the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalVel Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"to be"
accelDerivSent3 :: Sentence
accelDerivSent3 = String -> Sentence
S String
"Applying this to our equation for" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
acceleration
accelDerivSent4 :: Sentence
accelDerivSent4 = String -> Sentence
S String
"By the product and chain rules, we find"
accelDerivSent5 :: Sentence
accelDerivSent5 = String -> Sentence
S String
"Simplifying,"

----------------------------------------------------
-- Acceleration in Y direction in the First Object--
----------------------------------------------------
accelYGD_1 :: GenDefn
accelYGD_1 :: GenDefn
accelYGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
accelYQD_1) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
acceleration) (forall a. a -> Maybe a
Just Derivation
accelYDeriv_1) String
"accelerationY1" []

accelYQD_1 :: ModelQDef
accelYQD_1 :: ModelQDef
accelYQD_1 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
yAccel_1 (forall t. NamedIdea t => t -> NP
the ConceptChunk
yComp NP -> NP -> NP
`NP.of_` (UnitalChunk
acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)) PExpr
E.accelYExpr_1

accelYDeriv_1:: Derivation
accelYDeriv_1 :: Derivation
accelYDeriv_1= Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
yComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
acceleration))) (forall a. [[a]] -> [a]
weave [[Sentence]
accelYDerivSents_1, [Sentence]
accelYDerivEqns_1])

accelYDerivSents_1 :: [Sentence]
accelYDerivSents_1 :: [Sentence]
accelYDerivSents_1 = [Sentence
accelDerivSent1, Sentence
accelYDerivSent2_1, Sentence
accelDerivSent3, Sentence
accelDerivSent4, Sentence
accelDerivSent5]

accelYDerivEqns_1 :: [Sentence]
accelYDerivEqns_1 :: [Sentence]
accelYDerivEqns_1 = ModelExpr -> Sentence
eS ModelExpr
D.accelDerivEqn1 forall a. a -> [a] -> [a]
: forall t. Express t => t -> Sentence
eS' ModelQDef
velYQD_1 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr
D.accelYDerivEqn3_1, ModelExpr
D.accelYDerivEqn4_1] forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
accelYQD_1]

accelYDerivSent2_1 :: Sentence
accelYDerivSent2_1 :: Sentence
accelYDerivSent2_1 = String -> Sentence
S String
"Earlier" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we found the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalVel Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"to be"

-----------------------------------------------------
-- Acceleration in X direction in the Second Object--
-----------------------------------------------------
accelXGD_2 :: GenDefn
accelXGD_2 :: GenDefn
accelXGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
accelXQD_2) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
acceleration) (forall a. a -> Maybe a
Just Derivation
accelXDeriv_2) String
"accelerationX2" []

accelXQD_2 :: ModelQDef
accelXQD_2 :: ModelQDef
accelXQD_2 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
xAccel_2 (forall t. NamedIdea t => t -> NP
the ConceptChunk
xComp NP -> NP -> NP
`NP.of_` (UnitalChunk
acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)) PExpr
E.accelXExpr_2

accelXDeriv_2:: Derivation
accelXDeriv_2 :: Derivation
accelXDeriv_2= Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
acceleration))) (forall a. [[a]] -> [a]
weave [[Sentence]
accelXDerivSents_2, [Sentence]
accelXDerivEqns_2])

accelXDerivSents_2:: [Sentence]
accelXDerivSents_2 :: [Sentence]
accelXDerivSents_2= [Sentence
accelDerivSent1, Sentence
accelXDerivSent2_2, Sentence
accelDerivSent3, Sentence
accelDerivSent4]

accelXDerivEqns_2 :: [Sentence]
accelXDerivEqns_2 :: [Sentence]
accelXDerivEqns_2 = ModelExpr -> Sentence
eS ModelExpr
D.accelDerivEqn1 forall a. a -> [a] -> [a]
: forall t. Express t => t -> Sentence
eS' ModelQDef
velXQD_2 forall a. a -> [a] -> [a]
: [ModelExpr -> Sentence
eS ModelExpr
D.accelXDerivEqn3_2, forall t. Express t => t -> Sentence
eS' ModelQDef
accelXQD_2]

accelXDerivSent2_2 :: Sentence
accelXDerivSent2_2 :: Sentence
accelXDerivSent2_2 = String -> Sentence
S String
"Earlier" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we found the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalVel Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"to be"

-----------------------------------------------------
-- Acceleration in Y direction in the Second Object--
-----------------------------------------------------
accelYGD_2 :: GenDefn
accelYGD_2 :: GenDefn
accelYGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
accelYQD_2) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
acceleration) (forall a. a -> Maybe a
Just Derivation
accelYDeriv_2) String
"accelerationY2" []

accelYQD_2 :: ModelQDef
accelYQD_2 :: ModelQDef
accelYQD_2 = forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
yAccel_2 (forall t. NamedIdea t => t -> NP
the ConceptChunk
yComp NP -> NP -> NP
`NP.of_` (UnitalChunk
acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)) PExpr
E.accelYExpr_2

accelYDeriv_2:: Derivation
accelYDeriv_2 :: Derivation
accelYDeriv_2= Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
yComp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` UnitalChunk
acceleration))) (forall a. [[a]] -> [a]
weave [[Sentence]
accelYDerivSents_2, [Sentence]
accelYDerivEqns_2])

accelYDerivSents_2:: [Sentence]
accelYDerivSents_2 :: [Sentence]
accelYDerivSents_2= [Sentence
accelDerivSent1, Sentence
accelYDerivSent2_2, Sentence
accelDerivSent3, Sentence
accelDerivSent4]

accelYDerivEqns_2 :: [Sentence]
accelYDerivEqns_2 :: [Sentence]
accelYDerivEqns_2 = ModelExpr -> Sentence
eS ModelExpr
D.accelDerivEqn1 forall a. a -> [a] -> [a]
: forall t. Express t => t -> Sentence
eS' ModelQDef
velYQD_2 forall a. a -> [a] -> [a]
: [ModelExpr -> Sentence
eS ModelExpr
D.accelYDerivEqn3_2, forall t. Express t => t -> Sentence
eS' ModelQDef
accelYQD_2]

accelYDerivSent2_2 :: Sentence
accelYDerivSent2_2 :: Sentence
accelYDerivSent2_2 = String -> Sentence
S String
"Earlier" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we found the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalVel Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"to be"

-------------------------------------------------
-- Horizontal force acting on the first object --
-------------------------------------------------
xForceGD_1 :: GenDefn
xForceGD_1 :: GenDefn
xForceGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. String -> MultiDefn e -> ModelKind e
equationalRealmU String
"xForce1" MultiDefn ModelExpr
xForceMD_1)
        (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force) (forall a. a -> Maybe a
Just Derivation
xForceDeriv_1) String
"xForce1" []

xForceMD_1 :: MultiDefn ModelExpr
xForceMD_1 :: MultiDefn ModelExpr
xForceMD_1 = forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
quant Sentence
EmptyS NonEmpty (DefiningExpr ModelExpr)
defns
    where quant :: QuantityDict
quant = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
"force" (IdeaDict
horizontalForce forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
firstObject)
                    forall a. Maybe a
Nothing Space
Real (forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force)
          defns :: NonEmpty (DefiningExpr ModelExpr)
defns = forall a. [a] -> NonEmpty a
NE.fromList [
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"xForceWithMass1"
                      [] Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express forall a b. (a -> b) -> a -> b
$ SimpleQDef
forceGQD forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr,
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"xForceWithAngle1"
                      [] Sentence
EmptyS PExpr
E.xForceWithAngle_1]

xForceDeriv_1 :: Derivation
xForceDeriv_1 :: Derivation
xForceDeriv_1 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
firstObject)) [forall t. Express t => t -> Sentence
eS' MultiDefn ModelExpr
xForceMD_1]

-------------------------------------------------
-- Vertical force acting on the first object --
-------------------------------------------------
yForceGD_1 :: GenDefn
yForceGD_1 :: GenDefn
yForceGD_1 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. String -> MultiDefn e -> ModelKind e
equationalRealmU String
"yForce1" MultiDefn ModelExpr
yForceMD_1)
        (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force) (forall a. a -> Maybe a
Just Derivation
yForceDeriv_1) String
"yForce1" []

yForceMD_1 :: MultiDefn ModelExpr
yForceMD_1 :: MultiDefn ModelExpr
yForceMD_1 = forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
quant Sentence
EmptyS NonEmpty (DefiningExpr ModelExpr)
defns
    where quant :: QuantityDict
quant = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
"force" (IdeaDict
verticalForce forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
firstObject)
                    forall a. Maybe a
Nothing Space
Real (forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force)
          defns :: NonEmpty (DefiningExpr ModelExpr)
defns = forall a. [a] -> NonEmpty a
NE.fromList [
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"yForceWithMass1"
                      [] Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express forall a b. (a -> b) -> a -> b
$ SimpleQDef
forceGQD forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr,
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"yForceWithAngle1"
                      [] Sentence
EmptyS PExpr
E.yForceWithAngle_1]

yForceDeriv_1 :: Derivation
yForceDeriv_1 :: Derivation
yForceDeriv_1 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
firstObject)) [forall t. Express t => t -> Sentence
eS' MultiDefn ModelExpr
yForceMD_1]

-------------------------------------------------
-- Horizontal force acting on the second object --
-------------------------------------------------
xForceGD_2 :: GenDefn
xForceGD_2 :: GenDefn
xForceGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. String -> MultiDefn e -> ModelKind e
equationalRealmU String
"xForce2" MultiDefn ModelExpr
xForceMD_2)
        (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force) (forall a. a -> Maybe a
Just Derivation
xForceDeriv_2) String
"xForce2" []

xForceMD_2 :: MultiDefn ModelExpr
xForceMD_2 :: MultiDefn ModelExpr
xForceMD_2 = forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
quant Sentence
EmptyS NonEmpty (DefiningExpr ModelExpr)
defns
    where quant :: QuantityDict
quant = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
"force" (IdeaDict
horizontalForce forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
secondObject)
                    forall a. Maybe a
Nothing Space
Real (forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force)
          defns :: NonEmpty (DefiningExpr ModelExpr)
defns = forall a. [a] -> NonEmpty a
NE.fromList [
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"xForceWithMass2"
                      [] Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express forall a b. (a -> b) -> a -> b
$ SimpleQDef
forceGQD forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr,
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"xForceWithAngle2"
                      [] Sentence
EmptyS PExpr
E.xForceWithAngle_2]

xForceDeriv_2 :: Derivation
xForceDeriv_2 :: Derivation
xForceDeriv_2 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
secondObject)) [forall t. Express t => t -> Sentence
eS' MultiDefn ModelExpr
xForceMD_2]

-------------------------------------------------
-- Vertical force acting on the first object --
-------------------------------------------------
yForceGD_2 :: GenDefn
yForceGD_2 :: GenDefn
yForceGD_2 = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (forall e. String -> MultiDefn e -> ModelKind e
equationalRealmU String
"yForce2" MultiDefn ModelExpr
yForceMD_2)
        (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force) (forall a. a -> Maybe a
Just Derivation
yForceDeriv_2) String
"yForce2" []

yForceMD_2 :: MultiDefn ModelExpr
yForceMD_2 :: MultiDefn ModelExpr
yForceMD_2 = forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
quant Sentence
EmptyS NonEmpty (DefiningExpr ModelExpr)
defns
    where quant :: QuantityDict
quant = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
"force" (IdeaDict
verticalForce forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
secondObject)
                    forall a. Maybe a
Nothing Space
Real (forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
force)
          defns :: NonEmpty (DefiningExpr ModelExpr)
defns = forall a. [a] -> NonEmpty a
NE.fromList [
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"yForceWithMass2"
                      [] Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express forall a b. (a -> b) -> a -> b
$ SimpleQDef
forceGQD forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr,
                    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"yForceWithAngle2"
                      [] Sentence
EmptyS PExpr
E.yForceWithAngle_2]

yForceDeriv_2 :: Derivation
yForceDeriv_2 :: Derivation
yForceDeriv_2 = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` IdeaDict
secondObject)) [forall t. Express t => t -> Sentence
eS' MultiDefn ModelExpr
yForceMD_2]