{-# LANGUAGE PostfixOperators #-}
module Drasil.SSP.GenDefs (normForcEq, bsShrFEq, resShr, mobShr,
  normShrR, generalDefinitions,
  normForcEqGD, bsShrFEqGD, resShrGD, mobShrGD, normShrRGD, momentEqlGD,
  mobShearWOGD, resShearWOGD, srfWtrFGD) where

import Prelude hiding (sin, cos, tan)
import qualified Data.List.NonEmpty as NE
import Language.Drasil
import Theory.Drasil
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.DocLang.SRS as SRS (physSyst)
import Data.Drasil.SI_Units (metre, newton)
import Data.Drasil.Concepts.Documentation (analysis, assumption, component,
  constant, definition, method_, value)
import Data.Drasil.Concepts.Math (area, equation, zDir)
import Data.Drasil.Concepts.PhysicalProperties (len)
import Data.Drasil.Concepts.Physics (twoD, weight)
import Data.Drasil.Concepts.SolidMechanics (normForce, shearForce)
import Data.Drasil.Quantities.PhysicalProperties (specWeight)
import Data.Drasil.Quantities.Physics (displacement, force, height,
  pressure, torque)
import Data.Drasil.Theories.Physics (weightGD, hsPressureGD, torqueDD)
import Drasil.SSP.Assumptions (assumpFOSL, assumpSLH, assumpSP, assumpSLI,
  assumpINSFL, assumpPSC, assumpSBSBISL, assumpWIBE, assumpWISE, assumpNESSS,
  assumpHFSM)
import Drasil.SSP.BasicExprs (eqlExpr, eqlExprN, momExpr)
import Drasil.SSP.DataDefs (intersliceWtrF, angleA, angleB, lengthB, lengthLb,
  lengthLs, slcHeight, normStressDD, tangStressDD, ratioVariation)
import Drasil.SSP.Defs (intrslce, slice, slope, slopeSrf, slpSrf, soil,
  soilPrpty, waterTable)
import Drasil.SSP.Figures (figForceActing)
import Drasil.SSP.References (chen2005, fredlund1977, karchewski2012)
import Drasil.SSP.TMods (factOfSafety, equilibrium, mcShrStrgth, effStress)
import Drasil.SSP.Unitals (baseAngle, baseHydroForce, baseLngth, baseWthX,
  dryWeight, earthqkLoadFctr, effCohesion, fricAngle, fs, genericA, genericM,
  genericSpWght, impLoadAngle, intNormForce, intShrForce, index, inxi, inxiM1,
  midpntHght, mobShrI, momntArm, normToShear, nrmFSubWat, rotForce, satWeight,
  scalFunc, shearFNoIntsl, shrResI, shrStress, totNrmForce, shearRNoIntsl,
  slcWght, sliceHght, sliceHghtW, slipHght, slopeHght, surfHydroForce,
  surfAngle, surfLngth, surfLoad, watrForce, waterHght, waterWeight, dryVol,
  satVol, yi, zcoord)

---------------------------
--  General Definitions  --
---------------------------
generalDefinitions :: [GenDefn]
generalDefinitions :: [GenDefn]
generalDefinitions = [GenDefn
normForcEqGD, GenDefn
bsShrFEqGD, GenDefn
resShrGD, GenDefn
mobShrGD,
 GenDefn
effNormFGD, GenDefn
resShearWOGD, GenDefn
mobShearWOGD, GenDefn
normShrRGD, GenDefn
momentEqlGD, GenDefn
weightGD,
 GenDefn
sliceWghtGD, GenDefn
hsPressureGD, GenDefn
baseWtrFGD, GenDefn
srfWtrFGD]

normForcEqGD, bsShrFEqGD, resShrGD, mobShrGD, effNormFGD, resShearWOGD,
  mobShearWOGD, normShrRGD, momentEqlGD, sliceWghtGD, baseWtrFGD,
  srfWtrFGD :: GenDefn
normForcEqGD :: GenDefn
normForcEqGD = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
normForcEq) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
totNrmForce)   (forall a. a -> Maybe a
Just Derivation
nmFEqDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"normForcEq"  [Sentence
nmFEqDesc]
bsShrFEqGD :: GenDefn
bsShrFEqGD   = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
bsShrFEq)   (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
mobShrI)       (forall a. a -> Maybe a
Just Derivation
bShFEqDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"bsShrFEq"    [Sentence
bShFEqDesc]
resShrGD :: GenDefn
resShrGD     = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
resShr)     (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
shrResI)       (forall a. a -> Maybe a
Just Derivation
resShrDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"resShr"      [Sentence
resShrDesc]
mobShrGD :: GenDefn
mobShrGD     = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
mobShr)     (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
mobShrI)       (forall a. a -> Maybe a
Just Derivation
mobShrDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"mobShr"      [Sentence
mobShrDesc]
effNormFGD :: GenDefn
effNormFGD   = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
effNormF)   (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
nrmFSubWat)    (forall a. a -> Maybe a
Just Derivation
effNormFDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"effNormF"    [Sentence
effNormFDesc]
resShearWOGD :: GenDefn
resShearWOGD = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
resShearWO) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
shearRNoIntsl) forall a. Maybe a
Nothing
  (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef[Citation
chen2005, Citation
karchewski2012]) String
"resShearWO"  [Sentence
resShearWODesc]
mobShearWOGD :: GenDefn
mobShearWOGD = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
mobShearWO) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
shearFNoIntsl) forall a. Maybe a
Nothing
  (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef[Citation
chen2005, Citation
karchewski2012]) String
"mobShearWO"  [Sentence
mobShearWODesc]
normShrRGD :: GenDefn
normShrRGD   = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
normShrR)   (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
intShrForce)   forall a. Maybe a
Nothing
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"normShrR"    [Sentence
nmShrRDesc]
momentEqlGD :: GenDefn
momentEqlGD  = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd ModelKind ModelExpr
momentEqlModel        (forall a. a -> Maybe a
Just UnitDefn
newton)            (forall a. a -> Maybe a
Just Derivation
momEqlDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
chen2005]                      String
"momentEql"   [Sentence
momEqlDesc]
sliceWghtGD :: GenDefn
sliceWghtGD  = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
sliceWght)  (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
slcWght)       (forall a. a -> Maybe a
Just Derivation
sliceWghtDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977]                  String
"sliceWght"   [Sentence
sliceWghtNotes]
baseWtrFGD :: GenDefn
baseWtrFGD   = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
baseWtrF)   (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
baseHydroForce) (forall a. a -> Maybe a
Just Derivation
bsWtrFDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977]                  String
"baseWtrF"    [Sentence
bsWtrFNotes]
srfWtrFGD :: GenDefn
srfWtrFGD    = forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd (forall e. RelationConcept -> ModelKind e
othModel' RelationConcept
srfWtrF)    (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit UnitalChunk
surfHydroForce) (forall a. a -> Maybe a
Just Derivation
srfWtrFDeriv)
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977]                  String
"srfWtrF"     [Sentence
srfWtrFNotes]
--
normForcEq :: RelationConcept
normForcEq :: RelationConcept
normForcEq = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"normForcEq" (String -> NP
nounPhraseSP String
"normal force equilibrium")
  Sentence
