{-# LANGUAGE PostfixOperators #-}
module Drasil.Projectile.GenDefs (genDefns, posVecGD) where

import Prelude hiding (cos, sin)
import Language.Drasil
import Theory.Drasil (GenDefn, TheoryModel, gd, gdNoRefs, equationalModel')
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (coordinate, symbol_)
import Data.Drasil.Concepts.Math (cartesian, equation, vector)
import Data.Drasil.Concepts.Physics (oneD, rectilinear, twoD, motion)

import Data.Drasil.Quantities.Physics (acceleration, constAccelV, iPos, iSpeed,
  iVel, ixVel, iyVel, position, scalarAccel, scalarPos,
  time, velocity, positionVec, speed)
import qualified Data.Drasil.Quantities.Physics as QP (constAccel)
import Data.Drasil.Theories.Physics (accelerationTM, velocityTM)

import Drasil.Projectile.Assumptions (cartSyst, constAccel, pointMass, timeStartZero, twoDMotion)
import Drasil.Projectile.Concepts (rectVel)
import qualified Drasil.Projectile.Derivations as D
import qualified Drasil.Projectile.Expressions as E
import Data.Drasil.Citations (hibbeler2004)
import Drasil.Projectile.Unitals (projSpeed)

genDefns :: [GenDefn]
genDefns :: [GenDefn]
genDefns = [GenDefn
rectVelGD, GenDefn
rectPosGD, GenDefn
velVecGD, GenDefn
posVecGD]

----------
rectVelGD :: GenDefn
rectVelGD :: GenDefn
rectVelGD = ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (QDefinition ModelExpr -> ModelKind ModelExpr
forall e. QDefinition e -> ModelKind e
equationalModel' QDefinition ModelExpr
rectVelQD) (UnitalChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
projSpeed) (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
rectVelDeriv)
  [Citation -> RefInfo -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo Citation
hibbeler2004 (RefInfo -> DecRef) -> RefInfo -> DecRef
forall a b. (a -> b) -> a -> b
$ [Int] -> RefInfo
Page [8]] "rectVel" [{-Notes-}]

rectVelQD :: ModelQDef
rectVelQD :: QDefinition ModelExpr
rectVelQD = UnitalChunk -> NP -> ModelExpr -> QDefinition ModelExpr
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
projSpeed (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent_ 
            [ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
rectilinear, Sentence -> Sentence
sParen (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ CI -> Sentence
getAcc CI
oneD, UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
velocity,
             String -> Sentence
S "as a function" Sentence -> Sentence -> Sentence
`S.of_` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
time UnitalChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` UnitalChunk
QP.constAccel)])
            ModelExpr
PExpr
E.speed'

rectVelDeriv :: Derivation
rectVelDeriv :: Derivation
rectVelDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
rectVel)
               ([[Sentence]] -> [Sentence]
forall a. [[a]] -> [a]
weave [[Sentence]
rectVelDerivSents, [Sentence]
rectVelDerivEqns])

rectVelDerivSents :: [Sentence]
rectVelDerivSents :: [Sentence]
rectVelDerivSents = [UnitalChunk
-> UnitalChunk
-> Sentence
-> UnitalChunk
-> TheoryModel
-> Sentence
rectDeriv UnitalChunk
velocity UnitalChunk
acceleration Sentence
motSent UnitalChunk
iVel TheoryModel
accelerationTM, Sentence
rearrAndIntSent, Sentence
performIntSent]
  where
    motSent :: Sentence
motSent = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
motion) Sentence -> Sentence -> Sentence
`S.in_` TheoryModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
accelerationTM Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "now", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
oneD,
                         String -> Sentence
S "with a", UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
QP.constAccel Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "represented by", UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
QP.constAccel]

rectVelDerivEqns :: [Sentence]
rectVelDerivEqns :: [Sentence]
rectVelDerivEqns = (ModelExpr -> Sentence) -> [ModelExpr] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
D.rectVelDeriv [Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++ [QDefinition ModelExpr -> Sentence
forall t. Express t => t -> Sentence
eS' QDefinition ModelExpr
rectVelQD]

----------
rectPosGD :: GenDefn
rectPosGD :: GenDefn
rectPosGD = ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (QDefinition ModelExpr -> ModelKind ModelExpr
forall e. QDefinition e -> ModelKind e
equationalModel' QDefinition ModelExpr
rectPosQD) (UnitalChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
scalarPos) (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
rectPosDeriv)
  [Citation -> RefInfo -> DecRef
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> DecRef
dRefInfo Citation
hibbeler2004 (RefInfo -> DecRef) -> RefInfo -> DecRef
forall a b. (a -> b) -> a -> b
$ [Int] -> RefInfo
Page [8]] "rectPos" [{-Notes-}]

rectPosQD :: ModelQDef
rectPosQD :: QDefinition ModelExpr
rectPosQD = UnitalChunk -> NP -> ModelExpr -> QDefinition ModelExpr
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
scalarPos (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent_ 
            [ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
rectilinear, Sentence -> Sentence
sParen (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ CI -> Sentence
getAcc CI
oneD, UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
position,
             String -> Sentence
S "as a function" Sentence -> Sentence -> Sentence
`S.of_` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
time UnitalChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` UnitalChunk
QP.constAccel)])
            ModelExpr
PExpr
E.scalarPos'

rectPosDeriv :: Derivation
rectPosDeriv :: Derivation
rectPosDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
rectilinear Sentence -> Sentence -> Sentence
+:+ UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
position)
               ([[Sentence]] -> [Sentence]
forall a. [[a]] -> [a]
weave [[Sentence]
rectPosDerivSents, (ModelExpr -> Sentence) -> [ModelExpr] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
rectPosDerivEqns])

rectPosDerivSents :: [Sentence]
rectPosDerivSents :: [Sentence]
rectPosDerivSents = [UnitalChunk
-> UnitalChunk
-> Sentence
-> UnitalChunk
-> TheoryModel
-> Sentence
rectDeriv UnitalChunk
position UnitalChunk
velocity Sentence
motSent UnitalChunk
iPos TheoryModel
velocityTM,
  Sentence
rearrAndIntSent, GenDefn -> UnitalChunk -> Sentence
forall r.
(Referable r, HasShortName r) =>
r -> UnitalChunk -> Sentence
fromReplace GenDefn
rectVelGD UnitalChunk
speed, Sentence
performIntSent]
    where
      motSent :: Sentence
motSent = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
motion) Sentence -> Sentence -> Sentence
`S.in_` TheoryModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
velocityTM Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "now" Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
oneD

