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