nmFEqDesc Relation
nmFEqRel

nmFEqRel :: Relation
nmFEqRel :: Relation
nmFEqRel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
totNrmForce forall r. ExprC r => r -> r -> r
$= forall r.
(ExprC r, LiteralC r) =>
(r -> r) -> (r -> r) -> (r -> r -> r) -> r
eqlExprN forall r. ExprC r => r -> r
cos forall r. ExprC r => r -> r
sin
  (\Relation
x Relation
y -> Relation
x forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` Relation
y)

nmFEqDesc :: Sentence
nmFEqDesc :: Sentence
nmFEqDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This equation satisfies", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
equilibrium Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"in the normal direction", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
  [UnitalChunk
slcWght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
sliceWghtGD, UnitalChunk
surfHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
srfWtrFGD,
  UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB, UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA]]

nmFEqDeriv :: Derivation
nmFEqDeriv :: Derivation
nmFEqDeriv = [Sentence] -> Derivation
mkDerivNoHeader [[Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
atStart RelationConcept
normForcEq Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"derived from the free body diagram" Sentence -> Sentence -> Sentence
`S.of_`
  (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figForceActing Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.physSyst [] []))]]

--
bsShrFEq :: RelationConcept
bsShrFEq :: RelationConcept
bsShrFEq = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"bsShrFEq" (String -> NP
nounPhraseSP String
"base shear force equilibrium")
  Sentence
bShFEqDesc Relation
bShFEqRel

bShFEqRel :: Relation
bShFEqRel :: Relation
bShFEqRel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
mobShrI forall r. ExprC r => r -> r -> r
$= forall r.
(ExprC r, LiteralC r) =>
(r -> r) -> (r -> r) -> (r -> r -> r) -> r
eqlExpr forall r. ExprC r => r -> r
sin forall r. ExprC r => r -> r
cos
  (\Relation
x Relation
y -> Relation
x forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` Relation
y)

bShFEqDesc :: Sentence
bShFEqDesc :: Sentence
bShFEqDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This equation satisfies", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
equilibrium Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"in the shear direction", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [UnitalChunk
slcWght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
sliceWghtGD,
  UnitalChunk
surfHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
srfWtrFGD, UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB, 
  UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA]]

bShFEqDeriv :: Derivation
bShFEqDeriv :: Derivation
bShFEqDeriv = [Sentence] -> Derivation
mkDerivNoHeader [[Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
atStart RelationConcept
bsShrFEq Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"derived from the free body diagram" Sentence -> Sentence -> Sentence
`S.of_`
  (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figForceActing Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.physSyst [] []))]]
--
shrResEqn :: Expr
shrResEqn :: Relation
shrResEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
nrmFSubWat forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
fricAngle) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
effCohesion forall r. ExprC r => r -> r -> r
`mulRe`
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseLngth)

resShr :: RelationConcept
resShr :: RelationConcept
resShr = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"resShr" (String -> NP
nounPhraseSP String
"resistive shear force")
  Sentence
resShrDesc Relation
resShrRel -- genDef3Label

resShrRel :: Relation
resShrRel :: Relation
resShrRel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
shrResI forall r. ExprC r => r -> r -> r
$= Relation
shrResEqn

resShrDesc :: Sentence
resShrDesc :: Sentence
resShrDesc = [Sentence] -> Sentence
foldlSent [UnitalChunk
baseLngth forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthLb]

resShrDeriv :: Derivation
resShrDeriv :: Derivation
resShrDeriv = [Sentence] -> Derivation
mkDerivNoHeader [[Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Derived by substituting",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
normStressDD Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
tangStressDD, String -> Sentence
S String
"into the Mohr-Coulomb", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
shrStress Sentence -> Sentence -> Sentence
`sC`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
mcShrStrgth Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and multiplying both sides of the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"by",  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
genericA forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
slice) Sentence -> Sentence -> Sentence
`S.in_`
  String -> Sentence
S String
"the shear-" Sentence -> Sentence -> Sentence
:+: forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
zcoord Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"plane", String -> Sentence
S String
"Since", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slope),
  String -> Sentence
S String
"is assumed to extend infinitely in", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
zDir),
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the resulting", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
force,
  String -> Sentence
S String
"are expressed per", forall n. NamedIdea n => n -> Sentence
phrase UnitDefn
metre, String -> Sentence
S String
"in the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir, String -> Sentence
S String
"The",
  forall a. Quantity a => a -> Sentence
getTandS UncertQ
fricAngle Sentence -> Sentence -> Sentence
`S.andThe` forall a. Quantity a => a -> Sentence
getTandS UncertQ
effCohesion, String -> Sentence
S String
"are not indexed by",
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"because they are assumed to be isotropic",
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSLI) Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"is assumed to be",
  String -> Sentence
S String
"homogeneous, with", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constant, forall n. NamedIdea n => n -> Sentence
plural IdeaDict
soilPrpty, String -> Sentence
S String
"throughout",
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSLH Sentence -> Sentence -> Sentence
`sC` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSP)]]

--
mobShr :: RelationConcept
mobShr :: RelationConcept
mobShr = forall e c.
(Express e, Concept c) =>
c -> String -> e -> RelationConcept
addRelToCC UnitalChunk
mobShrI String
"mobShr" Relation
mobShrRel -- genDef4Label

mobShrRel :: Relation
mobShrRel :: Relation
mobShrRel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
mobShrI forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
shrResI forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
fs forall r. ExprC r => r -> r -> r
$= Relation
shrResEqn forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
fs

mobShrDesc :: Sentence
mobShrDesc :: Sentence
mobShrDesc = (UnitalChunk
baseLngth forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthLb !.)

mobShrDeriv :: Derivation
mobShrDeriv :: Derivation
mobShrDeriv = [Sentence] -> Derivation
mkDerivNoHeader [[Sentence] -> Sentence
foldlSent_ [forall n. NamedIdea n => n -> Sentence
atStart' UnitalChunk
mobShrI Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"derived by dividing",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
definition Sentence -> Sentence -> Sentence
`S.the_ofThe` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
shrResI, String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
resShrGD,
  String -> Sentence
S String
"by", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
definition forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConstrConcept
fs), String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
factOfSafety,
  String -> Sentence
S String
"The", forall a. Quantity a => a -> Sentence
getTandS ConstrConcept
fs, String -> Sentence
S String
"is not indexed by", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index,
  String -> Sentence
S String
"because it is assumed to be", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constant, String -> Sentence
S String
"for the entire",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
slpSrf Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpFOSL)]]

--
effNormF :: RelationConcept
effNormF :: RelationConcept
effNormF = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"effNormF"
  (String -> NP
nounPhraseSP String
"effective normal force") Sentence
effNormFDesc Relation
effNormFRel

effNormFRel :: Relation
effNormFRel :: Relation
effNormFRel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
nrmFSubWat forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
totNrmForce forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseHydroForce

effNormFDesc :: Sentence
effNormFDesc :: Sentence
effNormFDesc = (UnitalChunk
baseHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
baseWtrFGD !.)

effNormFDeriv :: Derivation
effNormFDeriv :: Derivation
effNormFDeriv = [Sentence] -> Derivation
mkDerivNoHeader [[Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Derived by substituting", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
normStressDD, String -> Sentence
S String
"into",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
effStress Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"multiplying both sides of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation),
  String -> Sentence
S String
"by", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
genericA forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
slice), String -> Sentence
S String
"in the shear-" Sentence -> Sentence -> Sentence
:+:
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
zcoord Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"plane", String -> Sentence
S String
"Since", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slope),
  String -> Sentence
S String
"is assumed to extend infinitely in", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
zDir),
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the resulting", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
force,
  String -> Sentence
S String
"are expressed per", forall n. NamedIdea n => n -> Sentence
phrase UnitDefn
metre, String -> Sentence
S String
"in", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
zDir)]]

-- 

normShrR :: ModelQDef
normShrR :: ModelQDef
normShrR = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
intShrForce PExpr
nmShrRExpr

nmShrRExpr :: PExpr
nmShrRExpr :: PExpr
nmShrRExpr = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
normToShear forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
scalFunc forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
intNormForce

nmShrRDesc :: Sentence
nmShrRDesc :: Sentence
nmShrRDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Mathematical representation of the primary",
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"for the Morgenstern-Price", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
method_ Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpINSFL), DefinedQuantityDict
scalFunc forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
ratioVariation]

--
resShearWO :: RelationConcept
resShearWO :: RelationConcept
resShearWO = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"resShearWO"
  (String -> NP
nounPhraseSP String
"resistive shear force, without interslice normal and shear forces") Sentence
resShearWODesc Relation
resShearWORel

resShearWORel :: Relation
resShearWORel :: Relation
resShearWORel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
shearRNoIntsl forall r. ExprC r => r -> r -> r
$=
  ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
cos (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle))) forall r. ExprC r => r -> r -> r
`mulRe`
  forall r. ExprC r => r -> r
cos (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle) forall r. ExprC r => r -> r -> r
`addRe` (forall r. ExprC r => r -> r
neg (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
watrForce) forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
watrForce forall r. ExprC r => r -> r -> r
`addRe`
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle)) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle) forall r. ExprC r => r -> r -> r
$-
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseHydroForce) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
fricAngle) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
effCohesion forall r. ExprC r => r -> r -> r
`mulRe`
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseLngth))

resShearWODesc :: Sentence
resShearWODesc :: Sentence
resShearWODesc = (SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [UnitalChunk
slcWght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
sliceWghtGD,
  UnitalChunk
surfHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
srfWtrFGD,
  UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB,
  UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA,
  UnitalChunk
watrForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
intersliceWtrF,
  UnitalChunk
baseHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
baseWtrFGD,
  UnitalChunk
baseLngth forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthLb] !.)

--
--
mobShearWO :: RelationConcept
mobShearWO :: RelationConcept
mobShearWO = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"mobShearWO"
  (String -> NP
nounPhraseSP String
"mobilized shear force, without interslice normal and shear forces") Sentence
mobShearWODesc Relation
mobShearWORel

mobShearWORel :: Relation
mobShearWORel :: Relation
mobShearWORel = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
shearFNoIntsl forall r. ExprC r => r -> r -> r
$= ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
`mulRe`
  forall r. ExprC r => r -> r
cos (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle))) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle) forall r. ExprC r => r -> r -> r
$- ((forall r. ExprC r => r -> r
neg (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
watrForce) forall r. ExprC r => r -> r -> r
`addRe`
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
watrForce forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle))) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
cos (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)))

mobShearWODesc :: Sentence
mobShearWODesc :: Sentence
mobShearWODesc = (SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [UnitalChunk
slcWght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
sliceWghtGD,
  UnitalChunk
surfHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
srfWtrFGD,
  UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB,
  UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA,
  UnitalChunk
watrForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
intersliceWtrF] !.)

--
momentEqlModel :: ModelKind ModelExpr
momentEqlModel :: ModelKind ModelExpr
momentEqlModel = forall e. ConstraintSet e -> ModelKind e
equationalConstraints' forall a b. (a -> b) -> a -> b
$
  forall e. ConceptChunk -> NonEmpty e -> ConstraintSet e
mkConstraintSet (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"momentEql" (String -> NP
nounPhraseSP String
"moment equilibrium") Sentence
momEqlDesc) forall a b. (a -> b) -> a -> b
$
  forall a. [a] -> NonEmpty a
NE.fromList [forall c. Express c => c -> ModelExpr
express Relation
momEqlExpr]

momEqlExpr :: Expr
momEqlExpr :: Relation
momEqlExpr = forall r. LiteralC r => Integer -> r
exactDbl Integer
0 forall r. ExprC r => r -> r -> r
$= forall r. (ExprC r, LiteralC r) => (r -> r -> r) -> r
momExpr (\ Relation
x Relation
y -> Relation
x forall r. ExprC r => r -> r -> r
`addRe`
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intShrForce)) forall r. ExprC r => r -> r -> r
`addRe` Relation
y)