rectPosDerivEqns :: [ModelExpr]
rectPosDerivEqns :: [ModelExpr]
rectPosDerivEqns = [ModelExpr]
D.rectPosDeriv [ModelExpr] -> [ModelExpr] -> [ModelExpr]
forall a. [a] -> [a] -> [a]
++ [QDefinition ModelExpr -> ModelExpr
forall c. Express c => c -> ModelExpr
express QDefinition ModelExpr
rectPosQD]

----------
velVecGD :: GenDefn
velVecGD :: GenDefn
velVecGD = ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> String
-> [Sentence]
-> GenDefn
forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (QDefinition ModelExpr -> ModelKind ModelExpr
forall e. QDefinition e -> ModelKind e
equationalModel' QDefinition ModelExpr
velVecQD) (UnitalChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
velocity)
           (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
velVecDeriv) "velVec" [{-Notes-}]

velVecQD :: ModelQDef
velVecQD :: QDefinition ModelExpr
velVecQD = UnitalChunk -> NP -> ModelExpr -> QDefinition ModelExpr
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
velocity (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent_ 
           [UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart UnitalChunk
velocity, String -> Sentence
S "vector as a function" Sentence -> Sentence -> Sentence
`S.of_` UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
time Sentence -> Sentence -> Sentence
`S.for`
            CI -> Sentence
getAcc CI
twoD, String -> Sentence
S "motion under", UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
QP.constAccel]) ModelExpr
PExpr
E.velVecExpr

