module Drasil.Projectile.IMods (iMods, landPosIM, messageIM, offsetIM, timeIM) where

import Prelude hiding (cos, sin)

import Language.Drasil
import Theory.Drasil (InstanceModel, imNoDerivNoRefs, imNoRefs, qwC, equationalModelN)
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import qualified Drasil.DocLang.SRS as SRS (valsOfAuxCons)

import Data.Drasil.Concepts.Documentation (value)
import Data.Drasil.Concepts.Math (constraint, equation, xAxis)

import Data.Drasil.Quantities.Math (pi_)
import Data.Drasil.Quantities.Physics (gravitationalAccelConst, iSpeed, ixPos,
  ixVel, iyPos, iyVel, time, xConstAccel, xPos, yConstAccel, yPos)

import Drasil.Projectile.Assumptions (accelXZero, accelYGravity, gravAccelValue,
  launchOrigin, posXDirection, targetXAxis, timeStartZero, yAxisGravity)
import Drasil.Projectile.Concepts (projectile, target)
import Drasil.Projectile.DataDefs (speedIX, speedIY)
import qualified Drasil.Projectile.Derivations as D
import qualified Drasil.Projectile.Expressions as E
import Drasil.Projectile.Figures (figLaunch)
import Drasil.Projectile.GenDefs (posVecGD)
import Drasil.Projectile.Unitals (flightDur, landPos, launAngle, launSpeed,
  message, offset, targPos, tol)

iMods :: [InstanceModel]
iMods :: [InstanceModel]
iMods = [InstanceModel
timeIM, InstanceModel
landPosIM, InstanceModel
offsetIM, InstanceModel
messageIM]
---
timeIM :: InstanceModel
timeIM :: InstanceModel
timeIM = ModelKind Expr
-> Inputs
-> QuantityDict
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs (forall e. NP -> QDefinition e -> ModelKind e
equationalModelN (String -> NP
nounPhraseSP String
"calculation of landing time") SimpleQDef
timeQD)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
launSpeed forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
launAngle forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. (ExprC r, LiteralC r) => r -> r
half forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
pi_)]
  (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw ConstrConcept
flightDur) [forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall a. a -> Maybe a
Just Derivation
timeDeriv) String
"calOfLandingTime" [Sentence
angleConstraintNote, Sentence
gravitationalAccelConstNote, Sentence
timeConsNote]

timeQD :: SimpleQDef 
timeQD :: SimpleQDef
timeQD =  forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef ConstrConcept
flightDur PExpr
E.flightDur'

timeDeriv :: Derivation
timeDeriv :: Derivation
timeDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
flightDur) (forall a. [[a]] -> [a]
weave [[Sentence]
timeDerivSents, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
timeDerivEqns])

timeDerivSents :: [Sentence]
timeDerivSents :: [Sentence]
timeDerivSents = [Sentence
timeDerivSent1, Sentence
timeDerivSent2, Sentence
timeDerivSent3, Sentence
timeDerivSent4, Sentence
timeDerivSent5]

timeDerivSent1, timeDerivSent2, timeDerivSent3, timeDerivSent4, timeDerivSent5 :: Sentence
timeDerivSent1 :: Sentence
timeDerivSent1 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"We know that" Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
    [forall r.
(Referable r, HasShortName r) =>
ModelExpr -> r -> Sentence
eqnWSource (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iyPos forall r. ExprC r => r -> r -> r
$= PExpr
E.iyPos) ConceptInstance
launchOrigin,
     forall r.
(Referable r, HasShortName r) =>
ModelExpr -> r -> Sentence
eqnWSource (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yConstAccel forall r. ExprC r => r -> r -> r
$= PExpr
E.yConstAccel) ConceptInstance
accelYGravity],
  String -> Sentence
S String
"Substituting these", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"into the y-direction" Sentence -> Sentence -> Sentence
`S.of_`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
posVecGD, String -> Sentence
S String
"gives us"]
timeDerivSent2 :: Sentence
timeDerivSent2 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"To find the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time, String -> Sentence
S String
"that the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
projectile, String -> Sentence
S String
"lands" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"we want to find the", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value,
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur), String -> Sentence
S String
"where", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yPos forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (String -> Sentence
S String
"since the" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
target Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"on the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xAxis Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
targetXAxis),
  String -> Sentence
