module Drasil.Projectile.Lesson.CaseProb where

import Utils.Drasil (weave)

import Data.Drasil.Concepts.Physics (motion, acceleration, velocity, force, time,
  constAccel, horizontalMotion, verticalMotion, gravity, position)
import Data.Drasil.Units.Physics (accelU)
import Data.Drasil.Concepts.Math (component, direction, equation, xDir, yAxis)
import Drasil.Projectile.Concepts (projectile, projMotion)
import Drasil.Projectile.Expressions
import Drasil.Projectile.Lesson.Figures (figCSandA)
import qualified Data.Drasil.Quantities.Physics as QP (iSpeed, ixSpeed, iySpeed, speed,
  constAccel, gravitationalAccel, xAccel, yAccel, time,
  ixPos, iyPos, xPos, yPos, ixVel, iyVel, xVel, yVel)
import Data.Drasil.Concepts.Documentation (coordinate, procedure)
import Language.Drasil
import Language.Drasil.ShortHands
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Drasil.SI_Units (s_2)

caseProbCont :: [Contents]
caseProbCont :: [Contents]
caseProbCont = [Contents
projMotionHead, Contents
motionContextP1, LabelledContent -> Contents
LlC LabelledContent
figCSandA, Contents
motionContextP2, 
  Contents
horMotionHead, Contents
hMintro, Contents
horizMotionEqn1, Contents
horizMotionEqn2, Contents
horizMotionEqn3, Contents
hMconcl, 
  Contents
verMotionHead, Contents
vMintro, Contents
vertMotionEqn1, Contents
vertMotionEqn2, Contents
vertMotionEqn3, Contents
vMconcl, Contents
summaryHead, Contents
summary, 
  Contents
procforAnlsHead, Contents
procforAnls, Contents
stepOneHead, Contents
stepOneCont, Contents
stepTwoHead, Contents
stepTwoCont, Contents
stepThreeHead, Contents
stepThreeCont, 
  Contents
stepFourHead, Contents
stepFourCont, Contents
stepFourOneHead, Contents
horizMotionEqn1, Contents
horizMotionEqn1Sent, Contents
horizMotionEqn2, Contents
stepFourTwoHead, 
  Contents
verMotionCont, Contents
vertMotionEqn1, Contents
vertMotionEqn2, Contents
vertMotionEqn3, Contents
stepFiveHead, Contents
stepFiveCont]

projMotionHead, horMotionHead, verMotionHead, summaryHead :: Contents
projMotionHead :: Contents
projMotionHead = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
1 (String -> Sentence
S String
"Motion of a Projectile")]
horMotionHead :: Contents
horMotionHead  = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
2 (String -> Sentence
S String
"Horizontal Motion")] 
verMotionHead :: Contents
verMotionHead  = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
2 (String -> Sentence
S String
"Vertical Motion")] 
summaryHead :: Contents
summaryHead    = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
2 (String -> Sentence
S String
"Summary")]

motionContextP1, motionContextP2 :: Contents
motionContextP1 :: Contents
motionContextP1
  = [Sentence] -> Contents
