{-# LANGUAGE PostfixOperators #-}
module Drasil.SSP.DataDefs (dataDefs, intersliceWtrF, angleA, angleB, lengthB,
  lengthLb, lengthLs, slcHeight, normStressDD, tangStressDD, ratioVariation,
  convertFunc1, convertFunc2, nrmForceSumDD, watForceSumDD) where

import Prelude hiding (cos, sin, tan)
import Language.Drasil
import Theory.Drasil (DataDefinition, ddE)
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (assumption)
import Data.Drasil.Concepts.Math (equation)
import Data.Drasil.Quantities.Math as QM (pi_)
import Data.Drasil.Theories.Physics (torqueDD)

import Drasil.SSP.Assumptions (assumpSBSBISL)
import Drasil.SSP.Defs (slice)
import Drasil.SSP.References (chen2005, fredlund1977, karchewski2012, huston2008)
import Drasil.SSP.Unitals (baseAngle, baseLngth, baseWthX, constF, fricAngle,
  fs, genericA, intNormForce, indxn, inx, inxi, inxiM1, midpntHght,
  fn, ft, mobShrC, normToShear, scalFunc, shrResC, slipDist, slipHght, slopeDist,
  slopeHght, surfAngle, surfLngth, totNormStress, tangStress, nrmForceSum,
  watForceSum, sliceHghtRight, sliceHghtLeft, waterHght, waterWeight, watrForce)

------------------------
--  Data Definitions  --
------------------------

dataDefs :: [DataDefinition]
dataDefs :: [DataDefinition]
dataDefs = [DataDefinition
intersliceWtrF, DataDefinition
angleA, DataDefinition
angleB, DataDefinition
lengthB, DataDefinition
lengthLb, DataDefinition
lengthLs,
  DataDefinition
slcHeight, DataDefinition
normStressDD, DataDefinition
tangStressDD, DataDefinition
torqueDD, DataDefinition
ratioVariation, DataDefinition
convertFunc1,
  DataDefinition
convertFunc2, DataDefinition
nrmForceSumDD, DataDefinition
watForceSumDD, DataDefinition
sliceHghtRightDD, DataDefinition
sliceHghtLeftDD]

--DD intersliceWtrF: interslice normal water forces

intersliceWtrF :: DataDefinition
intersliceWtrF :: DataDefinition
intersliceWtrF = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
intersliceWtrFQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"intersliceWtrF"
  []--Notes
--FIXME: fill empty lists in

intersliceWtrFQD :: SimpleQDef
intersliceWtrFQD :: SimpleQDef
intersliceWtrFQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
watrForce Expr
intersliceWtrFEqn

intersliceWtrFEqn :: Expr
intersliceWtrFEqn :: Expr
intersliceWtrFEqn = forall r. ExprC r => [(r, r)] -> r
completeCase [(Expr, Expr)
case1,(Expr, Expr)
case2,(Expr, Expr)
case3]
  where case1 :: (Expr, Expr)
case1 = (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 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
`mulRe`
          forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight forall r. ExprC r => r -> r -> r
`addRe` (forall r. (ExprC r, LiteralC r) => r -> r
square (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
`mulRe`
          forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight), 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)

        case2 :: (Expr, Expr)
case2 = (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 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
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
waterWeight,
                (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 UncertQ
waterHght forall r. ExprC r => r -> r -> r
$> forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipHght))

        case3 :: (Expr, Expr)
case3 = (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)

--DD angleA: base angles

angleA :: DataDefinition
angleA :: DataDefinition
angleA = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
angleAQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"angleA"
  [Sentence
angleANotes]
--FIXME: fill empty lists in

angleAQD :: SimpleQDef
angleAQD :: SimpleQDef
angleAQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
baseAngle Expr
angleAEqn

angleAEqn :: Expr
angleAEqn :: Expr
angleAEqn = forall r. ExprC r => r -> r
arctan ((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 -> Integer -> r
inx UnitalChunk
slipHght (-Integer
1)) forall r. ExprC r => r -> r -> r
$/
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipDist forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx UnitalChunk
slipDist (-Integer
1)))

angleANotes :: Sentence
angleANotes :: Sentence
angleANotes = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is based" Sentence -> Sentence -> Sentence
`S.onThe`
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"that the base" Sentence -> Sentence -> Sentence
`S.ofA` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"is a straight line", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSBSBISL)]

