module Drasil.PDController.Assumptions where import Data.Drasil.Concepts.Documentation (assumpDom) import Data.Drasil.Concepts.PhysicalProperties (mass) import Data.Drasil.SI_Units (kilogram) import Drasil.PDController.Concepts import Language.Drasil import Language.Drasil.Chunk.Concept.NamedCombinators import qualified Language.Drasil.Sentence.Combinators as S assumptions :: [ConceptInstance] assumptions :: [ConceptInstance] assumptions = [ConceptInstance aPwrPlant, ConceptInstance aDecoupled, ConceptInstance aSP, ConceptInstance aExtDisturb, ConceptInstance aInitialValue, ConceptInstance aParallelEq, ConceptInstance aUnfilteredDerivative, ConceptInstance apwrPlantTxFnx, ConceptInstance aMass, ConceptInstance aDampingCoeff, ConceptInstance aStiffnessCoeff] aPwrPlant, aDecoupled, aSP, aExtDisturb, aInitialValue, aParallelEq, aUnfilteredDerivative, apwrPlantTxFnx, aMass, aDampingCoeff, aStiffnessCoeff :: ConceptInstance aPwrPlant :: ConceptInstance aPwrPlant = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "pwrPlant" Sentence pwrPlantDesc "Power plant" ConceptChunk assumpDom aDecoupled :: ConceptInstance aDecoupled = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "decoupled" Sentence aDecoupledDesc "Decoupled equation" ConceptChunk assumpDom aSP :: ConceptInstance aSP = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "setPoint" Sentence aSPDesc "Set-Point" ConceptChunk assumpDom aExtDisturb :: ConceptInstance aExtDisturb = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "externalDisturb" Sentence aExtDisturbDesc "External disturbance" ConceptChunk assumpDom aInitialValue :: ConceptInstance aInitialValue = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "initialValue" Sentence aInitialValueDesc "Initial Value" ConceptChunk assumpDom aParallelEq :: ConceptInstance aParallelEq = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "parallelEq" Sentence aParallelEqDesc "Parallel Equation" ConceptChunk assumpDom apwrPlantTxFnx :: ConceptInstance apwrPlantTxFnx = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "pwrPlantTxFnx" Sentence apwrPlantTxFnxDesc "Transfer Function" ConceptChunk assumpDom aUnfilteredDerivative :: ConceptInstance aUnfilteredDerivative = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "unfilteredDerivative" Sentence aUnfilteredDerivativeDesc "Unfiltered Derivative" ConceptChunk assumpDom aMass :: ConceptInstance aMass = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "massSpring" Sentence aMassDesc "Spring Mass" ConceptChunk assumpDom aDampingCoeff :: ConceptInstance aDampingCoeff = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "dampingCoeffSpring" Sentence aDampingCoeffDesc "Spring Damping Coefficient" ConceptChunk assumpDom aStiffnessCoeff :: ConceptInstance aStiffnessCoeff = String -> Sentence -> String -> ConceptChunk -> ConceptInstance forall c. Concept c => String -> Sentence -> String -> c -> ConceptInstance cic "stiffnessCoeffSpring" Sentence aStiffnessCoeffDesc "Spring Stiffness Coefficient" ConceptChunk assumpDom pwrPlantDesc, aDecoupledDesc, aSPDesc, aExtDisturbDesc, aManualTuningDesc, aInitialValueDesc, aParallelEqDesc, apwrPlantTxFnxDesc, aUnfilteredDerivativeDesc, aMassDesc, aDampingCoeffDesc, aStiffnessCoeffDesc :: Sentence pwrPlantDesc :: Sentence pwrPlantDesc = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk powerPlant) Sentence -> Sentence -> Sentence `S.andThe` String -> Sentence S "Sensor are coupled as a single unit"] apwrPlantTxFnxDesc :: Sentence apwrPlantTxFnxDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "The combined", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk powerPlant Sentence -> Sentence -> Sentence `S.and_` String -> Sentence S "Sensor", Sentence -> Sentence sParen (ConceptInstance -> Sentence forall r. (HasUID r, HasRefAddress r, HasShortName r) => r -> Sentence refS ConceptInstance aPwrPlant), String -> Sentence S "are characterized by a Second Order mass-spring-damper System"] aDecoupledDesc :: Sentence aDecoupledDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "The decoupled form of the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk pidC, String -> Sentence S "equation used in this", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk simulation] aSPDesc :: Sentence aSPDesc = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk setPoint), String -> Sentence S "is constant throughout", NP -> Sentence forall n. NounPhrase n => n -> Sentence phraseNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk simulation)] aExtDisturbDesc :: Sentence aExtDisturbDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "There are no external disturbances to the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk powerPlant, String -> Sentence S "during the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk simulation] aManualTuningDesc :: Sentence aManualTuningDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "This model will be used for manual tuning of the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk pidC] aInitialValueDesc :: Sentence aInitialValueDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "The initial value of the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk processVariable, String -> Sentence S "is assumed to be zero"] aParallelEqDesc :: Sentence aParallelEqDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "The Parallel form of the equation is used for the", ConceptChunk -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase ConceptChunk pidC] aUnfilteredDerivativeDesc :: Sentence aUnfilteredDerivativeDesc = [Sentence] -> Sentence foldlSent [String -> Sentence S "A pure derivative function is used for this simulation;", String -> Sentence S "there are no filters applied"] aMassDesc :: Sentence aMassDesc = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk mass), String -> Sentence S "of the spring in the mass-spring-damper system", Sentence -> Sentence sParen (ConceptInstance -> Sentence forall r. (HasUID r, HasRefAddress r, HasShortName r) => r -> Sentence refS ConceptInstance aPwrPlant), String -> Sentence S "is assumed to be 1", UnitDefn -> Sentence forall n. (HasUID n, NamedIdea n) => n -> Sentence phrase UnitDefn kilogram] aDampingCoeffDesc :: Sentence aDampingCoeffDesc = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk ccDampingCoeff), String -> Sentence S "of the spring in the mass-spring-damper system", Sentence -> Sentence sParen (ConceptInstance -> Sentence forall r. (HasUID r, HasRefAddress r, HasShortName r) => r -> Sentence refS ConceptInstance aPwrPlant), String -> Sentence S "is assumed to be 1"] aStiffnessCoeffDesc :: Sentence aStiffnessCoeffDesc = [Sentence] -> Sentence foldlSent [NP -> Sentence forall n. NounPhrase n => n -> Sentence atStartNP (ConceptChunk -> NP forall t. NamedIdea t => t -> NP the ConceptChunk ccStiffCoeff), String -> Sentence S "of the spring in the mass-spring-damper system", Sentence -> Sentence sParen (ConceptInstance -> Sentence forall r. (HasUID r, HasRefAddress r, HasShortName r) => r -> Sentence refS ConceptInstance aPwrPlant), String -> Sentence S "is assumed to be 20"]