foldlSP
      [String -> Sentence
S String
"The free flight", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.ofA` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile, 
        String -> Sentence
S String
"is often studied in terms of its rectangular components, since the",
        forall n. NamedIdea n => n -> Sentence
phrasePoss ConceptChunk
projectile, forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"always acts in the vertical direciton",
       String -> Sentence
S String
"To illustrate the kinematic analysis, consider a ", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile,
         String -> Sentence
S String
"launched at point", Sentence -> Sentence
sParen (Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`sC` Symbol -> Sentence
P Symbol
lY),
         String -> Sentence
S String
"as shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figCSandA,
       String -> Sentence
S String
"The path is defined in the", Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`sDash` Symbol -> Sentence
P Symbol
lY, String -> Sentence
S String
"plane such that the initial", 
         forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity, String -> Sentence
S String
"is", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iSpeed) Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
", having components", 
         ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.ixSpeed) Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iySpeed),
       String -> Sentence
S String
"When air resistance is neglected, the only", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
force, String -> Sentence
S String
"acting on the",
         forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile, String -> Sentence
SString
"is its weight, which causes the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile, 
         String -> Sentence
S String
"to have a *constant downward acceleration* of approximately",
         ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.constAccel forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.gravitationalAccel forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Double -> r
dbl Double
9.81), USymb -> Sentence
Sy (forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
accelU) Sentence -> Sentence -> Sentence
`S.or_` 
         ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.gravitationalAccel forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Double -> r
dbl Double
32.2), USymb -> Sentence
Sy (forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
accelinftU)]

motionContextP2 :: Contents
motionContextP2
  = [Sentence] -> Contents
foldlSP_
      [String -> Sentence
S String
"The equations for rectilinear kinematics given above", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectVel, String -> Sentence
S String
"are in one dimension.",
       String -> Sentence
S String
"These equations can be applied for both the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
verticalMotion Sentence -> Sentence -> Sentence
`S.andThe`
       forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
horizontalMotion Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
", as follows:"]

hMintro, hMequations, hMconcl, vMintro, vMequations, vMconcl, summary:: Contents
hMintro :: Contents
hMintro = [Sentence] -> Contents
foldlSP_ [
            String -> Sentence
S String
"For", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
projMotion Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration, 
            String -> Sentence
S String
"in the horizontal direction is and equal to zero" Sentence -> Sentence -> Sentence
+:+. 
            Sentence -> Sentence
sParen(ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xAccel forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0)), Sentence
motionSent]
hMequations :: Contents
hMequations = [Sentence] -> Contents
foldlSP_ forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [a]
weave [[Sentence]
equationsSents, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
horMotionEqns]
hMconcl :: Contents
hMconcl = [Sentence] -> Contents
foldlSP [
            String -> Sentence
S String
"Since the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration, String -> Sentence
S String
"in the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir, 
            Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xAccel)), String -> Sentence
S String
"is zero, the horizontal component of ", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity,
            String -> Sentence
S String
"always remains constant during" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion,
            String -> Sentence
S String
"In addition to knowing this, we have one more equation"]

vMintro :: Contents
vMintro = [Sentence] -> Contents
foldlSP_ [
            String -> Sentence
S String
"Since the positive", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yAxis, String -> Sentence
S String
"is directed upward, the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration,
            String -> Sentence
S String
"in the vertical direction is" Sentence -> Sentence -> Sentence
+:+. ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yAccel forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.gravitationalAccel)), Sentence
motionSent]
vMequations :: Contents
vMequations = [Sentence] -> Contents
foldlSP_ forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [a]
weave [[Sentence]
equationsSents, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
verMotionEqns]
vMconcl :: Contents
vMconcl = [Sentence] -> Contents
foldlSP [
            String -> Sentence
S String
"Recall that the last equation can be formulated on the basis of eliminating the",
            forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
time Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.time), String -> Sentence
S String
"between the first two equations, and therefore only ",
            String -> Sentence
S String
"two of the above three equations are independent of one another"]

summary :: Contents
summary = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"In addition to knowing that the horizontal component of", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity,
                   String -> Sentence
S String
"is constant [Hibbler doesn't say this, but it seems necessary for completeness],",
                   String -> Sentence
S String
"problems involving the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.ofA` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile Sentence -> Sentence -> Sentence
+:
                   String -> Sentence
S String
"can have at most three unknowns since only three independent equations can be written",
                   String -> Sentence
S String
"that is, one equation in the horizontal direction and two in the vertical direction.",
                   String -> Sentence
S String
"Once", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xVel)  Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yVel),  String -> Sentence
S String
"are obtained, the resultant",
                   forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.speed), String -> Sentence
S String
"which is always tangent to the path,",
                   String -> Sentence
S String
"is defined by the vector sum as shown in", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figCSandA]

procforAnls :: Contents
procforAnls :: Contents
procforAnls = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Free-flight", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
projMotion, String -> Sentence
S String
"problems can be solved using the following", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
procedure]