momEqlDesc :: Sentence
momEqlDesc :: Sentence
momEqlDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"satisfies",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
equilibrium, String -> Sentence
S String
"for the net" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
genericM,
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [UnitalChunk
baseWthX forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthB,
  UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA,
  UnitalChunk
slcWght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
sliceWghtGD,
  UnitalChunk
midpntHght forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
slcHeight,
  UnitalChunk
surfHydroForce forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` GenDefn
srfWtrFGD,
  UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB]]

momEqlDeriv :: Derivation
momEqlDeriv :: Derivation
momEqlDeriv = [Sentence] -> Derivation
mkDerivNoHeader (forall a. [[a]] -> [a]
weave [[Sentence]
momEqlDerivSentences, [Sentence]
momEqlDerivEqns])

momEqlDerivSentences :: [Sentence]
momEqlDerivSentences :: [Sentence]
momEqlDerivSentences = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSentCol [[Sentence]
momEqlDerivTorqueSentence,
  [Sentence]
momEqlDerivMomentSentence, [Sentence]
momEqlDerivNormaliSentence,
  [Sentence]
momEqlDerivNormaliM1Sentence, [Sentence]
momEqlDerivWateriSentence,
  [Sentence]
momEqlDerivWateriM1Sentence, [Sentence]
momEqlDerivSheariSentence,
  [Sentence]
momEqlDerivSheariM1Sentence, [Sentence]
momEqlDerivSeismicIntSentence,
  [Sentence]
momEqlDerivSeismicSentence, [Sentence]
momEqlDerivSeismicWSentence,
  [Sentence]
momEqlDerivHydroSentence, [Sentence]
momEqlDerivExtSentence, [Sentence]
momEqlDerivFinalSentence]

momEqlDerivEqns :: [Sentence]
momEqlDerivEqns :: [Sentence]
momEqlDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [PExpr
momEqlDerivTorqueEqn, PExpr
momEqlDerivMomentEqn,
  PExpr
momEqlDerivNormaliEqn, PExpr
momEqlDerivNormaliM1Eqn, PExpr
momEqlDerivWateriEqn,
  PExpr
momEqlDerivWateriM1Eqn, PExpr
momEqlDerivSheariEqn,
  PExpr
momEqlDerivSheariM1Eqn, PExpr
momEqlDerivSeismicIntEqn,
  PExpr
momEqlDerivSeismicEqn, PExpr
momEqlDerivSeismicWEqn,
  PExpr
momEqlDerivHydroEqn, PExpr
momEqlDerivExtEqn,
  PExpr
momEqlDerivFinalEqn]

momEqlDerivTorqueSentence, momEqlDerivMomentSentence,
  momEqlDerivNormaliSentence, momEqlDerivNormaliM1Sentence,
  momEqlDerivWateriSentence, momEqlDerivWateriM1Sentence,
  momEqlDerivSheariSentence, momEqlDerivSheariM1Sentence,
  momEqlDerivSeismicIntSentence, momEqlDerivSeismicSentence,
  momEqlDerivSeismicWSentence, momEqlDerivHydroSentence,
  momEqlDerivExtSentence, momEqlDerivFinalSentence :: [Sentence]

momEqlDerivTorqueEqn, momEqlDerivMomentEqn,
  momEqlDerivNormaliEqn, momEqlDerivNormaliM1Eqn, momEqlDerivWateriEqn,
  momEqlDerivWateriM1Eqn, momEqlDerivSheariEqn,
  momEqlDerivSheariM1Eqn, momEqlDerivSeismicIntEqn,
  momEqlDerivSeismicEqn, momEqlDerivSeismicWEqn,
  momEqlDerivHydroEqn, momEqlDerivExtEqn,
  momEqlDerivFinalEqn :: PExpr

momEqlDerivTorqueSentence :: [Sentence]
momEqlDerivTorqueSentence = [forall n. NamedIdea n => n -> Sentence
atStart UnitalChunk
genericM, String -> Sentence
S String
"is equal to",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
torque Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation), String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
torqueDD,
  String -> Sentence
S String
"will be used to calculate", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
genericM]

momEqlDerivMomentSentence :: [Sentence]
momEqlDerivMomentSentence = [String -> Sentence
S String
"Considering one dimension, with",
  forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
genericM, String -> Sentence
S String
"in the clockwise direction as positive and",
  forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
genericM, String -> Sentence
S String
"in the counterclockwise direction as negative" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"and replacing", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
torque), String -> Sentence
S String
"symbol with", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM),
  String -> Sentence
S String
"symbol,", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation), String -> Sentence
S String
"simplifies to"]

momEqlDerivNormaliSentence :: [Sentence]
momEqlDerivNormaliSentence = [String -> Sentence
S String
"where", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
rotForce Sentence -> Sentence -> Sentence
`S.isThe`
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
rotForce Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
momntArm Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momntArm Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"or the distance between", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
force) Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"axis about" Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"which the rotation acts",
  String -> Sentence
S String
"To represent", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the GenDefn
momentEqlGD) Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM),
  String -> Sentence
S String
"from each", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, String -> Sentence
S String
"acting on a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"must be considered and added together", forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the UnitalChunk
force),
  String -> Sentence
S String
"acting on a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"are all shown in" Sentence -> Sentence -> Sentence
+:+.
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figForceActing,
  String -> Sentence
S String
"The midpoint of the base of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"is considered as the",
  String -> Sentence
S String
"axis of rotation, from which", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
momntArm) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is measured",
  String -> Sentence
S String
"Considering first", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
intrslce ConceptChunk
normForce)),
  String -> Sentence
S String
"acting on", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is negative because", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
force),
  String -> Sentence
S String
"tends to rotate", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"in a counterclockwise",
  String -> Sentence
S String
"direction" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
momntArm) Sentence -> Sentence -> Sentence
`S.is` forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe`
  UnitalChunk
force), String -> Sentence
S String
"plus the difference in height between the base at",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"base at the midpoint of",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
+:+. forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index,
  String -> Sentence
S String
"Thus,", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is expressed as"]

momEqlDerivNormaliM1Sentence :: [Sentence]
momEqlDerivNormaliM1Sentence = [String -> Sentence
S String
"For the", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int Integer
1) Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"th",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface" Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM) Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"similar but in the opposite direction"]

momEqlDerivWateriSentence :: [Sentence]
momEqlDerivWateriSentence = [String -> Sentence
S String
"Next,", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
intrslce), String -> Sentence
S String
"normal water",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is considered", String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, String -> Sentence
S String
"is zero at",
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
waterTable) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"then increases linearly towards",
  String -> Sentence
S String
"base" Sentence -> Sentence -> Sentence
`S.the_ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"due to the increasing water" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pressure, String -> Sentence
S String
"For such a triangular distribution, the resultant",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"acts at one-third of the height", String -> Sentence
S String
"Thus, for the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intrslce, String -> Sentence
S String
"normal water", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, String -> Sentence
S String
"acting on", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is"]

momEqlDerivWateriM1Sentence :: [Sentence]
momEqlDerivWateriM1Sentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"for the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intrslce, String -> Sentence
S String
"normal water", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, String -> Sentence
S String
"acting on", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"interface", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int Integer
1), String -> Sentence
S String
"is"]

momEqlDerivSheariSentence :: [Sentence]
momEqlDerivSheariSentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
intrslce), forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
shearForce,
  String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"tends to rotate in the",
  String -> Sentence
S String
"clockwise direction, and", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (UnitalChunk
momntArm forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`isThe` ConceptChunk
len)),
  String -> Sentence
S String
"from", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"edge to", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"equivalent to half of", String -> Sentence
S String
"width" Sentence -> Sentence -> Sentence
`S.the_ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
genericM, String -> Sentence
S String
"is"]

momEqlDerivSheariM1Sentence :: [Sentence]
momEqlDerivSheariM1Sentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
intrslce ConceptChunk
shearForce)),
  String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int Integer
1), String -> Sentence
S String
"also tends to",
  String -> Sentence
S String
"rotate in the clockwise direction, and has the same", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momntArm Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"so", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is"]

-- FIXME: Once differentials are expressible in Expr (issue #1407), change "sy yi" to the differential dy. "ch yi" actually means y and should stay as-is.
momEqlDerivSeismicIntSentence :: [Sentence]
momEqlDerivSeismicIntSentence = [String -> Sentence
S String
"Seismic", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
force, String -> Sentence
S String
"act over the",
  String -> Sentence
S String
"entire height of the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"For each horizontal segment"
  Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the seismic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force Sentence -> Sentence -> Sentence
`S.is`
  ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
earthqkLoadFctr forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght), String -> Sentence
S String
"where", ModelExpr -> Sentence
eS (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght),
  String -> Sentence
S String
"can be expressed as", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericSpWght forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yi),
  String -> Sentence
