{-# LANGUAGE PostfixOperators #-}
module Drasil.SSP.Assumptions where

import Language.Drasil
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 (plnStrn, slpSrf, slopeSrf, slope,
  soil, soilPrpty, intrslce, slice, waterTable)
import Drasil.SSP.Unitals (baseHydroForce, effCohesion, fricAngle, intNormForce,
  intShrForce, normToShear, numbSlices, scalFunc, shrStress, slipDist, slipHght,
  surfHydroForce, surfLoad, xi, zcoord)
import Drasil.SSP.References (morgenstern1965)

import Data.Drasil.Concepts.Documentation (analysis, assumpDom, assumption, 
  condition, constant, effect, interface)
import Data.Drasil.Concepts.Physics (force, position, stress, twoD)
import Data.Drasil.Concepts.Math (surface, unit_)


assumptions :: [ConceptInstance]
assumptions :: [ConceptInstance]
assumptions = [ConceptInstance
assumpSSC, ConceptInstance
assumpFOSL, ConceptInstance
assumpSLH, ConceptInstance
assumpSP, ConceptInstance
assumpSLI,
  ConceptInstance
assumpINSFL, ConceptInstance
assumpPSC, ConceptInstance
assumpENSL, ConceptInstance
assumpSBSBISL, ConceptInstance
assumpES, ConceptInstance
assumpSF,
  ConceptInstance
assumpSL, ConceptInstance
assumpWIBE, ConceptInstance
assumpWISE, ConceptInstance
assumpNESSS, ConceptInstance
assumpHFSM]

assumpSSC, assumpFOSL, assumpSLH, assumpSP, assumpSLI, assumpINSFL,
  assumpPSC, assumpENSL, assumpSBSBISL, assumpES, assumpSF, 
  assumpSL, assumpWIBE, assumpWISE, assumpNESSS, assumpHFSM :: ConceptInstance

assumpSSC :: ConceptInstance
assumpSSC = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSSC" Sentence
monotonicF String
"Slip-Surface-Concave" ConceptChunk
assumpDom
assumpFOSL :: ConceptInstance
assumpFOSL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpFOS" Sentence
slopeS String
"Factor-of-Safety" ConceptChunk
assumpDom
assumpSLH :: ConceptInstance
assumpSLH = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSLH" Sentence
homogeneousL String
"Soil-Layer-Homogeneous" ConceptChunk
assumpDom
assumpSP :: ConceptInstance
assumpSP = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSP" Sentence
propertiesS String
"Soil-Properties" ConceptChunk
assumpDom
assumpSLI :: ConceptInstance
assumpSLI = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSLI" Sentence
isotropicP String
"Soil-Layers-Isotropic" ConceptChunk
assumpDom
assumpINSFL :: ConceptInstance
assumpINSFL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpINSFL" Sentence
linearS String
"Interslice-Norm-Shear-Forces-Linear" ConceptChunk
assumpDom
assumpPSC :: ConceptInstance
assumpPSC = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpPSC" Sentence
planeS String
"Plane-Strain-Conditions" ConceptChunk
assumpDom
assumpENSL :: ConceptInstance
assumpENSL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpENSL" Sentence
largeN String
"Effective-Norm-Stress-Large" ConceptChunk
assumpDom
assumpSBSBISL :: ConceptInstance
assumpSBSBISL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSBSBISL" Sentence
straightS String
"Surface-Base-Slice-between-Interslice-Straight-Lines" ConceptChunk
assumpDom
assumpES :: ConceptInstance
assumpES = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpES" Sentence
edgeS String
"Edge-Slices" ConceptChunk
assumpDom
assumpSF :: ConceptInstance
assumpSF = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSF" Sentence
seismicF String
"Seismic-Force" ConceptChunk
assumpDom
assumpSL :: ConceptInstance
assumpSL = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSL" Sentence
surfaceL String
"Surface-Load" ConceptChunk
assumpDom
assumpWIBE :: ConceptInstance
assumpWIBE = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpWIBE" Sentence
waterBIntersect String
"Water-Intersects-Base-Edge" 
  ConceptChunk
assumpDom
assumpWISE :: ConceptInstance
assumpWISE = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpWISE" Sentence
waterSIntersect String
"Water-Intersects-Surface-Edge" 
  ConceptChunk
assumpDom
assumpNESSS :: ConceptInstance
assumpNESSS = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpNESSS" Sentence
negligibleSlopeEffect 
  String
"Negligible-Effect-Surface-Slope-Seismic" ConceptChunk
assumpDom
assumpHFSM :: ConceptInstance
assumpHFSM = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpHFSM" Sentence
hydrostaticFMidpoint 
  String
"Hydrostatic-Force-Slice-Midpoint" ConceptChunk
assumpDom

monotonicF, slopeS, homogeneousL, isotropicP, linearS, planeS, largeN, 
  straightS, propertiesS, edgeS, seismicF, surfaceL, waterBIntersect, 
  waterSIntersect, negligibleSlopeEffect, hydrostaticFMidpoint :: Sentence

monotonicF :: Sentence
monotonicF = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
slpSrf),
  String -> Sentence
