module Drasil.SSP.Unitals where --export all of it

import Language.Drasil
import Language.Drasil.Display (Symbol(..))
import Language.Drasil.ShortHands
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import Drasil.SSP.Defs (fsConcept)

import Data.Drasil.Constraints (gtZeroConstr)
import Data.Drasil.SI_Units (degree, metre, m_3, newton, pascal, specificWeight)

import Data.Drasil.Units.Physics (forcePerMeterU)

import Data.Drasil.Concepts.Math (cartesian, xCoord, xDir, yCoord, yDir,
  zCoord, zDir)
import Data.Drasil.Concepts.Physics (gravity)

import Data.Drasil.Quantities.Math (area, pi_, unitVectj)
import Data.Drasil.Quantities.PhysicalProperties (density, mass, specWeight, 
  vol)
import Data.Drasil.Quantities.Physics (acceleration, displacement, distance,
  force, gravitationalAccel, height, moment2D, pressure, subX, subY, subZ, 
  supMax, supMin, torque, weight, positionVec)


symbols :: [DefinedQuantityDict]
symbols :: [DefinedQuantityDict]
symbols = ConstrConcept -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr ConstrConcept
coords DefinedQuantityDict
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. a -> [a] -> [a]
: (DefinedQuantityDict -> DefinedQuantityDict)
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
inputs [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (ConstrConcept -> DefinedQuantityDict)
-> [ConstrConcept] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map ConstrConcept -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [ConstrConcept]
outputs
  [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (UnitalChunk -> DefinedQuantityDict)
-> [UnitalChunk] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UnitalChunk]
units [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (DefinedQuantityDict -> DefinedQuantityDict)
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
unitless

---------------------------
-- Imported UnitalChunks --
---------------------------
{-
SM.mobShear, SM.shearRes <- currently not used
SM.poissnsR, SM.elastMod <- Used to make UncertQ
-}
genericF :: UnitalChunk
genericF = UnitalChunk
force
genericA :: UnitalChunk
genericA = UnitalChunk
area
genericM :: UnitalChunk
genericM = UnitalChunk
moment2D

-- FIXME: These need to be imported here because they are used in generic TMs/GDs that SSP also imports. Automate this?
genericV :: UnitalChunk
genericV = UnitalChunk
vol
genericW :: UnitalChunk
genericW = UnitalChunk
weight
genericSpWght :: UnitalChunk
genericSpWght = UnitalChunk
specWeight
accel :: UnitalChunk
accel = UnitalChunk
acceleration
genericMass :: UnitalChunk
genericMass = UnitalChunk
mass
gravAccel :: UnitalChunk
gravAccel = UnitalChunk
gravitationalAccel
dens :: UnitalChunk
dens = UnitalChunk
density
genericH :: UnitalChunk
genericH = UnitalChunk
height
genericP :: UnitalChunk
genericP = UnitalChunk
pressure
genericR :: UnitalChunk
genericR = UnitalChunk
displacement
genericT :: UnitalChunk
genericT = UnitalChunk
torque
posVec :: UnitalChunk
posVec = UnitalChunk
positionVec

-------------
-- HELPERS --
-------------
wiif :: String
wiif :: String
wiif = String
"without the influence of interslice forces"

--------------------------------
-- START OF CONSTRAINEDCHUNKS --
--------------------------------

constrained :: [ConstrainedChunk]
constrained :: [ConstrainedChunk]
constrained = ConstrConcept -> ConstrainedChunk
forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw ConstrConcept
coords ConstrainedChunk -> [ConstrainedChunk] -> [ConstrainedChunk]
forall a. a -> [a] -> [a]
: (UncertQ -> ConstrainedChunk) -> [UncertQ] -> [ConstrainedChunk]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> ConstrainedChunk
forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw [UncertQ]
inputsWUncrtn [ConstrainedChunk] -> [ConstrainedChunk] -> [ConstrainedChunk]
forall a. [a] -> [a] -> [a]
++ (ConstrConcept -> ConstrainedChunk)
-> [ConstrConcept] -> [ConstrainedChunk]
forall a b. (a -> b) -> [a] -> [b]
map ConstrConcept -> ConstrainedChunk
forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw [ConstrConcept]
outputs

inputsWUncrtn :: [UncertQ]
inputsWUncrtn :: [UncertQ]
inputsWUncrtn = [UncertQ
slopeDist, UncertQ
slopeHght, UncertQ
waterDist, UncertQ
waterHght, UncertQ
xMaxExtSlip, 
  UncertQ
xMaxEtrSlip, UncertQ
xMinExtSlip, UncertQ
xMinEtrSlip, UncertQ
yMaxSlip, UncertQ
yMinSlip, UncertQ
effCohesion, 
  UncertQ
fricAngle, UncertQ
dryWeight, UncertQ
satWeight, UncertQ
waterWeight]

inputsNoUncrtn :: [DefinedQuantityDict]
inputsNoUncrtn :: [DefinedQuantityDict]
inputsNoUncrtn = [DefinedQuantityDict
constF]

inputs :: [DefinedQuantityDict]
inputs :: [DefinedQuantityDict]
inputs = (UncertQ -> DefinedQuantityDict)
-> [UncertQ] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UncertQ]
inputsWUncrtn [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (DefinedQuantityDict -> DefinedQuantityDict)
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
inputsNoUncrtn

outputs :: [ConstrConcept]
outputs :: [ConstrConcept]
outputs = [ConstrConcept
fs]

{-
monotonicIn :: [Constraint]  --FIXME: Move this?
monotonicIn = [physRange $ \_ -> -- FIXME: Hack with "index" !
  (idx xi (sy index) $< idx xi (sy index + 1) $=> idx yi (sy index) $< idx yi (sy index + 1))]
-}

slopeDist, slopeHght, waterDist, waterHght, xMaxExtSlip, xMaxEtrSlip, 
  xMinExtSlip, xMinEtrSlip, yMaxSlip, yMinSlip, effCohesion, fricAngle, 
  dryWeight, satWeight, waterWeight :: UncertQ


{-Intput Variables-}
--FIXME: add (x,y) when we can index or make related unitals
--FIXME: add constraints to coordinate unitals when that is possible (constraints currently in the Notes section of the crtSlpId IM instead)

slopeDist :: UncertQ
slopeDist = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slope,i"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the slope")
  (ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"points on the soil slope")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lX) Symbol
