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 = forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr ConstrConcept
coords forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
inputs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [ConstrConcept]
outputs
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UnitalChunk]
units forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw ConstrConcept
coords forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw [UncertQ]
inputsWUncrtn forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UncertQ]
inputsWUncrtn forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 = [physc $ \_ -> -- 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 = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slope,i"
  (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the slope")
  (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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

slopeHght :: UncertQ
slopeHght = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slope,i"
  (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"the slope")
  (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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

waterDist :: UncertQ
waterDist = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"x_wt,i" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ 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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Uncertainty
defaultUncrt

waterHght :: UncertQ
waterHght = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
"y_wt,i" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ 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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) Uncertainty
defaultUncrt

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

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

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

yMaxSlip :: UncertQ
yMaxSlip = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip^max"
  (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"maximum" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord)
  (String -> Sentence
S String
"the maximum potential" Sentence -> Sentence -> 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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
30)) Uncertainty
defaultUncrt

yMinSlip :: UncertQ
yMinSlip = forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip^min"
  (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"minimum" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yCoord)
  (String -> Sentence
S String
"the minimum potential" Sentence -> Sentence -> 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) [] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)) Uncertainty
defaultUncrt

effCohesion :: UncertQ
effCohesion = 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 forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"c") UnitDefn
pascal Space
Real [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Integer -> r
exactDbl Integer
10000) Uncertainty
defaultUncrt

fricAngle :: UncertQ
fricAngle = 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 " 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
physc forall a b. (a -> b) -> a -> b
$ forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
90)]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
25) Uncertainty
defaultUncrt

dryWeight :: UncertQ
dryWeight = 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]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
20000) Uncertainty
defaultUncrt

satWeight :: UncertQ
satWeight = 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]
  (forall r. LiteralC r => Integer -> r
exactDbl Integer
20000) Uncertainty
defaultUncrt

waterWeight :: UncertQ
waterWeight = 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]
  (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," forall a. [a] -> [a] -> [a]
++
  String
" or half-sine if false")) (forall a b. a -> b -> a
const (String -> Symbol
variable String
"const_f")) Space
Boolean forall a. Maybe a
Nothing

{-Output Variables-} --FIXME: See if there should be typical values
fs, coords :: ConstrConcept
fs :: ConstrConcept
fs = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' ConceptChunk
fsConcept (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
cF Symbol
lSafety) Space
Real forall a. Maybe a
Nothing)
  [ConstraintE
gtZeroConstr] (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")
  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
supMin (forall q. HasSymbol q => q -> Symbol
eqSymb ConstrConcept
fs)) Space
Real forall a. Maybe a
Nothing 
-- Once things are converted to the new style of instance models, this will
-- be removed/fixed.

coords :: ConstrConcept
coords = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> ConstrConcept
constrainedNRV' (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
+:+
   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 = forall a b. (a -> b) -> [a] -> [b]
map 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 = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"exerted between each pair of adjacent slices")
  (Symbol -> Symbol
vec Symbol
cG) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

slipHght :: UnitalChunk
slipHght = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"y_slip,i" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
yCoord Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of the 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 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_slip,i" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
xCoord Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of the slip surface")
  (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 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"x_i" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord)
  (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
xCoord forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
cartesian))) Symbol
lX Space
Real UnitDefn
metre

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

zcoord :: UnitalChunk
zcoord = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"z"   (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zCoord)
  (forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (ConceptChunk
zCoord 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 = 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_` forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
xCoord 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 of the 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 = 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 in the direction of potential motion") Symbol
cS Space
Real UnitDefn
newton

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

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

slcWght :: UnitalChunk
slcWght = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"on each slice caused by" Sentence -> Sentence -> 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 = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"exerted" Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"between each pair of adjacent slices")
  (Symbol -> Symbol
vec Symbol
cH) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

intShrForce :: UnitalChunk
intShrForce = 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` 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 = 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` 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 = 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` 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 on the slope surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cU) Symbol
lSurface) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

totNrmForce :: UnitalChunk
totNrmForce = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"for each slice of a soil surface subject to a body resting on it")
  (Symbol -> Symbol
vec Symbol
cN) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

nrmFSubWat :: UnitalChunk
nrmFSubWat = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"for each slice of a 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 forall a b. (a -> b) -> a -> b
$ String -> Symbol
variable String
"N")) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

surfLoad :: UnitalChunk
surfLoad = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"acting into the surface from the midpoint of each slice")
  (Symbol -> Symbol
vec Symbol
cQ) (Space -> Space
Vect Space
Real) UnitDefn
forcePerMeterU

baseAngle :: UnitalChunk
baseAngle = 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 of each slice and the horizontal")
  (Symbol -> Symbol
vec Symbol
lAlpha) (Space -> Space
Vect Space
Real) UnitDefn
degree

surfAngle :: UnitalChunk
surfAngle = 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 of each slice and the horizontal")
  (Symbol -> Symbol
vec Symbol
lBeta) (Space -> Space
Vect Space
Real) UnitDefn
degree

impLoadAngle :: UnitalChunk
impLoadAngle = 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 of each slice and the vertical")
  (Symbol -> Symbol
vec Symbol
lOmega) (Space -> Space
Vect Space
Real) UnitDefn
degree

