{-# 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, projPos)

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

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

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

rectVelDeriv :: Derivation
rectVelDeriv :: Derivation
rectVelDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
rectVel)
               (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 [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
motion) Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
accelerationTM Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"now", forall n. NamedIdea n => n -> Sentence
phrase CI
oneD,
                         String -> Sentence
S String
"with a", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.constAccel Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"represented by", forall t. Express t => t -> Sentence
eS' UnitalChunk
QP.constAccel]

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

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

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

rectPosDeriv :: Derivation
rectPosDeriv :: Derivation
rectPosDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rectilinear Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
position)
               (forall a. [[a]] -> [a]
weave [[Sentence]
rectPosDerivSents, [Sentence]
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, forall r.
(Referable r, HasShortName r) =>
r -> UnitalChunk -> Sentence
fromReplace GenDefn
rectVelGD UnitalChunk
speed, Sentence
performIntSent]
    where
      motSent :: Sentence
motSent = forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
motion) Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
velocityTM Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"now" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase CI
oneD

rectPosDerivEqns :: [Sentence]
rectPosDerivEqns :: [Sentence]
rectPosDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
D.rectPosDeriv forall a. [a] -> [a] -> [a]
++ [forall t. Express t => t -> Sentence
eS' ModelQDef
rectPosQD]

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

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

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

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

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

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

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

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

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

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