lSlope) (Space -> Space
Vect Space
Real) UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

slopeHght :: UncertQ
slopeHght = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slope,i"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the slope")
  (ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"points on the soil slope")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lY) Symbol
lSlope) (Space -> Space
Vect Space
Real) UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

waterDist :: UncertQ
waterDist = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"x_wt,i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the water table")
  String
"x-positions of the water table"
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lX) Symbol
lWatTab) UnitDefn
metre (Space -> Space
Vect Space
Real) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Uncertainty
defaultUncrt

waterHght :: UncertQ
waterHght = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"y_wt,i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the water table")
  String
"heights of the water table"
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lY) Symbol
lWatTab) UnitDefn
metre (Space -> Space
Vect Space
Real) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Uncertainty
defaultUncrt

xMaxExtSlip :: UncertQ
xMaxExtSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip^maxExt"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"maximum exit" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (String -> Sentence
S String
"the maximum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"the exit point" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"slip surface")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lX Symbol
lSlip) Symbol
lMaxExt) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
100)) Uncertainty
defaultUncrt

xMaxEtrSlip :: UncertQ
xMaxEtrSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip^maxEtr" 
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"maximum entry" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (String -> Sentence
S String
"the maximum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"the entry point" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"slip surface")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lX Symbol
lSlip) Symbol
lMaxEtr) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
20)) Uncertainty
defaultUncrt
  
xMinExtSlip :: UncertQ
xMinExtSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip^minExt"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"minimum exit" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (String -> Sentence
S String
"the minimum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"the exit point" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"slip surface")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lX Symbol
lSlip) Symbol
lMinExt) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
50)) Uncertainty
defaultUncrt

xMinEtrSlip :: UncertQ
xMinEtrSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip^minEtr"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"minimum entry" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (String -> Sentence
S String
"the minimum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"the entry point" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"slip surface")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub Symbol
lX Symbol
lSlip) Symbol
lMinEtr) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

yMaxSlip :: UncertQ
yMaxSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip^max"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"maximum" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord)
  (String -> Sentence
S String
"the maximum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"a point on a slip surface")
  (Symbol -> Symbol
supMax (Symbol -> Symbol -> Symbol
sub Symbol
lY Symbol
lSlip)) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
30)) Uncertainty
defaultUncrt

yMinSlip :: UncertQ
yMinSlip = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip^min"
  (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"minimum" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord)
  (String -> Sentence
S String
"the minimum potential" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"a point on a slip surface")
  (Symbol -> Symbol
supMin (Symbol -> Symbol -> Symbol
sub Symbol
lY Symbol
lSlip)) Space
Real UnitDefn
metre) [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

effCohesion :: UncertQ
effCohesion = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"c'" (String -> NP
cn String
"effective cohesion")
  String
"the internal pressure that sticks particles of soil together"
  (Symbol -> Symbol
prime (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"c") UnitDefn
pascal Space
Real [ConstraintE
gtZeroConstr] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
10000) Uncertainty
defaultUncrt

fricAngle :: UncertQ
fricAngle = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"varphi'" (String -> NP
cn String
"effective angle of friction")
  (String
"the angle of inclination with respect to the horizontal axis of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
"the Mohr-Coulomb shear resistance line") --http://www.geotechdata.info
  (Symbol -> Symbol
prime Symbol
vPhi) UnitDefn
degree Space
Real [RealInterval Expr Expr -> ConstraintE
physRange (RealInterval Expr Expr -> ConstraintE)
-> RealInterval Expr Expr -> ConstraintE
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> (Inclusive, Expr) -> RealInterval Expr Expr
forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
90)]
  (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
25) Uncertainty
defaultUncrt

dryWeight :: UncertQ
dryWeight = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"gamma" (String -> NP
cn String
"soil dry unit weight")
  String
"the weight of a dry soil/ground layer divided by the volume of the layer"
  (Symbol -> Symbol -> Symbol
sub Symbol
lGamma Symbol
lDry) UnitDefn
specificWeight Space
Real [ConstraintE
gtZeroConstr]
  (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
20000) Uncertainty
defaultUncrt

satWeight :: UncertQ
satWeight = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"gamma_sat" (String -> NP
cn String
"soil saturated unit weight")
  String