S String
"From the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"above we get"]
timeDerivSent3 :: Sentence
timeDerivSent3 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"Dividing by", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur,
  Sentence -> Sentence
sParen (String -> Sentence
S String
"with the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
constraint Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
flightDur forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0)),
  String -> Sentence
S String
"gives us"]
timeDerivSent4 :: Sentence
timeDerivSent4 = String -> Sentence
S String
"Solving for" Sentence -> Sentence -> Sentence
+:+ forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur Sentence -> Sentence -> Sentence
+: String -> Sentence
S String
"gives us"
timeDerivSent5 :: Sentence
timeDerivSent5 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"From", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
speedIY,
  Sentence -> Sentence
sParen (String -> Sentence
S String
"with" Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iSpeed forall r. ExprC r => r -> r -> r
$= PExpr
E.iSpeed)), String -> Sentence
S String
"we can replace", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
iyVel]

timeDerivEqns :: [ModelExpr]
timeDerivEqns :: [ModelExpr]
timeDerivEqns = [ModelExpr]
D.timeDeriv forall a. [a] -> [a] -> [a]
++ [forall c. Express c => c -> ModelExpr
express SimpleQDef
timeQD]

---
landPosIM :: InstanceModel
landPosIM :: InstanceModel
landPosIM = ModelKind Expr
-> Inputs
-> QuantityDict
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs (forall e. NP -> QDefinition e -> ModelKind e
equationalModelN (String -> NP
nounPhraseSP String
"calculation of landing position") SimpleQDef
landPosQD)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
launSpeed forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0),
   forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
launAngle forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. (ExprC r, LiteralC r) => r -> r
half forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
pi_)]
  (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw ConstrConcept
landPos) [forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall a. a -> Maybe a
Just Derivation
landPosDeriv) String
"calOfLandingDist" [Sentence
angleConstraintNote, Sentence
gravitationalAccelConstNote, Sentence
landPosConsNote]

landPosQD :: SimpleQDef
landPosQD :: SimpleQDef
landPosQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef ConstrConcept
landPos PExpr
E.landPosExpr

landPosDeriv :: Derivation
landPosDeriv :: Derivation
landPosDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
landPos) (forall a. [[a]] -> [a]
weave [[Sentence]
landPosDerivSents, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [ModelExpr]
landPosDerivEqns])

landPosDerivSents :: [Sentence]
landPosDerivSents :: [Sentence]
landPosDerivSents = [Sentence
landPosDerivSent1, Sentence
landPosDerivSent2, Sentence
landPosDerivSent3, Sentence
landPosDerivSent4]

landPosDerivSent1, landPosDerivSent2, landPosDerivSent3, landPosDerivSent4 :: Sentence
landPosDerivSent1 :: Sentence
landPosDerivSent1 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"We know that" Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
    [forall r.
(Referable r, HasShortName r) =>
ModelExpr -> r -> Sentence
eqnWSource (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
ixPos forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0) ConceptInstance
launchOrigin,
     forall r.
(Referable r, HasShortName r) =>
ModelExpr -> r -> Sentence
eqnWSource (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
xConstAccel forall r. ExprC r => r -> r -> r
$= forall r. LiteralC r => Integer -> r
exactDbl Integer
0) ConceptInstance
accelXZero],
  String -> Sentence
S String
"Substituting these", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"into the x-direction" Sentence -> Sentence -> Sentence
`S.of_`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
posVecGD, String -> Sentence
S String
"gives us"]
landPosDerivSent2 :: Sentence
landPosDerivSent2 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"To find the", forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
landPos Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"we want to find the", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xPos, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value, Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
landPos),
  String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
