{-# 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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSSC" Sentence monotonicF String "Slip-Surface-Concave" ConceptChunk assumpDom assumpFOSL :: ConceptInstance assumpFOSL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpFOS" Sentence slopeS String "Factor-of-Safety" ConceptChunk assumpDom assumpSLH :: ConceptInstance assumpSLH = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSLH" Sentence homogeneousL String "Soil-Layer-Homogeneous" ConceptChunk assumpDom assumpSP :: ConceptInstance assumpSP = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSP" Sentence propertiesS String "Soil-Properties" ConceptChunk assumpDom assumpSLI :: ConceptInstance assumpSLI = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSLI" Sentence isotropicP String "Soil-Layers-Isotropic" ConceptChunk assumpDom assumpINSFL :: ConceptInstance assumpINSFL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance 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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpPSC" Sentence planeS String "Plane-Strain-Conditions" ConceptChunk assumpDom assumpENSL :: ConceptInstance assumpENSL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpENSL" Sentence largeN String "Effective-Norm-Stress-Large" ConceptChunk assumpDom assumpSBSBISL :: ConceptInstance assumpSBSBISL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance 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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpES" Sentence edgeS String "Edge-Slices" ConceptChunk assumpDom assumpSF :: ConceptInstance assumpSF = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSF" Sentence seismicF String "Seismic-Force" ConceptChunk assumpDom assumpSL :: ConceptInstance assumpSL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpSL" Sentence surfaceL String "Surface-Load" ConceptChunk assumpDom assumpWIBE :: ConceptInstance assumpWIBE = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpWIBE" Sentence waterBIntersect String "Water-Intersects-Base-Edge" ConceptChunk assumpDom assumpWISE :: ConceptInstance assumpWISE = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic String "assumpWISE" Sentence waterSIntersect String "Water-Intersects-Surface-Edge" ConceptChunk assumpDom assumpNESSS :: ConceptInstance assumpNESSS = String -> Sentence -> String -> ConceptChunk -> ConceptInstance 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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance 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 [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk slpSrf), String -> Sentence S String "is concave" Sentence -> Sentence -> Sentence `S.wrt` (NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict slopeSrf) !.), String -> Sentence S String "The", Sentence -> Sentence sParen (UnitalChunk -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch UnitalChunk slipDist Sentence -> Sentence -> Sentence `sC` UnitalChunk -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch UnitalChunk slipHght), String -> Sentence S String "coordinates" Sentence -> Sentence -> Sentence `S.ofA` ConceptChunk -> Sentence 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" Sentence -> Sentence -> Sentence `S.is` String -> Sentence S String "assumed to be", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict constant, String -> Sentence S String "across the entire", ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk slpSrf] homogeneousL :: Sentence homogeneousL = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (IdeaDict -> NP 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", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence plural IdeaDict soilPrpty, String -> Sentence S String "throughout"] propertiesS :: Sentence propertiesS = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP' (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict soilPrpty), String -> Sentence S String "are independent" Sentence -> Sentence -> Sentence `S.of_` String -> Sentence S String "dry or saturated", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence plural IdeaDict condition Sentence -> Sentence -> Sentence `sC` String -> Sentence S String "with the exception" Sentence -> Sentence -> Sentence `S.of_` ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk unit_, String -> Sentence S String "weight"] isotropicP :: Sentence isotropicP = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict soil), String -> Sentence S String "mass is treated as if the", NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (UncertQ effCohesion UncertQ -> UncertQ -> NP 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", CI -> Sentence forall n. NamedIdea n => n -> Sentence phrase CI assumption Sentence -> Sentence -> Sentence `S.of_` String -> Sentence S String "Morgenstern", String -> Sentence S String "and Price", Sentence -> Sentence sParen (Citation -> Sentence forall r. (HasUID r, HasRefAddress r, HasShortName r) => r -> Sentence refS Citation morgenstern1965) Sentence -> Sentence -> Sentence `sC` NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (UnitalChunk intNormForce UnitalChunk -> UnitalChunk -> NP forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP `and_` UnitalChunk intShrForce), String -> Sentence S String "have a proportional relationship" Sentence -> Sentence -> Sentence `sC` String -> Sentence S String "depending on a proportionality", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict constant, Sentence -> Sentence sParen (DefinedQuantityDict -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch DefinedQuantityDict normToShear), String -> Sentence S String "and a function", Sentence -> Sentence sParen (DefinedQuantityDict -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch DefinedQuantityDict scalFunc), String -> Sentence S String "describing variation depending on", UnitalChunk -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch UnitalChunk xi, ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk position] planeS :: Sentence planeS = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (NP -> NP NP.the (IdeaDict slope IdeaDict -> ConceptChunk -> NP 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 (UnitalChunk -> Sentence 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", NP -> Sentence forall n. NounPhrase n => n -> Sentence pluralNP (ConceptChunk -> IdeaDict -> NP forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP combineNINI ConceptChunk plnStrn IdeaDict condition) Sentence -> Sentence -> Sentence `sC` String -> Sentence S String "making", CI -> Sentence forall c. Idea c => c -> Sentence short CI twoD, IdeaDict -> Sentence 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", ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk stress, String -> Sentence S String "is large enough that the", UnitalChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase UnitalChunk shrStress, String -> Sentence S String "to effective normal", ConceptChunk -> Sentence 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 [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk surface), String -> Sentence S String "and base of a", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice, String -> Sentence S String "are approximated as straight lines"] edgeS :: Sentence edgeS = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict intrslce), ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence plural ConceptChunk force, String -> Sentence S String "at the 0th" Sentence -> Sentence -> Sentence `S.and_` DefinedQuantityDict -> Sentence forall c. (HasUID c, HasSymbol c) => c -> Sentence ch DefinedQuantityDict numbSlices Sentence -> Sentence -> Sentence :+: String -> Sentence S String "th", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict intrslce, IdeaDict -> Sentence 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", ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk force, String -> Sentence S String "acting on the", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slope] surfaceL :: Sentence surfaceL = [Sentence] -> Sentence foldlSent [String -> Sentence S String "There is no imposed", ConceptChunk -> Sentence 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", UnitalChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase UnitalChunk surfLoad Sentence -> Sentence -> Sentence `sC` String -> Sentence S String "acting on the", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slope] waterBIntersect :: Sentence waterBIntersect = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP 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` IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice, String -> Sentence S String "at an edge" Sentence -> Sentence -> Sentence `S.ofThe` IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice] waterSIntersect :: Sentence waterSIntersect = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk waterTable), String -> Sentence S String "only intersects", NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict slopeSrf), String -> Sentence S String "at the edge" Sentence -> Sentence -> Sentence `S.ofA` IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice] negligibleSlopeEffect :: Sentence negligibleSlopeEffect = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (IdeaDict -> NP forall t. NamedIdea t => t -> NP the IdeaDict effect) Sentence -> Sentence -> Sentence `S.ofThe` String -> Sentence S String "slope" Sentence -> Sentence -> Sentence `S.ofThe` NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (ConceptChunk surface ConceptChunk -> IdeaDict -> NP forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP `ofThe` IdeaDict soil) Sentence -> Sentence -> Sentence `S.onThe` String -> Sentence S String "seismic", ConceptChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase ConceptChunk force Sentence -> Sentence -> Sentence `S.is` String -> Sentence S String "assumed to be negligible"] hydrostaticFMidpoint :: Sentence hydrostaticFMidpoint = [Sentence] -> Sentence foldlSent [String -> Sentence S String "The resultant", UnitalChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase UnitalChunk surfHydroForce, String -> Sentence S String "act into the midpoint of each", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice, String -> Sentence S String "surface" Sentence -> Sentence -> Sentence `S.andThe` String -> Sentence S String "resultant", UnitalChunk -> Sentence forall n. NamedIdea n => n -> Sentence phrase UnitalChunk baseHydroForce, String -> Sentence S String "act into the midpoint of each", IdeaDict -> Sentence forall n. NamedIdea n => n -> Sentence phrase IdeaDict slice, String -> Sentence S String "base"]