"the weight of saturated soil/ground layer divided by the volume of the layer"
  (Symbol -> Symbol -> Symbol
sub Symbol
lGamma Symbol
lSat) UnitDefn
specificWeight Space
Real [ConstraintE
gtZeroConstr]
  (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
20000) Uncertainty
defaultUncrt

waterWeight :: UncertQ
waterWeight = String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"gamma_w" (String -> NP
cn String
"unit weight of water")
  String
"the weight of one cubic meter of water"
  (Symbol -> Symbol -> Symbol
sub Symbol
lGamma Symbol
lW) UnitDefn
specificWeight Space
Real [ConstraintE
gtZeroConstr]
  (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
9800) Uncertainty
defaultUncrt

constF :: DefinedQuantityDict
constF :: DefinedQuantityDict
constF = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"const_f" (String -> NP
nounPhraseSP String
"decision on f") 
  (String
"a Boolean decision on which form of f the user desires: constant if true," String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" or half-sine if false")) (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (String -> Symbol
variable String
"const_f")) Space
Boolean Maybe UnitDefn
forall a. Maybe a
Nothing

{-Output Variables-} --FIXME: See if there should be typical values
fs, coords :: ConstrConcept
fs :: ConstrConcept
fs = DefinedQuantityDict -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' ConceptChunk
fsConcept (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Stage -> Symbol) -> Symbol -> Stage -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
cF Symbol
lSafety) Space
Real Maybe UnitDefn
forall a. Maybe a
Nothing)
  [ConstraintE
gtZeroConstr] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
1)

fsMin :: DefinedQuantityDict -- This is a hack to remove the use of indexing for 'min'.
fsMin :: DefinedQuantityDict
fsMin = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"fsMin" (String -> NP
cn String
"minimum factor of safety") 
  String
"the minimum factor of safety associated with the critical slip surface")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Stage -> Symbol) -> Symbol -> Stage -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
supMin (ConstrConcept -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb ConstrConcept
fs)) Space
Real Maybe UnitDefn
forall a. Maybe a
Nothing 
-- Once things are converted to the new style of instance models, this will
-- be removed/fixed.

coords :: ConstrConcept
coords = UnitalChunk -> [ConstraintE] -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> ConstrConcept
constrainedNRV' (String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"(x,y)" (String -> NP
cn String
"cartesian position coordinates")
  (Symbol -> Sentence
P Symbol
lY Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"is considered parallel to the direction of the force of" Sentence -> Sentence -> Sentence
+:+
   ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
gravity Sentence -> Sentence -> Sentence
`S.and_` Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"is considered perpendicular to" Sentence -> Sentence -> Sentence
+:+ Symbol -> Sentence
P Symbol
lY)
  Symbol
lCoords Space
Real UnitDefn
metre) []

---------------------------
-- START OF UNITALCHUNKS --
---------------------------

units :: [UnitalChunk]
units :: [UnitalChunk]
units = (UnitalChunk -> UnitalChunk) -> [UnitalChunk] -> [UnitalChunk]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> UnitalChunk
forall c. (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw [UnitalChunk
accel, UnitalChunk
genericMass, UnitalChunk
genericF, UnitalChunk
genericA, UnitalChunk
genericM, UnitalChunk
genericV,
  UnitalChunk
genericW, UnitalChunk
genericSpWght, UnitalChunk
gravAccel, UnitalChunk
dens, UnitalChunk
genericH, UnitalChunk
genericP, UnitalChunk
genericR, 
  UnitalChunk
genericT, UnitalChunk
nrmShearNum, UnitalChunk
nrmShearDen, UnitalChunk
slipHght, UnitalChunk
xi, UnitalChunk
yi, UnitalChunk
zcoord, UnitalChunk
critCoords, 
  UnitalChunk
slipDist, UnitalChunk
mobilizedShear, UnitalChunk
resistiveShear, UnitalChunk
mobShrI, UnitalChunk
shrResI, UnitalChunk
shearFNoIntsl, 
  UnitalChunk
shearRNoIntsl, UnitalChunk
slcWght, UnitalChunk
watrForce, UnitalChunk
intShrForce, UnitalChunk
baseHydroForce, 
  UnitalChunk
surfHydroForce, UnitalChunk
totNrmForce, UnitalChunk
nrmFSubWat, UnitalChunk
surfLoad, UnitalChunk
baseAngle, UnitalChunk
surfAngle, 
  UnitalChunk
impLoadAngle, UnitalChunk
baseWthX, UnitalChunk
baseLngth, UnitalChunk
surfLngth, UnitalChunk
midpntHght, 
  UnitalChunk
porePressure, UnitalChunk
sliceHght, UnitalChunk
sliceHghtW, UnitalChunk
fx, UnitalChunk
fy, UnitalChunk
fn, UnitalChunk
ft, UnitalChunk
nrmForceSum, UnitalChunk
watForceSum, 
  UnitalChunk
sliceHghtRight, UnitalChunk
sliceHghtLeft, UnitalChunk
intNormForce, UnitalChunk
shrStress, UnitalChunk
totNormStress, UnitalChunk
tangStress,
  UnitalChunk
effectiveStress, UnitalChunk
effNormStress, UnitalChunk
dryVol, UnitalChunk
satVol, UnitalChunk
rotForce, UnitalChunk
momntArm, UnitalChunk
posVec]

accel, genericMass, genericF, genericA, genericM, genericV, genericW, 
  genericSpWght, gravAccel, dens, genericH, genericP, genericR, genericT, 
  nrmShearNum, nrmShearDen, slipDist, slipHght, xi, yi, zcoord, critCoords, 
  mobilizedShear, mobShrI, sliceHght, sliceHghtW, shearFNoIntsl, shearRNoIntsl,
  slcWght, watrForce, resistiveShear, shrResI, intShrForce, baseHydroForce, 
  surfHydroForce, totNrmForce, nrmFSubWat, surfLoad, baseAngle, surfAngle, 
  impLoadAngle, baseWthX, baseLngth, surfLngth, midpntHght, fx, fy, fn, ft, 
  nrmForceSum, watForceSum, sliceHghtRight, sliceHghtLeft, porePressure, 
  intNormForce, shrStress, totNormStress, tangStress, effectiveStress, 
  effNormStress, dryVol, satVol, rotForce, momntArm, posVec :: UnitalChunk
  
{-FIXME: Many of these need to be split into term, defn pairs as
         their defns are mixed into the terms.-}

intNormForce :: UnitalChunk
intNormForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"G_i" (String -> NP
cn String
"interslice normal forces")
  (String -> Sentence
S String
"the forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"exerted between each pair" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"adjacent slices")
  (Symbol -> Symbol
vec Symbol
cG) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

slipHght :: UnitalChunk
slipHght = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip,i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"slip surface")
  (String -> Sentence
S String
"heights of the slip surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lY) Symbol
lSlip) (Space -> Space
Vect Space
Real) UnitDefn
metre

slipDist :: UnitalChunk
slipDist = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip,i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"slip surface")
  (ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"points on the slip surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lX) Symbol
lSlip) (Space -> Space
Vect Space
Real) UnitDefn
metre