procforAnlsHead, stepOneHead, stepTwoHead, stepThreeHead, stepFourHead, stepFourOneHead, stepFourTwoHead, stepFiveHead:: Contents
procforAnlsHead :: Contents
procforAnlsHead = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
2 (String -> Sentence
S String
"Procedure for Analysis")]
stepOneHead :: Contents
stepOneHead     = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
3 (String -> Sentence
S String
"Step 1: Coordinate System")]
stepTwoHead :: Contents
stepTwoHead     = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
3 (String -> Sentence
S String
"Step 2: Identify Knowns")] 
stepThreeHead :: Contents
stepThreeHead   = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
3 (String -> Sentence
S String
"Step 3: Identify Unknowns")] 
stepFourHead :: Contents
stepFourHead    = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
3 (String -> Sentence
S String
"Step 4: Kinematic Equations")]
stepFourOneHead :: Contents
stepFourOneHead = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
4 (String -> Sentence
S String
"Step 4.1: Horizontal Motion")]
stepFourTwoHead :: Contents
stepFourTwoHead = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
4 (String -> Sentence
S String
"Step 4.2: Vertical Motion")]
stepFiveHead :: Contents
stepFiveHead    = [Sentence] -> Contents
foldlSP_ [Int -> Sentence -> Sentence
headSent Int
3 (String -> Sentence
S String
"Step 5: Solve for Unknowns")]

stepOneCont, stepTwoCont, stepThreeCont, stepFourCont, horizMotionEqn1, horizMotionEqn1Sent, horizMotionEqn2, horizMotionEqn3,
  vertMotionEqn1, vertMotionEqn2, vertMotionEqn3, verMotionCont, stepFiveCont :: Contents
stepOneCont :: Contents
stepOneCont = [Sentence] -> Contents
enumBulletU forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent 
  [[String -> Sentence
S String
"Establish the fixed", Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`sC` Symbol -> Sentence
P Symbol
lY, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
coordinate Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"axes and sketch the trajectory of the particle",
    String -> Sentence
S String
"Between any *two points* on the path specify the given problem data and the *three unknowns*.",
    String -> Sentence
S String
"In all cases the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
gravity Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"acts downward",
    String -> Sentence
S String
"The particle's initial and final", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"should be represented in terms of their",
    Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`S.and_` Symbol -> Sentence
P Symbol
lY, forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
component],
  [String -> Sentence
S String
"Remember that positive and negative", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
position Sentence -> Sentence -> Sentence
`sC` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity, String -> Sentence
S String
"," Sentence -> Sentence -> Sentence
`S.and_`
    forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration, forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
component Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"always act in accordance with their associated",
    forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
coordinate Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
direction],
  [String -> Sentence
S String
"The two points that are selected should be significant points where something about the",
    forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"particle is known. Potential significant points include the initial point",
    String -> Sentence
S String
"of launching the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"final point where it lands." Sentence -> Sentence -> Sentence
+:+ 
    String -> Sentence
S String
"The landing point often has a known", Symbol -> Sentence
P Symbol
lY Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"value"],
  [String -> Sentence
S String
"The variables in the" , forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S String
"may need to be changed to match the notation of the specific problem.",
    String -> Sentence
S String
"For instance, a distinction may need to be made between the", Symbol -> Sentence
P Symbol
lX, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
coordinate Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"points", Symbol -> Sentence
P Symbol
cA Sentence -> Sentence -> Sentence
`S.and_` Symbol -> Sentence
P Symbol
cB,
    String -> Sentence
S String
"via notation like"]]

stepTwoCont :: Contents
stepTwoCont = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Using the notation for the problem in question, write out the known variables and their values.",
  String -> Sentence
S String
"The known variables will be a subset of the following:" Sentence -> Sentence -> Sentence
+:+. ((ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.ixPos) Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xPos)) Sentence -> Sentence -> Sentence
`sC` (ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iyPos) Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yPos)) Sentence -> Sentence -> Sentence
`sC` 
  (ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.ixVel) Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xVel)) Sentence -> Sentence -> Sentence
`sC` (ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iyVel) Sentence -> Sentence -> Sentence
`sC` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yVel)) Sentence -> Sentence -> Sentence
`S.and_` Symbol -> Sentence
P Symbol
lT),
  String -> Sentence
S String
"The knowns should be written in the notation adopted for the particular problem"]

stepThreeCont :: Contents
stepThreeCont = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Each problem will have at most 4 unknowns that need to be determined, selected from the variables listed in the Step 2 that are not known." Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"The number of relevant unknowns will usually be less than 4, since questions will often focus on one or two unknowns",
  String -> Sentence
S String
"As an example, the equation that horizontal", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is constant is so trivial that most problems will not look for this as an unknown",
  String -> Sentence
S String
"The unknowns should be written in the notation adopted for the particular problem"]

stepFourCont :: Contents
stepFourCont = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Depending upon the known data and what is to be determined, a choice should be made as to which four of the following five equations" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"should be applied between the two points on the path to obtain the most direct solution to the problem"]