velVecDeriv :: Derivation
velVecDeriv :: Derivation
velVecDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
velocity Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
vector) [Sentence
velVecDerivSent, 
  ModelExpr -> Sentence
E (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ ModelExpr -> ModelExpr -> ModelExpr
forall r. ModelExprC r => r -> r -> r
defines (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
velocity) ModelExpr
PExpr
E.velVecExpr]

velVecDerivSent :: Sentence
velVecDerivSent :: Sentence
velVecDerivSent = [(UnitalChunk, ModelExpr)] -> GenDefn -> Sentence
vecDeriv [(UnitalChunk
velocity, ModelExpr
PExpr
E.velocityXY), (UnitalChunk
acceleration, ModelExpr
PExpr
E.accelerationXY)] GenDefn
rectVelGD

----------
posVecGD :: GenDefn
posVecGD :: GenDefn
posVecGD = ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> String
-> [Sentence]
-> GenDefn
forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs (QDefinition ModelExpr -> ModelKind ModelExpr
forall e. QDefinition e -> ModelKind e
equationalModel' QDefinition ModelExpr
posVecQD) (UnitalChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
position) 
           (Derivation -> Maybe Derivation
forall a. a -> Maybe a
Just Derivation
posVecDeriv) "posVec" [{-Notes-}]

posVecQD :: ModelQDef
posVecQD :: QDefinition ModelExpr
posVecQD = UnitalChunk -> NP -> ModelExpr -> QDefinition ModelExpr
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
position (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent_ 
  [UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart UnitalChunk
position, String -> Sentence
S "vector as a function" Sentence -> Sentence -> Sentence
`S.of_` UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
time Sentence -> Sentence -> Sentence
`S.for`
   CI -> Sentence
getAcc CI
twoD, String -> Sentence
S "motion under", UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
QP.constAccel])
  ModelExpr
PExpr
E.posVecExpr

posVecDeriv :: Derivation
posVecDeriv :: Derivation
posVecDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
positionVec) [Sentence
posVecDerivSent, QDefinition ModelExpr -> Sentence
forall t. Express t => t -> Sentence
eS' QDefinition ModelExpr
posVecQD]

posVecDerivSent :: Sentence
posVecDerivSent :: Sentence
posVecDerivSent =
  [(UnitalChunk, ModelExpr)] -> GenDefn -> Sentence
vecDeriv [(UnitalChunk
position, ModelExpr
PExpr
E.positionXY), (UnitalChunk
velocity, ModelExpr
PExpr
E.velocityXY), (UnitalChunk
acceleration, ModelExpr
PExpr
E.accelerationXY)] GenDefn
rectPosGD

-- Helper for making rectilinear derivations
rectDeriv :: UnitalChunk -> UnitalChunk -> Sentence -> UnitalChunk -> TheoryModel -> Sentence
rectDeriv :: UnitalChunk
-> UnitalChunk
-> Sentence
-> UnitalChunk
-> TheoryModel
-> Sentence
rectDeriv c1 :: UnitalChunk
c1 c2 :: UnitalChunk
c2 motSent :: Sentence
motSent initc :: UnitalChunk
initc ctm :: TheoryModel
ctm = [Sentence] -> Sentence
foldlSent_ [
  String -> Sentence
S "Assume we have", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
rectilinear ConceptChunk
motion) Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S "particle",
  Sentence -> Sentence
sParen (String -> Sentence
S "of negligible size" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "shape" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "from" Sentence -> Sentence -> Sentence
+:+ ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
pointMass) Sentence -> Sentence -> Sentence
:+:
  String -> Sentence
S ";" Sentence -> Sentence -> Sentence
+:+. (String -> Sentence
S "that is" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "motion" Sentence -> Sentence -> Sentence
`S.in_` String -> Sentence
S "a straight line"),
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
c1) Sentence -> Sentence -> Sentence
`S.is` UnitalChunk -> Sentence
getScalar UnitalChunk
c1 Sentence -> Sentence -> Sentence
`S.andThe` UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
c2 Sentence -> Sentence -> Sentence
`S.is` UnitalChunk -> Sentence
getScalar UnitalChunk
c2 Sentence -> Sentence
!.), Sentence
motSent,
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
initc), Sentence -> Sentence
sParen (String -> Sentence
S "at" Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= Integer -> ModelExpr
forall r. LiteralC r => Integer -> r
exactDbl 0) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "from" Sentence -> Sentence -> Sentence
+:+
  ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
timeStartZero) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "represented by" Sentence -> Sentence -> Sentence
+:+. UnitalChunk -> Sentence
getScalar UnitalChunk
initc,
  String -> Sentence
S "From", TheoryModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
ctm Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "using the above", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
symbol_ Sentence -> Sentence -> Sentence
+: String -> Sentence
S "we have"]
  where
    getScalar :: UnitalChunk -> Sentence