xi :: UnitalChunk
xi = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xCoord ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
cartesian))) Symbol
lX Space
Real UnitDefn
metre

yi :: UnitalChunk
yi = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord)
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
yCoord ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
cartesian))) Symbol
lY Space
Real UnitDefn
metre

zcoord :: UnitalChunk
zcoord = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"z" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zCoord)
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
zCoord ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
cartesian))) Symbol
lZ Space
Real UnitDefn
metre

-- FIXME: the 'symbol' for this should not have { and } embedded in it.
-- They have been removed now, but we need a reasonable notation.
critCoords :: UnitalChunk
critCoords = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"(xcs,ycs)" (String -> NP
cn String
"critical slip surface coordinates")
  (String -> Sentence
S String
"the set" Sentence -> Sentence -> Sentence
`S.of_` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
xCoord ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_PP` ConceptChunk
yCoord) Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"that describe the vertices" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"critical slip surface")
  ([Symbol] -> Symbol
Concat [Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lX) Symbol
lCSlip, String -> Symbol
label String
",", Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lY) Symbol
lCSlip]) Space
Real UnitDefn
metre

mobilizedShear :: UnitalChunk
mobilizedShear = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"mobilizedShear" (String -> NP
cn' String
"mobilized shear force")
  (String -> Sentence
S String
"the shear force" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"direction" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"potential motion") Symbol
cS Space
Real UnitDefn
newton

resistiveShear :: UnitalChunk
resistiveShear = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"resistiveShear" (String -> NP
cn' String
"resistive shear force")
  (String -> Sentence
S String
"the Mohr Coulomb frictional force that describes the limit" Sentence -> Sentence -> Sentence
`S.of_`
    UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
mobilizedShear Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that can be withstood before failure")
  Symbol
cP Space
Real UnitDefn
newton

mobShrI :: UnitalChunk
mobShrI = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"mobShrFs" (String -> NP
cn' String
"mobilized shear force")
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
mobilizedShear) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"for each slice")
  (Symbol -> Symbol
vec Symbol
cS) Space
Real UnitDefn
forcePerMeterU --FIXME: DUE TO ID THIS WILL SHARE THE SAME SYMBOL AS CSM.mobShear
              -- This is fine for now, as they are the same concept, but when this
              -- symbol is used, it is usually indexed at i. That is handled in
              -- Expr.

shrResI :: UnitalChunk
shrResI = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"shrRes" (String -> NP
cn String
"resistive shear forces")
  (String -> Sentence
S String
"the Mohr Coulomb frictional forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"for each slice that describe the limit" Sentence -> Sentence -> Sentence
`S.of_` UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
mobilizedShear Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"the slice can withstand before failure")
  (Symbol -> Symbol
vec Symbol
cP) Space
Real UnitDefn
forcePerMeterU --FIXME: DUE TO ID THIS WILL SHARE THE SAME SYMBOL AS CSM.shearRes
              -- This is fine for now, as they are the same concept, but when this
              -- symbol is used, it is usually indexed at i. That is handled in
              -- Expr.

shearFNoIntsl :: UnitalChunk
shearFNoIntsl = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"T_i" (String -> NP
cn (String
"mobilized shear forces " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wiif)) 
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
mobilizedShear) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"per meter" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
wiif Sentence -> Sentence -> Sentence
`S.inThe`
   ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"each slice")
  (Symbol -> Symbol
vec Symbol
cT) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

shearRNoIntsl :: UnitalChunk
shearRNoIntsl = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"R_i" (String -> NP
cn (String
"resistive shear forces " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wiif))
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
resistiveShear) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"per meter" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
wiif Sentence -> Sentence -> Sentence
`S.inThe`
   ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"each slice")
  (Symbol -> Symbol
vec Symbol
cR) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

slcWght :: UnitalChunk
slcWght = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"W_i" (String -> NP
cn String
"weights")
  (String -> Sentence
S String
"the downward force per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"on each slice caused by" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
gravity)
  (Symbol -> Symbol
vec Symbol
cW) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

watrForce :: UnitalChunk
watrForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"H_i" (String -> NP
cn String
"interslice normal water forces") 
  (String -> Sentence
S String
"the normal water forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"exerted" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"between each pair" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"adjacent slices")
  (Symbol -> Symbol
vec Symbol
cH) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

intShrForce :: UnitalChunk
intShrForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"X_i" (String -> NP
cn String
"interslice shear forces") 
  (String -> Sentence
S String
"the shear forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"exerted between adjacent slices")
  (Symbol -> Symbol
vec Symbol
cX) (Space -> Space
Vect Space
Real)UnitDefn
forcePerMeterU

baseHydroForce :: UnitalChunk
baseHydroForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"U_b,i" (String -> NP
cn String
"base hydrostatic forces")
  (String -> Sentence
S String
"the forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from water pressure within each slice")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cU) Symbol
lBase) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

surfHydroForce :: UnitalChunk
surfHydroForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"U_t,i" (String -> NP
cn String
"surface hydrostatic forces")
  (String -> Sentence
S String
"the forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from water pressure acting" Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"into each slice from standing water" Sentence -> Sentence -> Sentence
`S.onThe` String -> Sentence
S String
"slope surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cU) Symbol
lSurface) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

totNrmForce :: UnitalChunk
totNrmForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"N_i" (String -> NP
cn String
"normal forces")
  (String -> Sentence
S String
"the total reactive forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"for each slice" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"soil surface subject to a body resting on it")
  (Symbol -> Symbol
vec Symbol
cN) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

nrmFSubWat :: UnitalChunk
nrmFSubWat = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"N'_i" (String -> NP
cn String
"effective normal forces")
  (String -> Sentence
S String
"the forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"soil surface" Sentence -> Sentence -> Sentence
`sC`
   String -> Sentence
S String
"subtracting pore water reactive force from total reactive force") 
  (Symbol -> Symbol
vec (Symbol -> Symbol
prime (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"N")) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

surfLoad :: UnitalChunk
surfLoad = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"Q_i" (String -> NP
cn String
"external forces") 
  (String -> Sentence
S String
"the forces per meter" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"acting into the surface from the midpoint" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice")
  (Symbol -> Symbol
vec Symbol
cQ) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

baseAngle :: UnitalChunk
baseAngle = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"alpha_i" (String -> NP
cn String
"base angles")
  (String -> Sentence
S String
"the angles between the base" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice and the horizontal")
  (Symbol -> Symbol
vec Symbol
lAlpha) (Space -> Space
Vect Space
Real) UnitDefn
degree

surfAngle :: UnitalChunk
surfAngle = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"beta_i" (String -> NP
cn String
"surface angles")
  (String -> Sentence
S String
"the angles between the surface" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice and the horizontal")
  (Symbol -> Symbol
vec Symbol
lBeta) (Space -> Space
Vect Space
Real) UnitDefn
degree

impLoadAngle :: UnitalChunk
impLoadAngle = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"omega_i" (String -> NP
cn String
"imposed load angles")
  (String -> Sentence
S String
"the angles between the external force acting into the surface" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice and the vertical")
  (Symbol -> Symbol
vec Symbol
lOmega) (Space -> Space
Vect Space
Real) UnitDefn
degree

baseWthX :: UnitalChunk
baseWthX = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"b_i" (String -> NP
cn String
"base width of slices")
  (String -> Sentence
S String
"the width" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir)
  (Symbol -> Symbol
vec Symbol
lB) (Space -> Space
Vect Space
Real) UnitDefn
metre

baseLngth :: UnitalChunk
baseLngth = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"l_b,i" (String -> NP
cn String
"total base lengths of slices") 
  (String -> Sentence
S String
"the lengths of each slice in the direction parallel to the slope of the base")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cL) Symbol
lB) (Space -> Space
Vect Space
Real) UnitDefn
metre

surfLngth :: UnitalChunk
surfLngth = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"l_s,i" (String -> NP
cn String
"surface lengths of slices")
  (String -> Sentence
S String
"the lengths" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"direction parallel" Sentence -> Sentence -> Sentence
`S.toThe` String -> Sentence
S String
"slope" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cL) Symbol
lS) (Space -> Space
Vect Space
Real) UnitDefn
metre

midpntHght :: UnitalChunk
midpntHght = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"h_i" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"heights" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"slices")
  (String -> Sentence
S String
"the heights" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from the base" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`S.toThe`
   String -> Sentence
S String
"slope surface" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"at the" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"midpoint" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"slice")
  (Symbol -> Symbol
vec Symbol
lH) (Space -> Space
Vect Space
Real) UnitDefn
metre

porePressure :: UnitalChunk
porePressure = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"u" (String -> NP
cn String
"pore pressure")
  (String -> Sentence
S String
"the pressure that comes from water within the soil") Symbol
lU Space
Real UnitDefn
pascal
  
shrStress :: UnitalChunk
shrStress = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tau_i" (String -> NP
cn String
"shear strength")
  (String -> Sentence
S String
"the strength" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"material against shear failure") (Symbol -> Symbol -> Symbol
sup Symbol
lTau (String -> Symbol
label String
"f")) Space
Real UnitDefn
pascal

sliceHght :: UnitalChunk
sliceHght = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"h_z,i" (String -> NP
cn String
"heights of interslice normal forces")
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (UnitalChunk
height UnitalChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThePS` ConceptChunk
yDir) Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"interslice normal forces on each slice")
  (Symbol -> Symbol
subZ (Symbol -> Symbol
vec Symbol
lH)) Space
Real UnitDefn
metre