horizMotionEqn1 :: Contents
horizMotionEqn1 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectVel, ModelExpr -> Sentence
eS PExpr
horizVel] 
horizMotionEqn1Sent :: Contents
horizMotionEqn1Sent = [Sentence] -> Contents
foldlSP_ [Sentence -> Sentence
sParen (String -> Sentence
S String
"The *velocity* in the horizontal" Sentence -> Sentence -> Sentence
`S.or_` Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
direction Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"is *constant*")]
horizMotionEqn2 :: Contents
horizMotionEqn2 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectPos, ModelExpr -> Sentence
eS PExpr
horizPos]
horizMotionEqn3 :: Contents
horizMotionEqn3 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectNoTime, ModelExpr -> Sentence
eS PExpr
horizVel]

vertMotionEqn1 :: Contents
vertMotionEqn1 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectVel, ModelExpr -> Sentence
eS PExpr
vertVel]
vertMotionEqn2 :: Contents
vertMotionEqn2 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectPos, ModelExpr -> Sentence
eS PExpr
vertPos]
vertMotionEqn3 :: Contents
vertMotionEqn3 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"From equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectNoTime, ModelExpr -> Sentence
eS PExpr
vertNoTime]

verMotionCont :: Contents
verMotionCont = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"In the vertical" Sentence -> Sentence -> Sentence
`S.or_` Symbol -> Sentence
P Symbol
lY, forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
direction, String -> Sentence
S String
"*only two*" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"following three equations", 
  Sentence -> Sentence
sParen (String -> Sentence
S String
"using" Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yAccel forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.gravitationalAccel))) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"can be used for solution",
  Sentence -> Sentence
sParen (String -> Sentence
S String
"The sign" Sentence -> Sentence -> Sentence
`S.of_` Symbol -> Sentence
P Symbol
lG Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"will change to positive if the positive" Sentence -> Sentence -> Sentence
+:+ Symbol -> Sentence
P Symbol
lY Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"axis is downward"),
  String -> Sentence
S String
"For example, if the particle's final velocity", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yVel), String -> Sentence
S String
"is not needed, then the first and third of these questions",
  Sentence -> Sentence
sParen (String -> Sentence
S String
"for" Sentence -> Sentence -> Sentence
+:+ Symbol -> Sentence
P Symbol
lY) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"will not be useful"] 

stepFiveCont :: Contents
stepFiveCont = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Use the equations from Step 4, together with the known values from Step 2 to find the unknown values from Step 3." Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"We can do this systematically by going through each equation and determining how many unknowns are in that equation",
  String -> Sentence
S String
"Any equations with one unknown can be used to solve for that unknown directly"]


equationsSents :: [Sentence]
equationsSents :: [Sentence]
equationsSents = [String -> Sentence
S String
"From Equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectVel,
                  String -> Sentence
S String
"From Equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectPos,
                  String -> Sentence
S String
"From Equation" Sentence -> Sentence -> Sentence
+: forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
lcrectNoTime]
                
horMotionEqns :: [ModelExpr]
horMotionEqns :: [ModelExpr]
horMotionEqns = [PExpr
horizVel, PExpr
horizPos, PExpr
horizVel]

verMotionEqns :: [ModelExpr]
verMotionEqns :: [ModelExpr]
verMotionEqns = [PExpr
vertVel, PExpr
vertPos, PExpr
vertNoTime]

motionSent :: Sentence
motionSent :: Sentence
motionSent = String -> Sentence
S String
"This value can be substituted in the equations for" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
constAccel Sentence -> Sentence -> Sentence
+:
             String -> Sentence
S String
"given above (ref) to yield the following"

-- References --
figRefs :: [Reference]
figRefs :: [Reference]
figRefs = [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref LabelledContent
figCSandA]

foot, accelinftU :: UnitDefn
foot :: UnitDefn
foot = String -> String -> String -> UnitDefn
fund String
"foot" String
"length" String
"ft"
accelinftU :: UnitDefn
accelinftU = String -> UnitEquation -> UnitDefn
newUnit String
"acceleration" forall a b. (a -> b) -> a -> b
$ UnitDefn
foot UnitDefn -> UnitDefn -> UnitEquation
/: UnitDefn
s_2