--DD angleB: surface angles

angleB :: DataDefinition
angleB :: DataDefinition
angleB = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
angleBQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"angleB"
  [Sentence
angleBNotes]--Notes
--FIXME: fill empty lists in

angleBQD :: SimpleQDef
angleBQD :: SimpleQDef
angleBQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
surfAngle Expr
angleBEqn

angleBEqn :: Expr
angleBEqn :: Expr
angleBEqn = forall r. ExprC r => r -> r
arctan ((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 -> Integer -> r
inx UncertQ
slopeHght (-Integer
1)) forall r. ExprC r => r -> r -> r
$/
  (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UncertQ
slopeDist forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx UncertQ
slopeDist (-Integer
1)))

angleBNotes :: Sentence
angleBNotes :: Sentence
angleBNotes = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"is based" Sentence -> Sentence -> Sentence
`S.onThe`
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"that the surface" Sentence -> Sentence -> Sentence
`S.ofA` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  String -> Sentence
S String
"is a straight line", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSBSBISL)]

--DD lengthB: base width of slices

lengthB :: DataDefinition
lengthB :: DataDefinition
lengthB = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
lengthBQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"lengthB" []--Notes
--FIXME: fill empty lists in

lengthBQD :: SimpleQDef
lengthBQD :: SimpleQDef
lengthBQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
baseWthX Expr
lengthBEqn

lengthBEqn :: Expr
lengthBEqn :: Expr
lengthBEqn = forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipDist forall r. ExprC r => r -> r -> r
$- forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx UnitalChunk
slipDist (-Integer
1)

--DD lengthLb: total base lengths of slices

lengthLb :: DataDefinition
lengthLb :: DataDefinition
lengthLb = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
lengthLbQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"lengthLb"
  [Sentence
lengthLbNotes]--Notes
--FIXME: fill empty lists in

lengthLbQD :: SimpleQDef
lengthLbQD :: SimpleQDef
lengthLbQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
baseLngth Expr
lengthLbEqn

lengthLbEqn :: Expr
lengthLbEqn :: Expr
lengthLbEqn = 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
sec (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
baseAngle)

lengthLbNotes :: Sentence
lengthLbNotes :: Sentence
lengthLbNotes = [Sentence] -> Sentence
foldlSent [UnitalChunk
baseWthX forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''`
  DataDefinition
lengthB Sentence -> Sentence -> Sentence
`S.and_` (UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA)]

--DD lengthLs: surface lengths of slices

lengthLs :: DataDefinition
lengthLs :: DataDefinition
lengthLs = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
lengthLsQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"lengthLs"
  [Sentence
lengthLsNotes]--Notes
--FIXME: fill empty lists in

lengthLsQD :: SimpleQDef
lengthLsQD :: SimpleQDef
lengthLsQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
surfLngth Expr
lengthLsEqn

lengthLsEqn :: Expr
lengthLsEqn :: Expr
lengthLsEqn = 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
sec (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
surfAngle)

lengthLsNotes :: Sentence
lengthLsNotes :: Sentence
lengthLsNotes = [Sentence] -> Sentence
foldlSent [UnitalChunk
baseWthX forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''`
  DataDefinition
lengthB Sentence -> Sentence -> Sentence
`S.and_` (UnitalChunk
surfAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleB)]


--DD slcHeight: y-direction heights of slices

slcHeight :: DataDefinition
slcHeight :: DataDefinition
slcHeight = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
slcHeightQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing String
"slcHeight"
  [Sentence]
slcHeightNotes

slcHeightQD :: SimpleQDef
slcHeightQD :: SimpleQDef
slcHeightQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
midpntHght Expr
slcHeightEqn

slcHeightEqn :: Expr
slcHeightEqn :: Expr
slcHeightEqn = forall r. (ExprC r, LiteralC r) => r
oneHalf forall r. ExprC r => r -> r -> r
`mulRe` (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
sliceHghtRight forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
sliceHghtLeft)