sliceHghtW :: UnitalChunk
sliceHghtW = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"h_z,w,i" (String -> NP
cn String
"heights of the water table")
  (String -> Sentence
S String
"the heights" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from the base" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`S.toThe` String -> Sentence
S String
"water table")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lH) Symbol
lHeights) Space
Real UnitDefn
metre

nrmShearNum :: UnitalChunk
nrmShearNum = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"C_num,i" (String -> NP
cn String
"proportionality constant numerator")
  (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String
"values for each slice that sum together to form the numerator of the " String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
"interslice normal to shear force proportionality constant")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cC) Symbol
lNum) (Space -> Space
Vect Space
Real) UnitDefn
newton
  
nrmShearDen :: UnitalChunk
nrmShearDen = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"C_den,i" (String -> NP
cn String
"proportionality constant denominator")
  (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String
"values for each slice that sum together to form the denominator of the " String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
"interslice normal to shear force proportionality constant")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cC) Symbol
lDen) (Space -> Space
Vect Space
Real) UnitDefn
newton

fx :: UnitalChunk
fx = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"fx" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"force")
  (String -> Sentence
S String
"the force acting" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir) (Symbol -> Symbol
subX Symbol
cF) Space
Real UnitDefn
newton

fy :: UnitalChunk
fy = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"fy" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"force")
  (String -> Sentence
S String
"the force acting" Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yDir) (Symbol -> Symbol
subY Symbol
cF) Space
Real UnitDefn
newton