S String
"using", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
weightGD, String -> Sentence
S String
"where", forall t. Express t => t -> Sentence
eS' UnitalChunk
yi, String -> Sentence
S String
"is the height of" Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"the segment under consideration", String -> Sentence
S String
"The corresponding", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momntArm Sentence -> Sentence -> Sentence
`S.is`
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
yi Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the height from the base of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice) Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"to the segment under consideration", String -> Sentence
S String
"In reality,", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
force),
  String -> Sentence
S String
"near the surface of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
soil), String -> Sentence
S String
"mass are slightly different",
  String -> Sentence
S String
"due to the slope of the surface, but this difference is assumed to be",
  String -> Sentence
S String
"negligible" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpNESSS), String -> Sentence
S String
"The resultant",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
genericM, String -> Sentence
S String
"from", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
force), String -> Sentence
S String
"on all of the segments",
  String -> Sentence
S String
"with an equivalent resultant", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momntArm, String -> Sentence
S String
"is determined by",
  String -> Sentence
S String
"taking the integral over" Sentence -> Sentence -> Sentence
+:+. forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
slice UnitalChunk
height)), forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the UnitalChunk
force), 
  String -> Sentence
S String
"tend to rotate in the counterclockwise direction, so the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
genericM, String -> Sentence
S String
"is negative"]

momEqlDerivSeismicSentence :: [Sentence]
momEqlDerivSeismicSentence = [String -> Sentence
S String
"Solving the definite integral yields"]

momEqlDerivSeismicWSentence :: [Sentence]
momEqlDerivSeismicWSentence = [String -> Sentence
S String
"Using", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
weightGD,
  String -> Sentence
S String
"again to express", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericSpWght forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght),
  String -> Sentence
S String
"as", ModelExpr -> Sentence
eS (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght) Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is"]

momEqlDerivHydroSentence :: [Sentence]
momEqlDerivHydroSentence = [String -> Sentence
S String
"The surface hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force,
  String -> Sentence
S String
"acts into the midpoint of the surface of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice) Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpHFSM),
  String -> Sentence
S String
"Thus, the vertical", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
component forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` UnitalChunk
force),
  String -> Sentence
S String
"acts directly towards the point of rotation, and has a",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
genericM Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"of zero", String -> Sentence
S String
"The horizontal", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
component
  forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` UnitalChunk
force), String -> Sentence
S String
"tends to rotate in a clockwise direction" Sentence -> Sentence -> Sentence
`S.and_`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
momntArm), String -> Sentence
S String
"is the entire height of the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"Thus,", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is"]

momEqlDerivExtSentence :: [Sentence]
momEqlDerivExtSentence = [String -> Sentence
S String
"The external", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, String -> Sentence
S String
"again acts into",
  String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
`S.the_ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"surface, so the vertical",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, String -> Sentence
S String
"does not contribute to", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"and", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
momntArm), String -> Sentence
S String
"is again the entire height of the" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM), String -> Sentence
S String
"is"]

momEqlDerivFinalSentence :: [Sentence]
momEqlDerivFinalSentence = [String -> Sentence
S String
"The base hydrostatic", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
  IdeaDict
slice), forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
weight, String -> Sentence
S String
"both act in the direction of the point of",
  String -> Sentence
S String
"rotation", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpHFSM) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"therefore both have",
  forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
genericM Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"of zero", String -> Sentence
S String
"Thus, all of", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
genericM) Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"have been determined", forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the GenDefn
momentEqlGD) Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"then represented by the sum of all", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
genericM]

momEqlDerivTorqueEqn :: PExpr
momEqlDerivTorqueEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
torque forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => r -> r -> r
cross (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
displacement) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
force)

momEqlDerivMomentEqn :: PExpr
momEqlDerivMomentEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericM forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
rotForce forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
momntArm

momEqlDerivNormaliEqn :: PExpr
momEqlDerivNormaliEqn = forall r. ExprC r => r -> r
neg (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intNormForce) forall r. ExprC r => r -> r -> r
`mulRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
sliceHght forall r. ExprC r => r -> r -> r
`addRe`
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)))

momEqlDerivNormaliM1Eqn :: PExpr
momEqlDerivNormaliM1Eqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intNormForce forall r. ExprC r => r -> r -> r
`mulRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
sliceHght forall r. ExprC r => r -> r -> r
$-
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)))

momEqlDerivWateriEqn :: PExpr
momEqlDerivWateriEqn = forall r. ExprC r => r -> r
neg (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
watrForce) forall r. ExprC r => r -> r -> r
`mulRe` (forall r. (ExprC r, LiteralC r) => Integer -> Integer -> r
frac Integer
1 Integer
3 forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
sliceHghtW forall r. ExprC r => r -> r -> r
`addRe`
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)))

momEqlDerivWateriM1Eqn :: PExpr
momEqlDerivWateriM1Eqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
watrForce forall r. ExprC r => r -> r -> r
`mulRe` (forall r. (ExprC r, LiteralC r) => Integer -> Integer -> r
frac Integer
1 Integer
3 forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
sliceHghtW forall r. ExprC r => r -> r -> r
`addRe`
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
tan (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)))

momEqlDerivSheariEqn :: PExpr
momEqlDerivSheariEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX)

momEqlDerivSheariM1Eqn :: PExpr
momEqlDerivSheariM1Eqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX)

momEqlDerivSeismicIntEqn :: PExpr
momEqlDerivSeismicIntEqn = forall r. ExprC r => r -> r
neg forall a b. (a -> b) -> a -> b
$ forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
yi) (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght)
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
earthqkLoadFctr forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericSpWght forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yi)

momEqlDerivSeismicEqn :: PExpr
momEqlDerivSeismicEqn = forall r. ExprC r => r -> r
neg forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
earthqkLoadFctr forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericSpWght forall r. ExprC r => r -> r -> r
`mulRe`
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` forall r. (ExprC r, LiteralC r) => r -> r
half (forall r. (ExprC r, LiteralC r) => r -> r
square (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght))

momEqlDerivSeismicWEqn :: PExpr
momEqlDerivSeismicWEqn = forall r. ExprC r => r -> r
neg forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
earthqkLoadFctr forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
`mulRe`
  forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght)

momEqlDerivHydroEqn :: PExpr
momEqlDerivHydroEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle) forall r. ExprC r => r -> r -> r
`mulRe`
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght

momEqlDerivExtEqn :: PExpr
momEqlDerivExtEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfLoad forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
impLoadAngle) forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
midpntHght