baseWthX :: UnitalChunk
baseWthX = 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 of each slice" Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir)
  (Symbol -> Symbol
vec Symbol
lB) (Space -> Space
Vect Space
Real) UnitDefn
metre

baseLngth :: UnitalChunk
baseLngth = 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 = 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 of each slice in the direction parallel to the slope of the surface")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cL) Symbol
lS) (Space -> Space
Vect Space
Real) UnitDefn
metre

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

porePressure :: UnitalChunk
porePressure = 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 = 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 of a material against shear failure") (Symbol -> Symbol -> Symbol
sup Symbol
lTau (String -> Symbol
label String
"f")) Space
Real UnitDefn
pascal

sliceHght :: UnitalChunk
sliceHght = 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")
  (forall n. NounPhrase n => n -> Sentence
pluralNP (UnitalChunk
height 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 = 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` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
yDir Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from the base of each slice to the water table")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
lH) Symbol
lHeights) Space
Real UnitDefn
metre

nrmShearNum :: UnitalChunk
nrmShearNum = 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 forall a b. (a -> b) -> a -> b
$ String
"values for each slice that sum together to form the numerator of the " 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 = 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 forall a b. (a -> b) -> a -> b
$ String
"values for each slice that sum together to form the denominator of the " 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 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"fx" (Sentence -> NP
nounPhraseSent forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xCoord Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of the force")
  (String -> Sentence
S String
"the force acting" Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
xDir) (Symbol -> Symbol
subX Symbol
cF) Space
Real UnitDefn
newton

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

fn :: UnitalChunk
fn = 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 of a force in the normal direction")
  (Symbol -> Symbol -> Symbol
sub Symbol
cF (String -> Symbol
label String
"n")) Space
Real UnitDefn
newton

ft :: UnitalChunk
ft = 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 of a force in the tangential direction")
  (Symbol -> Symbol -> Symbol
sub Symbol
cF (String -> Symbol
label String
"t")) Space
Real UnitDefn
newton

nrmForceSum :: UnitalChunk
nrmForceSum = 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 of the normal forces acting on each pair of adjacent interslice boundaries")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
subX (Symbol -> Symbol
vec Symbol
cF)) Symbol
lNorm) Space
Real UnitDefn
newton

watForceSum :: UnitalChunk
watForceSum = 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 of the normal water forces acting on each pair of adjacent interslice boundaries")
  (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol
subX (Symbol -> Symbol
vec Symbol
cF)) Symbol
lNormWat) Space
Real UnitDefn
newton

sliceHghtRight :: UnitalChunk
sliceHghtRight = 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 of the right side of each slice, 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 = 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 of the left side of each slice, 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 = 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 on the soil mass") Symbol
lSigma Space
Real UnitDefn
pascal

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

dryVol :: UnitalChunk
dryVol = 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 of space occupied by dry soil for each slice")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cV) Symbol
lDry) Space
Real UnitDefn
m_3

satVol :: UnitalChunk
satVol = 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 of space occupied by saturated soil for each slice")
  (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cV) Symbol
lSat) Space
Real UnitDefn
m_3

rotForce :: UnitalChunk
rotForce = 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 in the direction of rotation") (Symbol -> Symbol -> Symbol
sub Symbol
cF Symbol
lRot) Space
Real UnitDefn
newton
  
momntArm :: UnitalChunk
momntArm = 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; " forall a. [a] -> [a] -> [a]
++
   String
"caused by seismic earth movements"))
  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol
sub Symbol
cK Symbol
lCoeff) Space
Real 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")
  (forall a b. a -> b -> a
const Symbol
lLambda) Space
Real 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_` forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
distance forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
xDir) Sentence -> Sentence -> Sentence
+:+
   String -> Sentence
S String
"that describes the variation of the interslice normal to shear ratio"))
  (forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
lF)) Space
Real 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")
  (forall a b. a -> b -> a
const Symbol
lN) Space
Integer 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")
  (forall a b. a -> b -> a
const Symbol
cUpsilon) ([Space] -> Space -> Space
mkFunction (forall a. Int -> a -> [a]
replicate Int
10 Space
Real) Space
Real) 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 " forall a. [a] -> [a] -> [a]
++ String
wiif forall a. [a] -> [a] -> [a]
++
   String
", to a calculation considering the interslice forces"))
  (forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
cPsi)) (Space -> Space
Vect Space
Real) 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 " forall a. [a] -> [a] -> [a]
++ String
wiif forall a. [a] -> [a] -> [a]
++
   String
", to a calculation considering the interslice forces"))
  (forall a b. a -> b -> a
const (Symbol -> Symbol
vec Symbol
cPhi)) (Space -> Space
Vect Space
Real) 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")
  (forall a b. a -> b -> a
const Symbol
lV) Space
Natural 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")
  (forall a b. a -> b -> a
const Symbol
lI) Space
Integer 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 = forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
a) (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 = forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
a) (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 = 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 = 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 = 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 forall a. Ord a => a -> a -> Bool
< Integer
0     = forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
$- forall r. LiteralC r => Integer -> r
int (-Integer
n))
  | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0    = forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index)
  | Bool
otherwise = forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy e
e) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
`addI` 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 = forall r. ExprC r => Symbol -> r -> r -> r -> r
defsum (forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
index) (forall r. LiteralC r => Integer -> r
int Integer
1) (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"