fn :: UnitalChunk
fn = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"F_n" (String -> NP
cn String
"total normal force") (String -> Sentence
S String
"component" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"force" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"normal direction")
  (Symbol -> Symbol -> Symbol
sub Symbol
cF (String -> Symbol
label String
"n")) Space
Real UnitDefn
newton

ft :: UnitalChunk
ft = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"F_t" (String -> NP
cn String
"tangential force") (String -> Sentence
S String
"component" Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"force" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"tangential direction")
  (Symbol -> Symbol -> Symbol
sub Symbol
cF (String -> Symbol
label String
"t")) Space
Real UnitDefn
newton

nrmForceSum :: UnitalChunk
nrmForceSum = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"F_x^G" (String -> NP
cn String
"sums of the interslice normal forces") 
  (String -> Sentence
S String
"the sums" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"normal forces acting on each pair" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"adjacent interslice boundaries")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
subX (Symbol -> Symbol
vec Symbol
cF)) Symbol
lNorm) Space
Real UnitDefn
newton

watForceSum :: UnitalChunk
watForceSum = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"F_x^H" (String -> NP
cn String
"sums of the interslice normal water forces") 
  (String -> Sentence
S String
"the sums" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"normal water forces acting on each pair" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"adjacent interslice boundaries")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
subX (Symbol -> Symbol
vec Symbol
cF)) Symbol
lNormWat) Space
Real UnitDefn
newton

sliceHghtRight :: UnitalChunk
sliceHghtRight = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"h^R" (String -> NP
cn String
"heights of the right side of slices") 
  (String -> Sentence
S String
"the heights" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"right side" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"assuming slice surfaces have negative slope")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
vec Symbol
lH) Symbol
lRight) (Space -> Space
Vect Space
Real) UnitDefn
metre

sliceHghtLeft :: UnitalChunk
sliceHghtLeft = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"h^L" (String -> NP
cn String
"heights of the left side of slices") 
  (String -> Sentence
S String
"the heights" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"left side" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"each slice" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"assuming slice surfaces have negative slope")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
vec Symbol
lH) Symbol
lLeft) (Space -> Space
Vect Space
Real) UnitDefn
metre

totNormStress :: UnitalChunk
totNormStress = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"sigma" (String -> NP
cn' String
"total normal stress")
  (String -> Sentence
S String
"the total force per area acting" Sentence -> Sentence -> Sentence
`S.onThe` String -> Sentence
S String
"soil mass") Symbol
lSigma Space
Real UnitDefn
pascal

tangStress :: UnitalChunk
tangStress = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"tau" (String -> NP
cn' String
"tangential stress")
  (String -> Sentence
S String
"the shear force per unit area") Symbol
lTau Space
Real UnitDefn
pascal

effectiveStress :: UnitalChunk
effectiveStress = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"sigma'" (String -> NP
cn' String
"effective stress")
  (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String
"the stress in a soil mass that is effective in causing volume changes " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"and mobilizes the shear strength arising from friction; represents the " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"average stress carried by the soil skeleton")
  (Symbol -> Symbol
prime Symbol
lSigma) Space
Real UnitDefn
pascal