momEqlDerivFinalEqn :: PExpr
momEqlDerivFinalEqn = forall r. LiteralC r => Integer -> r
exactDbl Integer
0 forall r. ExprC r => r -> r -> r
$= forall r. (ExprC r, LiteralC r) => (r -> r -> r) -> r
momExpr (\ r
x r
y -> r
x forall r. ExprC r => r -> r -> r
`addRe`
  (forall r. (ExprC r, LiteralC r) => r -> r
half (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX) forall r. ExprC r => r -> r -> r
`mulRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intShrForce forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intShrForce)) forall r. ExprC r => r -> r -> r
`addRe` r
y)

--

sliceWght :: RelationConcept
sliceWght :: RelationConcept
sliceWght = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"sliceWght" (String -> NP
nounPhraseSP String
"slice weight") Sentence
sliceWghtNotes
  Relation
sliceWghtEqn

sliceWghtEqn :: Expr
sliceWghtEqn :: Relation
sliceWghtEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => [(r, r)] -> r
completeCase [(Relation, Relation)
case1, (Relation, Relation)
case2, (Relation, Relation)
case3]
  where case1 :: (Relation, Relation)
case1 = (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight,
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght) forall r. ExprC r => r -> r -> r
$||
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght))
        case2 :: (Relation, Relation)
case2 = (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight forall r. ExprC r => r -> r -> r
`addRe`
          (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight),
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$>= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$>= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
$&&
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$>= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$>= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght))
        case3 :: (Relation, Relation)
case3 = (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight,
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$< forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
$||
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$< forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght))

sliceWghtNotes :: Sentence
sliceWghtNotes :: Sentence
sliceWghtNotes = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is based on the",
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"that the surface and the base of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"are straight lines" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSBSBISL), String -> Sentence
S String
"The",
  forall a. Quantity a => a -> Sentence
getTandS UncertQ
dryWeight Sentence -> Sentence -> Sentence
`S.andThe` forall a. Quantity a => a -> Sentence
getTandS UncertQ
satWeight, String -> Sentence
S String
"are not indexed by",
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"because", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
soil), String -> Sentence
S String
"is assumed to be homogeneous" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"with", forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
constant IdeaDict
soilPrpty), String -> Sentence
S String
"throughout" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSLH), UnitalChunk
baseWthX forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthB]

sliceWghtDeriv :: Derivation
sliceWghtDeriv :: Derivation
sliceWghtDeriv = [Sentence] -> Derivation
mkDerivNoHeader (forall a. [[a]] -> [a]
weave [[Sentence]
sliceWghtDerivSentences, [Sentence]
sliceWghtDerivEqns])

sliceWghtDerivEqns :: [Sentence]
sliceWghtDerivEqns :: [Sentence]
sliceWghtDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [PExpr
sliceWghtDerivSatCaseWeightEqn,
  PExpr
sliceWghtDerivSatCaseSliceEqn, PExpr
sliceWghtDerivDryCaseWeightEqn,
  PExpr
sliceWghtDerivDryCaseSliceEqn, PExpr
sliceWghtDerivMixCaseWeightEqn,
  PExpr
sliceWghtDerivMixCaseSliceEqn]

sliceWghtDerivSentences :: [Sentence]
sliceWghtDerivSentences :: [Sentence]
sliceWghtDerivSentences = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSentCol [[Sentence]
sliceWghtDerivSatCaseIntroSentence,
  [Sentence]
sliceWghtDerivSatCase2DSentence, [Sentence]
sliceWghtDerivDryCaseIntroSentence,
  [Sentence]
sliceWghtDerivDryCase2DSentence, [Sentence]
sliceWghtDerivMixCaseIntroSentence,
  [Sentence]
sliceWghtDerivMixCase2DSentence]

sliceWghtDerivSatCaseIntroSentence, sliceWghtDerivSatCase2DSentence,
  sliceWghtDerivDryCaseIntroSentence, sliceWghtDerivDryCase2DSentence,
  sliceWghtDerivMixCaseIntroSentence,
  sliceWghtDerivMixCase2DSentence :: [Sentence]

sliceWghtDerivSatCaseWeightEqn, sliceWghtDerivSatCaseSliceEqn,
  sliceWghtDerivDryCaseWeightEqn, sliceWghtDerivDryCaseSliceEqn,
  sliceWghtDerivMixCaseWeightEqn, sliceWghtDerivMixCaseSliceEqn :: PExpr

sliceWghtDerivSatCaseIntroSentence :: [Sentence]
sliceWghtDerivSatCaseIntroSentence = [String -> Sentence
S String
"For the case where the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable, String -> Sentence
S String
"is above", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slopeSrf) Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght), String -> Sentence
S String
"come from", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
weight Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"saturated" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil,
  String -> Sentence
S String
"Substituting", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"for saturated", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"into the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
equation forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` ConceptChunk
weight), String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
weightGD,
  String -> Sentence
S String
"yields"]

sliceWghtDerivSatCase2DSentence :: [Sentence]
sliceWghtDerivSatCase2DSentence = [String -> Sentence
S String
"Due to", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"only two dimensions are considered, so", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
area) Sentence -> Sentence -> Sentence
`S.of_`
  String -> Sentence
S String
"saturated", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"are considered instead of the" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
satVol,
  String -> Sentence
S String
"Any given", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"has a trapezoidal shape",
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
area), String -> Sentence
S String
"of a trapezoid is the average of",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
len Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"parallel sides multiplied by", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
len) Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"between the parallel sides", String -> Sentence
S String
"The parallel sides in this case are the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intrslce, String -> Sentence
S String
"edges and", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
len), String -> Sentence
S String
"between them" Sentence -> Sentence -> Sentence
`S.isThe`
  String -> Sentence
S String
"width of the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"Thus" Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght),
  String -> Sentence
S String
"are defined as"]

sliceWghtDerivSatCaseWeightEqn :: PExpr
sliceWghtDerivSatCaseWeightEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
satVol forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight

sliceWghtDerivSatCaseSliceEqn :: PExpr
sliceWghtDerivSatCaseSliceEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe`
  ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight

sliceWghtDerivDryCaseIntroSentence :: [Sentence]
sliceWghtDerivDryCaseIntroSentence = [String -> Sentence
S String
"For the case where the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable, String -> Sentence
S String
"is below", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
slpSrf) Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght), String -> Sentence
S String
"come from", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
weight Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"dry" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil,
  String -> Sentence
S String
"Substituting", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"for dry", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"into the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
equation forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` ConceptChunk
weight), String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
weightGD,
  String -> Sentence
S String
"yields"]

sliceWghtDerivDryCase2DSentence :: [Sentence]
sliceWghtDerivDryCase2DSentence = [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC, String -> Sentence
S String
"again allows for",
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI CI
twoD IdeaDict
analysis), String -> Sentence
S String
"so", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
area) Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"dry",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"are considered instead of the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
dryVol,
  String -> Sentence
S String
"The trapezoidal", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"shape is the same as in the previous case" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght),
  String -> Sentence
S String
"are defined as"]

sliceWghtDerivDryCaseWeightEqn :: PExpr
sliceWghtDerivDryCaseWeightEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
dryVol forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight

sliceWghtDerivDryCaseSliceEqn :: PExpr
sliceWghtDerivDryCaseSliceEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe`
  ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight

sliceWghtDerivMixCaseIntroSentence :: [Sentence]
sliceWghtDerivMixCaseIntroSentence = [String -> Sentence
S String
"For the case where the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable, String -> Sentence
S String
"is between", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (IdeaDict
slopeSrf forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
  ConceptChunk
slpSrf)) Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght), String -> Sentence
S String
"are the sums of",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
weight Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"dry portions"  Sentence -> Sentence -> Sentence
`S.and_` forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
weight Sentence -> Sentence -> Sentence
`S.ofThe`
  String -> Sentence
S String
"saturated portions of the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil,
  String -> Sentence
S String
"Substituting", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"for dry and saturated", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil,
  String -> Sentence
S String
"into", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
equation forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` ConceptChunk
weight)),
  String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