slcHeightNotes :: [Sentence]
slcHeightNotes :: [Sentence]
slcHeightNotes = [String -> Sentence
S String
"This" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"is based on the" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase CI
assumption Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that the surface" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"base of a slice" Sentence -> Sentence -> Sentence
+:+
  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),
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
sliceHghtRight Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
sliceHghtLeft Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"are defined in" Sentence -> Sentence -> Sentence
+:+
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
sliceHghtRightDD Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
sliceHghtLeftDD Sentence -> Sentence -> Sentence
`sC`
  (String -> Sentence
S String
"respectively" !.)]

--DD normStress: total normal stress

normStressDD :: DataDefinition
normStressDD :: DataDefinition
normStressDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
normStressQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
huston2008] forall a. Maybe a
Nothing String
"normStress" []

normStressQD :: SimpleQDef
normStressQD :: SimpleQDef
normStressQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
totNormStress Expr
normStressEqn

normStressEqn :: Expr
normStressEqn :: Expr
normStressEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
fn forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericA

--DD tangStress: tangential stress

tangStressDD :: DataDefinition
tangStressDD :: DataDefinition
tangStressDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
tangStressQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
huston2008] forall a. Maybe a
Nothing String
"tangStress" []

tangStressQD :: SimpleQDef
tangStressQD :: SimpleQDef
tangStressQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
tangStress Expr
tangStressEqn

tangStressEqn :: Expr
tangStressEqn :: Expr
tangStressEqn = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
ft forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
genericA

--DD ratioVariation: interslice normal to shear force ratio variation function

ratioVariation :: DataDefinition
ratioVariation :: DataDefinition
ratioVariation = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
ratioVarQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing
  String
"ratioVariation" []

ratioVarQD :: SimpleQDef
ratioVarQD :: SimpleQDef
ratioVarQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
scalFunc Expr
ratioVarEqn

ratioVarEqn :: Expr
ratioVarEqn :: Expr
ratioVarEqn = forall r. ExprC r => [(r, r)] -> r
completeCase [(Expr, Expr)
case1, (Expr, Expr)
case2]
  where case1 :: (Expr, Expr)
case1 = (forall r. LiteralC r => Integer -> r
exactDbl Integer
1, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
constF)

        case2 :: (Expr, Expr)
case2 = (forall r. ExprC r => r -> r
sin (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
QM.pi_ forall r. ExprC r => r -> r -> r
`mulRe` ((forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
slipDist forall r. ExprC r => r -> r -> r
$- forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
slipDist) (forall r. LiteralC r => Integer -> r
int Integer
0)) forall r. ExprC r => r -> r -> r
$/
                (forall r a. (ExprC r, Quantity a) => a -> r
indxn UnitalChunk
slipDist forall r. ExprC r => r -> r -> r
$- forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
slipDist) (forall r. LiteralC r => Integer -> r
int Integer
0)))), forall r. ExprC r => r -> r
not_ (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
constF))

--DD convertFunc1: first function for incorporating interslice forces into shear force

convertFunc1 :: DataDefinition
convertFunc1 :: DataDefinition
convertFunc1 = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
convertFunc1QD (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef [Citation
chen2005, Citation
karchewski2012]) forall a. Maybe a
Nothing
  String
"convertFunc1" [Sentence
convertFunc1Notes]

convertFunc1QD :: SimpleQDef
convertFunc1QD :: SimpleQDef
convertFunc1QD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
shrResC Expr
convertFunc1Eqn