S String
"is concave" Sentence -> Sentence -> Sentence
`S.wrt` (forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slopeSrf) !.), String -> Sentence
S String
"The",
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
slipDist Sentence -> Sentence -> Sentence
`sC` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
slipHght), String -> Sentence
S String
"coordinates" Sentence -> Sentence -> Sentence
`S.ofA` 
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
slpSrf, String -> Sentence
S String
"follow a concave up function"]

slopeS :: Sentence
slopeS = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The factor of safety is assumed to be", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constant,
  String -> Sentence
S String
"across the entire", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
slpSrf]

homogeneousL :: Sentence
homogeneousL = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
soil), String -> Sentence
S String
"mass is homogeneous" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"with consistent", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
soilPrpty, String -> Sentence
S String
"throughout"]

propertiesS :: Sentence
propertiesS = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the IdeaDict
soilPrpty), String -> Sentence
S String
"are independent of dry or saturated",
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"with the exception of", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
unit_, String -> Sentence
S String
"weight"]

isotropicP :: Sentence
isotropicP = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
soil), String -> Sentence
S String
"mass is treated as if the", 
  forall n. NounPhrase n => n -> Sentence
phraseNP (UncertQ
effCohesion forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UncertQ
fricAngle), String -> Sentence
S String
"are isotropic properties"]

linearS :: Sentence
linearS = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Following the", forall n. NamedIdea n => n -> Sentence
phrase CI
assumption, String -> Sentence
S String
"of Morgenstern",
  String -> Sentence
S String
"and Price", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
morgenstern1965) Sentence -> Sentence -> Sentence
`sC` 
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
intNormForce forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
intShrForce),
  String -> Sentence
S String
"have a proportional relationship, depending on a proportionality",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constant, Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
normToShear), String -> Sentence
S String
"and a function", 
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
scalFunc), String -> Sentence
S String
"describing variation depending on", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xi, 
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
position]

planeS :: Sentence
planeS = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (IdeaDict
slope forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
slpSrf)),
  String -> Sentence
S String
"extends far into and out of the geometry" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
zcoord Sentence -> Sentence -> Sentence
+:+ 
  String -> Sentence
S String
"coordinate"), String -> Sentence
S String
"This implies", forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
plnStrn IdeaDict
condition) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"making", forall c. Idea c => c -> Sentence
short CI
twoD, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
analysis, String -> Sentence
S String
"appropriate"]

largeN :: Sentence
largeN = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The effective normal", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
stress,
  String -> Sentence
S String
"is large enough that the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
shrStress, String -> Sentence
S String
"to effective normal",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
stress, String -> Sentence
S String
"relationship can be approximated as a linear relationship"]

straightS :: Sentence
straightS = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
surface), String -> Sentence
S String
"and base of a",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"are approximated as straight lines"]

edgeS :: Sentence
edgeS = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
intrslce), forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
force, 
  String -> Sentence
S String
"at the 0th" Sentence -> Sentence -> Sentence
`S.and_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
numbSlices Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"th", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intrslce,
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
interface, String -> Sentence
S String
"are zero"]

seismicF :: Sentence
seismicF = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"There is no seismic", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
force, String -> Sentence
S String
"acting on the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope]

surfaceL :: Sentence
surfaceL = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"There is no imposed", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
surface, String -> Sentence
S String
"load" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"and therefore no", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surfLoad Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"acting on the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope]

waterBIntersect :: Sentence
waterBIntersect = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
waterTable), String -> Sentence
S String
"only intersects", 
  String -> Sentence
S String
"the base" Sentence -> Sentence -> Sentence
`S.ofA` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"at an edge" Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice]

waterSIntersect :: Sentence
waterSIntersect = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
waterTable), String -> Sentence
S String
"only intersects", 
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
slopeSrf), String -> Sentence
S String
"at the edge of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice]

negligibleSlopeEffect :: Sentence
negligibleSlopeEffect = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
effect)
  Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"slope" Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
surface forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
soil) Sentence -> Sentence -> Sentence
`S.onThe` String -> Sentence
S String
"seismic",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
force, String -> Sentence
S String
"is assumed to be negligible"]

hydrostaticFMidpoint :: Sentence
hydrostaticFMidpoint = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The resultant", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surfHydroForce,
  String -> Sentence
S String
"act into the midpoint of each", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"surface" Sentence -> Sentence -> Sentence
`S.andThe`
  String -> Sentence
S String
"resultant", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
baseHydroForce, String -> Sentence
S String
"act into the midpoint of each",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, String -> Sentence
S String
"base"]