weightGD, String -> Sentence
S String
"and adding them together yields"]

sliceWghtDerivMixCase2DSentence :: [Sentence]
sliceWghtDerivMixCase2DSentence = [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC, String -> Sentence
S String
"again allows for",
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI CI
twoD IdeaDict
analysis), String -> Sentence
S String
"so", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
area) Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"dry",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil Sentence -> Sentence -> Sentence
`S.and_` forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
area Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"saturated", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil,
  String -> Sentence
S String
"are considered instead of the" Sentence -> Sentence -> Sentence
+:+. forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
dryVol forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
satVol),
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
waterTable), String -> Sentence
S String
"is assumed to only intersect a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"surface or base at a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"edge",
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWISE Sentence -> Sentence -> Sentence
`sC` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWIBE) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so the" Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"dry and saturated portions each have trapezoidal shape", String -> Sentence
S String
"For the dry",
  String -> Sentence
S String
"portion, the parallel sides of the trapezoid are", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
len),
  String -> Sentence
S String
"between", forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (IdeaDict
slopeSrf forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
waterTable)), String -> Sentence
S String
"at the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"edges", String -> Sentence
S String
"For the saturated portion, the parallel",
  String -> Sentence
S String
"sides of the trapezoid are", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
len), String -> Sentence
S String
"between the",
  forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
waterTable forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
slpSrf), String -> Sentence
S String
"at", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice) Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"edges", String -> Sentence
S String
"Thus" Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
slcWght),  String -> Sentence
S String
"are defined as"]

sliceWghtDerivMixCaseWeightEqn :: PExpr
sliceWghtDerivMixCaseWeightEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
dryVol forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight forall r. ExprC r => r -> r -> r
`addRe`
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
satVol forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight)

sliceWghtDerivMixCaseSliceEqn :: PExpr
sliceWghtDerivMixCaseSliceEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slcWght forall r. ExprC r => r -> r -> r
$= (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseWthX forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe`
  (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght) forall r. ExprC r => r -> r -> r
`addRe`
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
dryWeight forall r. ExprC r => r -> r -> r
`addRe`
  (((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe`
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
satWeight)))

-- 

baseWtrF :: RelationConcept
baseWtrF :: RelationConcept
baseWtrF = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"baseWtrF" (String -> NP
nounPhraseSP String
"base hydrostatic force")
  Sentence
bsWtrFNotes Relation
bsWtrFEqn

bsWtrFEqn :: Expr
bsWtrFEqn :: Relation
bsWtrFEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseHydroForce forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseLngth forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe`
  forall r. ExprC r => [(r, r)] -> r
completeCase [(Relation, Relation)
case1, (Relation, Relation)
case2]
  where case1 :: (Relation, Relation)
case1 = ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght),
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
$||
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght))
        case2 :: (Relation, Relation)
case2 = (forall r. LiteralC r => Integer -> r
exactDbl Integer
0, (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$<= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
$&&
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$<= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght))

bsWtrFNotes :: Sentence
bsWtrFNotes :: Sentence
bsWtrFNotes = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is based on the",
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"that the base of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"is a straight line" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSBSBISL),
  UnitalChunk
baseLngth forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthLb]

bsWtrFDeriv :: Derivation
bsWtrFDeriv :: Derivation
bsWtrFDeriv = [Sentence] -> Derivation
mkDerivNoHeader (forall a. [[a]] -> [a]
weave [[Sentence]
bsWtrFDerivSentences, [Sentence]
bsWtrFDerivEqns] forall a. [a] -> [a] -> [a]
++
  [Sentence]
bsWtrFDerivEndSentence)

bsWtrFDerivEqns :: [Sentence]
bsWtrFDerivEqns :: [Sentence]
bsWtrFDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [PExpr
bsWtrFDerivWeightEqn, PExpr
bsWtrFDerivHeightEqn,
  PExpr
bsWtrFDerivSliceEqn]

bsWtrFDerivSentences :: [Sentence]
bsWtrFDerivSentences :: [Sentence]
bsWtrFDerivSentences = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSentCol [[Sentence]
bsWtrFDerivIntroSentence,
  [Sentence]
bsWtrFDerivHeightSentence, [Sentence]
bsWtrFDeriv2DSentence]

bsWtrFDerivIntroSentence, bsWtrFDerivHeightSentence, bsWtrFDeriv2DSentence,
  bsWtrFDerivEndSentence :: [Sentence]

bsWtrFDerivWeightEqn, bsWtrFDerivHeightEqn, bsWtrFDerivSliceEqn :: PExpr

bsWtrFDerivIntroSentence :: [Sentence]
bsWtrFDerivIntroSentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
baseHydroForce), String -> Sentence
S String
"come from the",
  String -> Sentence
S String
"hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pressure, String -> Sentence
S String
"exerted by the water above the base of",
  String -> Sentence
S String
"each" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation), String -> Sentence
S String
"for hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pressure,
  String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
hsPressureGD, String -> Sentence
S String
"is"]

bsWtrFDerivHeightSentence :: [Sentence]
bsWtrFDerivHeightSentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
specWeight), String -> Sentence
S String
"in this case is",
  String -> Sentence
S String
"the" Sentence -> Sentence -> Sentence
+:+. forall a. Quantity a => a -> Sentence
getTandS UncertQ
waterWeight,
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
height), String -> Sentence
S String
"in this case is the height from", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice),
  String -> Sentence
S String
"base to the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable,
  String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"is measured from", String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
`S.the_ofThe`
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"because the resultant hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force,
  String -> Sentence
S String
"is assumed to act at", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpHFSM),
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
height), String -> Sentence
S String
"at the midpoint is the average of the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`S.andThe`
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int Integer
1)]

bsWtrFDeriv2DSentence :: [Sentence]
bsWtrFDeriv2DSentence = [String -> Sentence
S String
"Due to", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"only two dimensions are considered, so", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
baseHydroForce),
  String -> Sentence
S String
"are expressed as", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
force Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"per meter",
  forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the UnitalChunk
pressure), String -> Sentence
S String
"acting on", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"can thus be converted",
  String -> Sentence
S String
"to", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
baseHydroForce, String -> Sentence
S String
"by multiplying by the corresponding",
  forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
len forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
slice), String -> Sentence
S String
"base", ModelExpr -> Sentence
eS (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseLngth) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"assuming", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
waterTable), String -> Sentence
S String
"does not intersect a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"base except at a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"edge" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWIBE),
  String -> Sentence
S String
"Thus, in the case where", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
waterTable),
  String -> Sentence
S String
"is above", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
slpSrf) Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
baseHydroForce), String -> Sentence
S String
"are defined as"]

bsWtrFDerivEndSentence :: [Sentence]
bsWtrFDerivEndSentence = [[Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"the non-zero case of" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
baseWtrFGD,
  String -> Sentence
S String
"The zero case is when", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
waterTable),
  String -> Sentence
S String
"is below", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
slpSrf) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so there is no",
  String -> Sentence
S String
"hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force]]

bsWtrFDerivWeightEqn :: PExpr
bsWtrFDerivWeightEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pressure forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
specWeight forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
height

bsWtrFDerivHeightEqn :: PExpr
bsWtrFDerivHeightEqn = PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe` ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
slipHght))