effNormStress :: UnitalChunk
effNormStress = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"sigmaN'" (String -> NP
nounPhraseSP String
"effective normal stress")
  (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String
"the normal stress in a soil mass that is effective in causing volume " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"changes; represents the average normal stress carried by the soil skeleton")
  (Symbol -> Symbol
prime (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
lSigma Symbol
cN) Space
Real UnitDefn
pascal

dryVol :: UnitalChunk
dryVol = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"V_dry" (String -> NP
cn String
"volumes of dry soil")
  (String -> Sentence
S String
"the amount" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"space occupied by dry soil" Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"each slice")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cV) Symbol
lDry) Space
Real UnitDefn
m_3

satVol :: UnitalChunk
satVol = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"V_sat" (String -> NP
cn String
"volumes of saturated soil")
  (String -> Sentence
S String
"the amount" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"space occupied by saturated soil" Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"each slice")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cV) Symbol
lSat) Space
Real UnitDefn
m_3

rotForce :: UnitalChunk
rotForce = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"F_rot" (String -> NP
cn String
"force causing rotation") 
  (String -> Sentence
S String
"a force" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"direction" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"rotation") (Symbol -> Symbol -> Symbol
sub Symbol
cF Symbol
lRot) Space
Real UnitDefn
newton
  
momntArm :: UnitalChunk
momntArm = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"r" (String -> NP
cn' String
"length of the moment arm") 
  (String -> Sentence
S String
"the distance between a force causing rotation and the axis of rotation")
  Symbol
lR Space
Real UnitDefn
metre

----------------------
-- Unitless Symbols --
----------------------

unitless :: [DefinedQuantityDict]
unitless :: [DefinedQuantityDict]
unitless = [DefinedQuantityDict
earthqkLoadFctr, DefinedQuantityDict
normToShear, DefinedQuantityDict
scalFunc, DefinedQuantityDict
numbSlices, DefinedQuantityDict
minFunction, 
  DefinedQuantityDict
mobShrC, DefinedQuantityDict
shrResC, DefinedQuantityDict
index, DefinedQuantityDict
pi_, DefinedQuantityDict
varblV, DefinedQuantityDict
fsMin, DefinedQuantityDict
unitVectj]

earthqkLoadFctr, normToShear, scalFunc, numbSlices,
  minFunction, mobShrC, shrResC, index, varblV :: DefinedQuantityDict

earthqkLoadFctr :: DefinedQuantityDict
earthqkLoadFctr = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"K_c" (String -> NP
nounPhraseSP String
"seismic coefficient")
  (String
"the proportionality factor of force that weight pushes outwards; " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"caused by seismic earth movements"))
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Stage -> Symbol) -> Symbol -> Stage -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
cK Symbol
lCoeff) Space
Real Maybe UnitDefn
forall a. Maybe a
Nothing 

normToShear :: DefinedQuantityDict
normToShear = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"lambda" (String -> NP
nounPhraseSP String
"proportionality constant")
  String
"the ratio of the interslice normal to the interslice shear force")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
lLambda) Space
Real Maybe UnitDefn
forall a. Maybe a
Nothing

scalFunc :: DefinedQuantityDict
scalFunc = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"f_i" 
  (String -> NP
nounPhraseSP String
"interslice normal to shear force ratio variation function")
  (String -> Sentence
S String
"a function" Sentence -> Sentence -> Sentence
`S.of_` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
distance UnitalChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
xDir) Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"that describes the variation" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"interslice normal to shear ratio"))
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
lF)) Space
Real Maybe UnitDefn
forall a. Maybe a
Nothing 

-- As we're going to subtract from this, can't type it 'Natural'.
numbSlices :: DefinedQuantityDict
numbSlices = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"n" (String -> NP
nounPhraseSP String
"number of slices")
  String
"the number of slices into which the slip surface is divided")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
lN) Space
Integer Maybe UnitDefn
forall a. Maybe a
Nothing

-- horrible hack, but it's only used once, so...
minFunction :: DefinedQuantityDict
minFunction = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"Upsilon" (String -> NP
nounPhraseSP String
"minimization function")
  String
"generic minimization function or algorithm")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
cUpsilon) ([Space] -> Space -> Space
mkFunction (Int -> Space -> [Space]
forall a. Int -> a -> [a]
replicate Int
10 Space
Real) Space
Real) Maybe UnitDefn
forall a. Maybe a
Nothing

mobShrC :: DefinedQuantityDict
mobShrC = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"Psi"
  (String -> NP
nounPhraseSP String
"second function for incorporating interslice forces into shear force")
  (String
"the function for converting mobile shear " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wiif String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
", to a calculation considering the interslice forces"))
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
cPsi)) (Space -> Space
Vect Space
Real) Maybe UnitDefn
forall a. Maybe a
Nothing

shrResC :: DefinedQuantityDict
shrResC = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"Phi"
  (String -> NP
nounPhraseSP String
"first function for incorporating interslice forces into shear force")
  (String
"the function for converting resistive shear " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wiif String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
", to a calculation considering the interslice forces"))
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
cPhi)) (Space -> Space
Vect Space
Real) Maybe UnitDefn
forall a. Maybe a
Nothing

--------------------
-- Index Function --
--------------------

varblV :: DefinedQuantityDict
varblV = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"varblV" (String -> NP
nounPhraseSP String
"local index")
  String