convertFunc1Eqn :: Expr
convertFunc1Eqn :: Expr
convertFunc1Eqn = (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
normToShear forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi DefinedQuantityDict
scalFunc 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
$- 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
`mulRe` forall r. ExprC r => r -> r
tan (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
fricAngle) forall r. ExprC r => r -> r -> r
$-
  ((forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
normToShear forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi DefinedQuantityDict
scalFunc 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
`addRe`
  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
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
fs)

convertFunc1Notes :: Sentence
convertFunc1Notes :: Sentence
convertFunc1Notes = [Sentence] -> Sentence
foldlSent [DefinedQuantityDict
scalFunc forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
ratioVariation Sentence -> Sentence -> Sentence
`S.and_` (UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA)]

--DD convertFunc2: second function for incorporating interslice forces into shear force

convertFunc2 :: DataDefinition
convertFunc2 :: DataDefinition
convertFunc2 = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
convertFunc2QD (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef [Citation
chen2005, Citation
karchewski2012]) forall a. Maybe a
Nothing
  String
"convertFunc2" [Sentence
convertFunc2Notes]

convertFunc2QD :: SimpleQDef
convertFunc2QD :: SimpleQDef
convertFunc2QD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef DefinedQuantityDict
mobShrC Expr
convertFunc2Eqn

convertFunc2Eqn :: Expr
convertFunc2Eqn :: Expr
convertFunc2Eqn = ((forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
normToShear forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi DefinedQuantityDict
scalFunc 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
$- 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
`mulRe` forall r. ExprC r => r -> r
tan (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
fricAngle) forall r. ExprC r => r -> r -> r
$-
  ((forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
normToShear forall r. ExprC r => r -> r -> r
`mulRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi DefinedQuantityDict
scalFunc 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
`addRe`
  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
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
fs)) forall r. ExprC r => r -> r -> r
$/
  forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 DefinedQuantityDict
shrResC

convertFunc2Notes :: Sentence
convertFunc2Notes :: Sentence
convertFunc2Notes = (SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
  [DefinedQuantityDict
scalFunc forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
ratioVariation, UnitalChunk
baseAngle forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
angleA,
  DefinedQuantityDict
shrResC forall q r.
(HasSymbol q, HasUID q, Referable r, HasShortName r) =>
q -> r -> Sentence
`definedIn'''` DataDefinition
convertFunc1] !.)

{--DD10

resShearWO :: DataDefinition
resShearWO = ddE resShearWOQD [chen2005] resShr_deriv_ssp resShearWOL
  [refS newA3, refS newA4, refS newA5]--Notes
--FIXME: fill empty lists in

resShearWOQD :: QDefinition
resShearWOQD = mkQuantDef shearRNoIntsl resShearWOEqn

resShearWOEqn :: Expr
resShearWOEqn = (((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (cos (inxi baseAngle)) `addRe` (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForceDif) `addRe` (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) +
  (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) `mulRe` (sin (inxi baseAngle)) -
  (inxi baseHydroForce)) `mulRe` tan (inxi fricAngle) `addRe` (inxi effCohesion) *
  (inxi baseWthX) `mulRe` sec (inxi baseAngle)

resShr_deriv_ssp :: Derivation
resShr_deriv_ssp = weave [resShrDerivation_sentence, map E resShr_deriv_eqns_ssp]

--DD11

mobShearWO :: DataDefinition
mobShearWO = ddE mobShearWOQD [chen2005] mobShr_deriv_ssp mobShearWOL
  [refS newA3, refS newA4, refS newA5]--Notes
--FIXME: fill empty lists in

mobShearWOQD :: QDefinition
mobShearWOQD = mkQuantDef shearFNoIntsl mobShearWOEqn

mobShearWOEqn :: Expr 
mobShearWOEqn = ((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (sin (inxi baseAngle)) - (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForceDif) `addRe` (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) +
  (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) `mulRe` (cos (inxi baseAngle))

mobShr_deriv_ssp :: Derivation
mobShr_deriv_ssp = (weave [mobShrDerivation_sentence, map E mobShr_deriv_eqns_ssp])-}

-----------------
-- Hacks --------
-----------------

nrmForceSumDD, watForceSumDD, sliceHghtRightDD,
  sliceHghtLeftDD :: DataDefinition
nrmForceSumDD :: DataDefinition
nrmForceSumDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
nrmForceSumQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing
  String
"nrmForceSumDD" []--Notes
watForceSumDD :: DataDefinition
watForceSumDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
watForceSumQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing
  String
"watForceSumDD" []--Notes
sliceHghtRightDD :: DataDefinition
sliceHghtRightDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
sliceHghtRightQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing
  String
"sliceHghtRightDD" []--Notes
sliceHghtLeftDD :: DataDefinition
sliceHghtLeftDD = SimpleQDef
-> [DecRef]
-> Maybe Derivation
-> String
-> [Sentence]
-> DataDefinition
ddE SimpleQDef
sliceHghtLeftQD [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> DecRef
dRef Citation
fredlund1977] forall a. Maybe a
Nothing
  String
"sliceHghtLeftDD" []--Notes

nrmForceSumQD :: SimpleQDef
nrmForceSumQD :: SimpleQDef
nrmForceSumQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec UnitalChunk
nrmForceSum (forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxi UnitalChunk
intNormForce forall r. ExprC r => r -> r -> r
`addRe` forall r e. (ExprC r, LiteralC r, Quantity e) => e -> r
inxiM1 UnitalChunk
intNormForce)

watForceSumQD :: SimpleQDef
watForceSumQD :: SimpleQDef
watForceSumQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec UnitalChunk
watForceSum (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)

sliceHghtRightQD :: SimpleQDef
sliceHghtRightQD :: SimpleQDef
sliceHghtRightQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec UnitalChunk
sliceHghtRight (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)

sliceHghtLeftQD :: SimpleQDef
sliceHghtLeftQD :: SimpleQDef
sliceHghtLeftQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec UnitalChunk
sliceHghtLeft (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)

--------------------------
-- Derivation Sentences --
--------------------------

-- FIXME: move derivations with the appropriate data definition

{-resShr_deriv_sentences_ssp_s1 :: [Sentence]
resShr_deriv_sentences_ssp_s1 = [S "The", phrase shrResI, S "of a slice is", 
  S "defined as", ch shrResI, S "in" +:+. refS genDef3Label, S "The",
  phrase nrmFSubWat, S "in the", phrase equation, S "for", ch shrResI,
  S "of the soil is defined in the perpendicular force equilibrium",
  S "of a slice from", makeRefS genDef2Label `sC` S "using the", getTandS nrmFSubWat,
  S "of", refS effStress, S "shown in", eqN 1]

resShr_deriv_sentences_ssp_s2 :: [Sentence]
resShr_deriv_sentences_ssp_s2 = [plural value `the_ofThe'` S "interslice forces",
  ch intNormForce `S.and_` ch intShrForce, S "in the", phrase equation,
  S "are unknown, while the other", plural value,
  S "are found from the physical force", plural definition, S "of",
  refS sliceWght, S "to" +:+. refS lengthLs,
  S "Consider a force equilibrium without the affect of interslice forces" `sC`
  S "to obtain a solvable value as done for", ch nrmFNoIntsl, S "in", eqN 2]

resShr_deriv_sentences_ssp_s3 :: [Sentence]
resShr_deriv_sentences_ssp_s3 = [S "Using", ch nrmFNoIntsl `sC` S "a", phrase shearRNoIntsl,
  shearRNoIntsl ^. defn, S "can be solved for in terms of all known",
  plural value, S "as done in", eqN 3]

resShr_deriv_sentences_ssp_s4 :: [Sentence]
resShr_deriv_sentences_ssp_s4 = [S "This can be further simplified by considering assumptions",
  refS newA10, S "and", refS newA12 `sC`
  S "which state that the seismic coefficient and the external force" `sC` S "respectively"
  `sC` S "are0", S "Removing seismic and external forces yields ", eqN 4]

resShrDerivation_sentence :: [Sentence]
resShrDerivation_sentence = map foldlSentCol [resShr_deriv_sentences_ssp_s1, resShr_deriv_sentences_ssp_s2,
  resShr_deriv_sentences_ssp_s3, resShr_deriv_sentences_ssp_s4]

resShr_deriv_eqns_ssp :: [Expr]
resShr_deriv_eqns_ssp = [eq1, eq2, eq3, eq8]

eq1, eq2, eq3, eq8 :: Expr
eq1 = (inxi nrmFSubWat) $= eqlExpr cos sin (\x y -> x -
  inxiM1 intShrForce `addRe` inxi intShrForce `addRe` y) - inxi baseHydroForce

eq2 = (inxi nrmFNoIntsl) $= (((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (cos (inxi baseAngle)) `addRe` (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForce) `addRe` (inxiM1 watrForce) `addRe` (inxi surfHydroForce) *
  sin (inxi surfAngle) `addRe` (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) *
  (sin (inxi baseAngle)) - (inxi baseHydroForce))

eq3 = inxi shearRNoIntsl $= (inxi nrmFNoIntsl) `mulRe` tan (inxi fricAngle) +
  (inxi effCohesion) `mulRe` (inxi baseWthX) `mulRe` sec (inxi baseAngle) $=
  (((inxi slcWght) `addRe` (inxi surfHydroForce) `mulRe` (cos (inxi surfAngle)) +
  (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) `mulRe` (cos (inxi baseAngle)) +
  (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) - (inxi watrForceDif) +
  (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) `addRe` (inxi surfLoad) *
  (sin (inxi impLoadAngle))) `mulRe` (sin (inxi baseAngle)) -
  (inxi baseHydroForce)) `mulRe` tan (inxi fricAngle) `addRe` (inxi effCohesion) *
  (inxi baseWthX) `mulRe` sec (inxi baseAngle)

eq8 = inxi shearRNoIntsl $=
  (((inxi slcWght) `addRe` (inxi surfHydroForce) `mulRe` (cos (inxi surfAngle))) `mulRe` (cos (inxi baseAngle)) +
  (- (inxi watrForceDif) +
  (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) `addRe` (inxi surfLoad) *
  (sin (inxi impLoadAngle))) `mulRe` (sin (inxi baseAngle)) -
  (inxi baseHydroForce)) `mulRe` tan (inxi fricAngle) `addRe` (inxi effCohesion) *
  (inxi baseWthX) `mulRe` sec (inxi baseAngle)

-------old chunk---------

resShrDerivation :: [Contents]
resShrDerivation = [

  foldlSP [S "The", phrase shrResI, S "of a slice is", 
  S "defined as", ch shrResI, S "in" +:+. refS genDef3Label, S "The",
  phrase nrmFSubWat, S "in the", phrase equation, S "for", ch shrResI,
  S "of the soil is defined in the perpendicular force equilibrium",
  S "of a slice from", makeRefS bsShrFEq `sC` S "using the", getTandS nrmFSubWat,
  S "of", refS effStress, S "shown in", eqN 5],
  
  eqUnR' $ (inxi nrmFSubWat) $= eqlExpr cos sin (\x y -> x -
  inxiM1 intShrForce `addRe` inxi intShrForce `addRe` y) - inxi baseHydroForce,
  
  foldlSP [plural value `the_ofThe'` S "interslice forces",
  ch intNormForce `S.and_` ch intShrForce, S "in the", phrase equation,
  S "are unknown, while the other", plural value,
  S "are found from the physical force", plural definition, S "of",
  refS sliceWght, S "to" +:+. refS lengthLs,
  S "Consider a force equilibrium without the affect of interslice forces" `sC`
  S "to obtain a solvable value as done for", ch nrmFNoIntsl, S "in", eqN 2],

  eqUnR' $
  (inxi nrmFNoIntsl) $= (((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (cos (inxi baseAngle)) `addRe` (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForce) `addRe` (inxiM1 watrForce) `addRe` (inxi surfHydroForce) *
  sin (inxi surfAngle) `addRe` (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) *
  (sin (inxi baseAngle)) - (inxi baseHydroForce)),
  
  foldlSP [S "Using", ch nrmFNoIntsl `sC` S "a", phrase shearRNoIntsl,
  shearRNoIntsl ^. defn, S "can be solved for in terms of all known",
  plural value, S "as done in", eqN 3],
  
  eqUnR' $
  inxi shearRNoIntsl $= (inxi nrmFNoIntsl) `mulRe` tan (inxi fricAngle) +
  (inxi effCohesion) `mulRe` (inxi baseWthX) `mulRe` sec (inxi baseAngle) $=
  (((inxi slcWght) `addRe` (inxi surfHydroForce) `mulRe` (cos (inxi surfAngle)) +
  (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) `mulRe` (cos (inxi baseAngle)) +
  (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) - (inxi watrForceDif) +
  (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) `addRe` (inxi surfLoad) *
  (sin (inxi impLoadAngle))) `mulRe` (sin (inxi baseAngle)) -
  (inxi baseHydroForce)) `mulRe` tan (inxi fricAngle) `addRe` (inxi effCohesion) *
  (inxi baseWthX) `mulRe` sec (inxi baseAngle)

  ]

------------------------------------------------------------------

mobShr_deriv_sentences_ssp_s1 :: [Sentence]
mobShr_deriv_sentences_ssp_s1 = [S "The", phrase mobShrI, S "acting on a slice is defined as",
  ch mobShrI, S "from the force equilibrium in", refS genDef2Label `sC`
  S "also shown in", eqN 5]

mobShr_deriv_sentences_ssp_s2 :: [Sentence]
mobShr_deriv_sentences_ssp_s2 = [S "The", phrase equation, S "is unsolvable, containing the unknown",
  getTandS intNormForce, S "and" +:+. getTandS intShrForce,
  S "Consider a force equilibrium", S wiif `sC` S "to obtain the",
  getTandS shearFNoIntsl `sC` S "as done in", eqN 6]

mobShr_deriv_sentences_ssp_s3 :: [Sentence]
mobShr_deriv_sentences_ssp_s3 = [S "The" +:+ plural value +:+ S "of" +:+ 
  ch shearFNoIntsl +:+ S "is now defined completely in terms of the" +:+
  S "known" +:+. plural value +:+ S "This can be further simplified by considering assumptions" +:+
  refS newA10 +:+ S "and" +:+ refS newA12 `sC`
  S "which state that the seismic coefficient and the external force" `sC` S "respectively"
  `sC` S "are0" +:+ S "Removing seismic and external forces yields " +:+ eqN 7]


mobShrDerivation_sentence :: [Sentence]
mobShrDerivation_sentence = map foldlSentCol [mobShr_deriv_sentences_ssp_s1, mobShr_deriv_sentences_ssp_s2,
  mobShr_deriv_sentences_ssp_s3]

mobShr_deriv_eqns_ssp :: [Expr]
mobShr_deriv_eqns_ssp = [eq4, eq5, eq6]

eq4, eq5, eq6:: Expr
eq4 = inxi mobShrI $= eqlExpr sin cos
    (\x y -> x - inxiM1 intShrForce `addRe` inxi intShrForce `addRe` y)

eq5 = inxi shearFNoIntsl $= ((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (sin (inxi baseAngle)) - (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForceDif) `addRe` (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) +
  (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) `mulRe` (cos (inxi baseAngle))

eq6 = inxi shearFNoIntsl $= ((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle))) *
  (sin (inxi baseAngle)) -
  ((inxi watrForceDif) `addRe` (inxi surfHydroForce) `mulRe` sin (inxi surfAngle)) `mulRe` (cos (inxi baseAngle))

  ------old chunk-----
mobShrDerivation :: [Contents]
mobShrDerivation = [

  foldlSP [S "The", phrase mobShrI, S "acting on a slice is defined as",
  ch mobShrI, S "from the force equilibrium in", refS genDef2Label `sC`
  S "also shown in", eqN 4],
  
  eqUnR' $ inxi mobShrI $= eqlExpr sin cos
    (\x y -> x - inxiM1 intShrForce `addRe` inxi intShrForce `addRe` y),
  
  foldlSP [S "The", phrase equation, S "is unsolvable, containing the unknown",
  getTandS intNormForce, S "and" +:+. getTandS intShrForce,
  S "Consider a force equilibrium", S wiif `sC` S "to obtain the",
  getTandS shearFNoIntsl `sC` S "as done in", eqN 5],
  
  eqUnR' $
  inxi shearFNoIntsl $= ((inxi slcWght) `addRe` (inxi surfHydroForce) *
  (cos (inxi surfAngle)) `addRe` (inxi surfLoad) `mulRe` (cos (inxi impLoadAngle))) *
  (sin (inxi baseAngle)) - (negate (sy earthqkLoadFctr) `mulRe` (inxi slcWght) -
  (inxi watrForceDif) `addRe` (inxi surfHydroForce) `mulRe` sin (inxi surfAngle) +
  (inxi surfLoad) `mulRe` (sin (inxi impLoadAngle))) `mulRe` (cos (inxi baseAngle)),
  
  foldlSP [S "The", plural value, S "of", ch shearRNoIntsl `S.and_`
  ch shearFNoIntsl, S "are now defined completely in terms of the",
  S "known force property", plural value, S "of", refS sliceWght, S "to", 
  refS lengthLs]

  ]-}