flightDur, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
timeIM]
landPosDerivSent3 :: Sentence
landPosDerivSent3 = [Sentence] -> Sentence
foldlSentCol [String -> Sentence
S String
"From", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
speedIX,
  Sentence -> Sentence
sParen (String -> Sentence
S String
"with" Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
E (forall r. ModelExprC r => r -> r -> r
defines (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iSpeed) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launSpeed))), String -> Sentence
S String
"we can replace", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
ixVel]
landPosDerivSent4 :: Sentence
landPosDerivSent4 = String -> Sentence
S String
"Rearranging this gives us the required" Sentence -> Sentence -> Sentence
+: forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation

landPosDerivEqns :: [ModelExpr]
landPosDerivEqns :: [ModelExpr]
landPosDerivEqns = [ModelExpr]
D.landPosDeriv forall a. [a] -> [a] -> [a]
++ [forall c. Express c => c -> ModelExpr
express SimpleQDef
landPosQD]

---
offsetIM :: InstanceModel
offsetIM :: InstanceModel
offsetIM = ModelKind Expr
-> Inputs
-> QuantityDict
-> OutputConstraints
-> String
-> [Sentence]
-> InstanceModel
imNoDerivNoRefs (forall e. NP -> QDefinition e -> ModelKind e
equationalModelN (String -> NP
nounPhraseSP String
"offset") SimpleQDef
offsetQD)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
landPos forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
targPos forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw ConstrConcept
offset) [] String
"offsetIM" [Sentence
landPosNote, Sentence
landAndTargPosConsNote]

offsetQD :: SimpleQDef
offsetQD :: SimpleQDef
offsetQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef ConstrConcept
offset PExpr
E.offset'
---
messageIM :: InstanceModel
messageIM :: InstanceModel
messageIM = ModelKind Expr
-> Inputs
-> QuantityDict
-> OutputConstraints
-> String
-> [Sentence]
-> InstanceModel
imNoDerivNoRefs (forall e. NP -> QDefinition e -> ModelKind e
equationalModelN (String -> NP
nounPhraseSP String
"output message") SimpleQDef
messageQD)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
offset forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
targPos))
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC ConstrConcept
targPos forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)]
  (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw QuantityDict
message)
  [] String
"messageIM" [Sentence
offsetNote, Sentence
targPosConsNote, Sentence
offsetConsNote, Sentence
tolNote]

messageQD :: SimpleQDef
messageQD :: SimpleQDef
messageQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef QuantityDict
message PExpr
E.message

--- Notes

angleConstraintNote, gravitationalAccelConstNote, landAndTargPosConsNote, landPosNote,
  landPosConsNote, offsetNote, offsetConsNote, targPosConsNote,
  timeConsNote, tolNote :: Sentence

angleConstraintNote :: Sentence
angleConstraintNote = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint),
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval ConstrConcept
launAngle (forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. (ExprC r, LiteralC r) => r -> r
half forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
pi_))) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
posXDirection Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
yAxisGravity Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"and is shown" Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figLaunch]

gravitationalAccelConstNote :: Sentence
gravitationalAccelConstNote = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstQDef
gravitationalAccelConst Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"defined in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
gravAccelValue

landAndTargPosConsNote :: Sentence
landAndTargPosConsNote = forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint) Sentence -> Sentence -> Sentence
+:+
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
landPos forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
targPos forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
posXDirection

landPosNote :: Sentence
landPosNote = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
landPos Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
landPosIM

landPosConsNote :: Sentence
landPosConsNote = forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint) Sentence -> Sentence -> Sentence
+:+
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
landPos forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
posXDirection

offsetNote :: Sentence
offsetNote = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
offset Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
offsetIM

offsetConsNote :: Sentence
offsetConsNote = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint), ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
offset 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 ConstrConcept
targPos)) Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"from the fact that", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
landPos 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", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
posXDirection]

targPosConsNote :: Sentence
targPosConsNote = forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint) Sentence -> Sentence -> Sentence
+:+
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
targPos forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
posXDirection

timeConsNote :: Sentence
timeConsNote = forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
constraint) Sentence -> Sentence -> Sentence
+:+
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
flightDur forall r. ExprC r => r -> r -> r
$> forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
timeStartZero

tolNote :: Sentence
tolNote = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstQDef
tol Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"defined in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.valsOfAuxCons ([]::[Contents]) ([]::[Section]))