bsWtrFDerivSliceEqn :: PExpr
bsWtrFDerivSliceEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseHydroForce forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseLngth forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight forall r. ExprC r => r -> r -> r
`mulRe`
  PExpr
bsWtrFDerivHeightEqn

--

srfWtrF :: RelationConcept
srfWtrF :: RelationConcept
srfWtrF = forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
"srfWtrF" (String -> NP
nounPhraseSP String
"surface hydrostatic force")
  Sentence
srfWtrFNotes Relation
srfWtrFEqn

srfWtrFEqn :: Relation
srfWtrFEqn :: Relation
srfWtrFEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfLngth forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight forall r. ExprC r => r -> r -> r
`mulRe` PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe`
  forall r. ExprC r => [(r, r)] -> r
completeCase [(Relation, Relation)
case1, (Relation, Relation)
case2]
  where case1 :: (Relation, Relation)
case1 = ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght) forall r. ExprC r => r -> r -> r
`addRe`
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght),
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght) forall r. ExprC r => r -> r -> r
$||
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght))
        case2 :: (Relation, Relation)
case2 = (forall r. LiteralC r => Integer -> r
exactDbl Integer
0, (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$<= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght) forall r. ExprC r => r -> r -> r
$&&
          (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$<= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght))

srfWtrFNotes :: Sentence
srfWtrFNotes :: Sentence
srfWtrFNotes = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is based on the",
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"that the surface of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"is a straight line" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSBSBISL), 
  UnitalChunk
surfLngth forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
lengthLs]

srfWtrFDeriv :: Derivation
srfWtrFDeriv :: Derivation
srfWtrFDeriv = [Sentence] -> Derivation
mkDerivNoHeader (forall a. [[a]] -> [a]
weave [[Sentence]
srfWtrFDerivSentences, [Sentence]
srfWtrFDerivEqns] forall a. [a] -> [a] -> [a]
++
  [Sentence]
srfWtrFDerivEndSentence)

srfWtrFDerivEqns :: [Sentence]
srfWtrFDerivEqns :: [Sentence]
srfWtrFDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [PExpr
srfWtrFDerivWeightEqn, PExpr
srfWtrFDerivHeightEqn,
  PExpr
srfWtrFDerivSliceEqn]

srfWtrFDerivSentences :: [Sentence]
srfWtrFDerivSentences :: [Sentence]
srfWtrFDerivSentences = forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSentCol [[Sentence]
srfWtrFDerivIntroSentence,
  [Sentence]
srfWtrFDerivHeightSentence, [Sentence]
srfWtrFDeriv2DSentence]

srfWtrFDerivIntroSentence, srfWtrFDerivHeightSentence, srfWtrFDeriv2DSentence,
  srfWtrFDerivEndSentence :: [Sentence]

srfWtrFDerivWeightEqn, srfWtrFDerivHeightEqn, srfWtrFDerivSliceEqn :: PExpr

srfWtrFDerivIntroSentence :: [Sentence]
srfWtrFDerivIntroSentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
surfHydroForce), String -> Sentence
S String
"come from the",
  String -> Sentence
S String
"hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pressure, String -> Sentence
S String
"exerted by the water above the surface",
  String -> Sentence
S String
"of each" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
equation), String -> Sentence
S String
"for hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
pressure, String -> Sentence
S String
"from",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
hsPressureGD, String -> Sentence
S String
"is"]

srfWtrFDerivHeightSentence :: [Sentence]
srfWtrFDerivHeightSentence = [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
specWeight), String -> Sentence
S String
"in this case is",
  String -> Sentence
S String
"the" Sentence -> Sentence -> Sentence
+:+. forall a. Quantity a => a -> Sentence
getTandS UncertQ
waterWeight,
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
height), String -> Sentence
S String
"in this case is the height from", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice),
  String -> Sentence
S String
"surface to the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable,
  String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"is measured from", String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
`S.the_ofThe`
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"because the resultant hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force,
  String -> Sentence
S String
"is assumed to act at", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpHFSM),
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
height), String -> Sentence
S String
"at the midpoint is the average of the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`S.andThe`
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
height, String -> Sentence
S String
"at", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"interface", ModelExpr -> Sentence
eS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int Integer
1)]

srfWtrFDeriv2DSentence :: [Sentence]
srfWtrFDeriv2DSentence = [String -> Sentence
S String
"Due to", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPSC Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"only two dimensions are considered, so", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
surfHydroForce),
  String -> Sentence
S String
"are expressed as", forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
force Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"per meter", String -> Sentence
S String
"The",
  forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
pressure, String -> Sentence
S String
"acting on", forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"can thus be converted",
  String -> Sentence
S String
"to", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surfHydroForce, String -> Sentence
S String
"by multiplying by the corresponding",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
len, String -> Sentence
S String
"of", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slice), String -> Sentence
S String
"surface", ModelExpr -> Sentence
eS (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfLngth) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"assuming", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
waterTable), String -> Sentence
S String
"does not intersect a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"surface except at a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"edge" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpWISE),
  String -> Sentence
S String
"Thus, in the case where", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
waterTable),
  String -> Sentence
S String
"is above", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
slopeSrf) Sentence -> Sentence -> Sentence
`sC`
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
surfHydroForce), String -> Sentence
S String
"are defined as"]

srfWtrFDerivEndSentence :: [Sentence]
srfWtrFDerivEndSentence = [[Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"the non-zero case of" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
srfWtrFGD,
  String -> Sentence
S String
"The zero case is when", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
waterTable),
  String -> Sentence
S String
"is below", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
height forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
slopeSrf) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so there is no",
  String -> Sentence
S String
"hydrostatic", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force]]

srfWtrFDerivWeightEqn :: PExpr
srfWtrFDerivWeightEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pressure forall r. ExprC r => r -> r -> r
$= forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
specWeight forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
height

srfWtrFDerivHeightEqn :: PExpr
srfWtrFDerivHeightEqn = PExpr
oneHalf forall r. ExprC r => r -> r -> r
`mulRe` ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeHght) forall r. ExprC r => r -> r -> r
`addRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UncertQ
slopeHght))

srfWtrFDerivSliceEqn :: PExpr
srfWtrFDerivSliceEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfHydroForce forall r. ExprC r => r -> r -> r
$= forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfLngth forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight forall r. ExprC r => r -> r -> r
`mulRe`
  PExpr
srfWtrFDerivHeightEqn