getScalar c :: UnitalChunk
c
      | UnitalChunk
c UnitalChunk -> UnitalChunk -> Bool
forall a. Eq a => a -> a -> Bool
== UnitalChunk
position     = UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
scalarPos
      | UnitalChunk
c UnitalChunk -> UnitalChunk -> Bool
forall a. Eq a => a -> a -> Bool
== UnitalChunk
velocity     = UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
speed
      | UnitalChunk
c UnitalChunk -> UnitalChunk -> Bool
forall a. Eq a => a -> a -> Bool
== UnitalChunk
acceleration = UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
scalarAccel
      | UnitalChunk
c UnitalChunk -> UnitalChunk -> Bool
forall a. Eq a => a -> a -> Bool
== UnitalChunk
iPos         = UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
iPos
      | UnitalChunk
c UnitalChunk -> UnitalChunk -> Bool
forall a. Eq a => a -> a -> Bool
== UnitalChunk
iVel         = UnitalChunk -> Sentence
forall t. Express t => t -> Sentence
eS' UnitalChunk
iSpeed
      | Bool
otherwise         = String -> Sentence
forall a. HasCallStack => String -> a
error "Not implemented in getScalar"

rearrAndIntSent, performIntSent :: Sentence
rearrAndIntSent :: Sentence
rearrAndIntSent = String -> Sentence
S "Rearranging" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "integrating" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "we" Sentence -> Sentence -> Sentence
+: String -> Sentence
S "have"
performIntSent :: Sentence
performIntSent  = String -> Sentence
S "Performing the integration" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "we have the required" Sentence -> Sentence -> Sentence
+: ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
equation

-- Helper for making vector derivations
vecDeriv :: [(UnitalChunk, ModelExpr)] -> GenDefn -> Sentence
vecDeriv :: [(UnitalChunk, ModelExpr)] -> GenDefn -> Sentence
vecDeriv vecs :: [(UnitalChunk, ModelExpr)]
vecs gdef :: GenDefn
gdef = [Sentence] -> Sentence
foldlSentCol [
  String -> Sentence
S "For a", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (CI -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI CI
twoD ConceptChunk
cartesian), Sentence -> Sentence
sParen (ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
twoDMotion Sentence -> Sentence -> Sentence
`S.and_` ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
cartSyst) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "we can represent" Sentence -> Sentence -> Sentence
+:+. SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List 
  (((UnitalChunk, ModelExpr) -> Sentence)
-> [(UnitalChunk, ModelExpr)] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: UnitalChunk
c, e :: ModelExpr
e) -> [Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
c), ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
vector, String -> Sentence
S "as", ModelExpr -> Sentence
eS ModelExpr
e]) [(UnitalChunk, ModelExpr)]
vecs),
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
acceleration) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "assumed to be constant", Sentence -> Sentence
sParen (ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
constAccel) Sentence -> Sentence -> Sentence
`S.andThe`
  UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
constAccelV Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "represented as" Sentence -> Sentence -> Sentence
+:+. ModelExpr -> Sentence
eS ModelExpr
PExpr
E.constAccelXY, 
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
iVel) Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (String -> Sentence
S "at" Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= Integer -> ModelExpr
forall r. LiteralC r => Integer -> r
exactDbl 0) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "from" Sentence -> Sentence -> Sentence
+:+ ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
timeStartZero) Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S "represented by" Sentence -> Sentence -> Sentence
+:+. ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iVel ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
ixVel) (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iyVel)), 
  String -> Sentence
S "Since we have a",
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
cartesian Sentence -> Sentence -> Sentence
`sC` GenDefn -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
gdef, String -> Sentence
S "can be applied to each", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
coordinate NamedChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe`
  ((UnitalChunk, ModelExpr) -> UnitalChunk
forall a b. (a, b) -> a
fst ((UnitalChunk, ModelExpr) -> UnitalChunk)
-> ([(UnitalChunk, ModelExpr)] -> (UnitalChunk, ModelExpr))
-> [(UnitalChunk, ModelExpr)]
-> UnitalChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(UnitalChunk, ModelExpr)] -> (UnitalChunk, ModelExpr)
forall a. [a] -> a
head) [(UnitalChunk, ModelExpr)]
vecs), ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
vector, String -> Sentence
S "to yield the required", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
equation]