"used as a bound variable index in calculations")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
lV) Space
Natural Maybe UnitDefn
forall a. Maybe a
Nothing

-- As we do arithmetic on index, must type it 'Integer' right now
index :: DefinedQuantityDict
index = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
"index" (String -> NP
nounPhraseSP String
"index")
  String
"a number representing a single slice")
  (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
lI) Space
Integer Maybe UnitDefn
forall a. Maybe a
Nothing 

-- FIXME: move to drasil-lang
indx1 :: (ExprC r, LiteralC r, Quantity a) => a -> r
indx1 :: forall r a. (ExprC r, LiteralC r, Quantity a) => a -> r
indx1 a
a = r -> r -> r
forall r. ExprC r => r -> r -> r
idx (a -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
a) (Integer -> r
forall r. LiteralC r => Integer -> r
int Integer
1)

indxn :: (ExprC r, Quantity a) => a -> r
indxn :: forall r a. (ExprC r, Quantity a) => a -> r
indxn a
a = r -> r -> r
forall r. ExprC r => r -> r -> r
idx (a -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
a) (DefinedQuantityDict -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
numbSlices)

inxi, inxiP1, inxiM1 :: (ExprC r, LiteralC r, Quantity e) => e -> r
inxiP1 :: forall r a. (ExprC r, LiteralC r, Quantity a) => a -> r
inxiP1 e
e = e -> Integer -> r
forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx e
e Integer
1
inxi :: forall r a. (ExprC r, LiteralC r, Quantity a) => a -> r
inxi   e
e = e -> Integer -> r
forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx e
e Integer
0
inxiM1 :: forall r a. (ExprC r, LiteralC r, Quantity a) => a -> r
inxiM1 e
e = e -> Integer -> r
forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx e
e (-Integer
1)

inx :: (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx :: forall r e. (ExprC r, LiteralC r, Quantity e) => e -> Integer -> r
inx e
e Integer
n 
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = r -> r -> r
forall r. ExprC r => r -> r -> r
idx (e -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (DefinedQuantityDict -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index r -> r -> r
forall r. ExprC r => r -> r -> r
$- Integer -> r
forall r. LiteralC r => Integer -> r
int (-Integer
n))
  | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = r -> r -> r
forall r. ExprC r => r -> r -> r
idx (e -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (DefinedQuantityDict -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index)
  | Bool
otherwise = r -> r -> r
forall r. ExprC r => r -> r -> r
idx (e -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (DefinedQuantityDict -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index r -> r -> r
forall r. ExprC r => r -> r -> r
$+ Integer -> r
forall r. LiteralC r => Integer -> r
int Integer
n)

sum1toN :: (ExprC r, LiteralC r) => r -> r
sum1toN :: forall r. (ExprC r, LiteralC r) => r -> r
sum1toN = Symbol -> r -> r -> r -> r
forall r. ExprC r => Symbol -> r -> r -> r -> r
defsum (DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
index) (Integer -> r
forall r. LiteralC r => Integer -> r
int Integer
1) (DefinedQuantityDict -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
numbSlices)

-- Labels

lBase, lCoeff, lCoords, lCSlip, lDen, lDry, lHeights, lLeft, lMaxEtr, lMaxExt,
  lMinEtr, lMinExt, lNorm, lNormWat, lNum, lRight, lRot, lSafety, lSat, lSlip,
  lSlope, lSurface, lWatTab :: Symbol
lBase :: Symbol
lBase    = String -> Symbol
label String
"b"
lCoeff :: Symbol
lCoeff   = String -> Symbol
label String
"c"
lCoords :: Symbol
lCoords  = String -> Symbol
label String
"(x,y)"
lCSlip :: Symbol
lCSlip   = String -> Symbol
label String
"cs"
lDen :: Symbol
lDen     = String -> Symbol
label String
"den"
lDry :: Symbol
lDry     = String -> Symbol
label String
"dry"
lHeights :: Symbol
lHeights = String -> Symbol
label String
"z,w"
lLeft :: Symbol
lLeft    = String -> Symbol
label String
"L"
lMaxEtr :: Symbol
lMaxEtr  = String -> Symbol
label String
"maxEtr"
lMaxExt :: Symbol
lMaxExt  = String -> Symbol
label String
"maxExt"
lMinEtr :: Symbol
lMinEtr  = String -> Symbol
label String
"minEtr"
lMinExt :: Symbol
lMinExt  = String -> Symbol
label String
"minExt"
lNorm :: Symbol
lNorm    = String -> Symbol
label String
"G"
lNormWat :: Symbol
lNormWat = String -> Symbol
label String
"H"
lNum :: Symbol
lNum     = String -> Symbol
label String
"num"
lRight :: Symbol
lRight   = String -> Symbol
label String
"R"
lRot :: Symbol
lRot     = String -> Symbol
label String
"rot"
lSafety :: Symbol
lSafety  = String -> Symbol
label String
"S"
lSat :: Symbol
lSat     = String -> Symbol
label String
"sat"
lSlip :: Symbol
lSlip    = String -> Symbol
label String
"slip"
lSlope :: Symbol
lSlope   = String -> Symbol
label String
"slope"
lSurface :: Symbol
lSurface = String -> Symbol
label String
"g"
lWatTab :: Symbol
lWatTab  = String -> Symbol
label String
"wt"