Adding Precision Capabilities

code/drasil-data/Data/Drasil/SentenceStructures.hs

@@ -18,13 +18,14 @@ module Data.Drasil.SentenceStructures
  ) where
 
 import Language.Drasil
-import Data.Drasil.Utils (foldle, foldle1, addPercent)
+import Data.Drasil.Utils (addPercent, foldle, foldle1)
 import Data.Drasil.Concepts.Documentation hiding (constraint)
 import Data.Drasil.Concepts.Math (equation)
 
 import Control.Lens ((^.))
+import Data.Decimal (DecimalRaw, realFracToDecimal)
+import Data.List (intersperse, transpose)
 import Data.Monoid (mconcat)
-import Data.List (intersperse,transpose)
 
 {--** Sentence Folding **--}
 -- | partial function application of foldle for sentences specifically
@@ -218,11 +219,12 @@ mkTableFromColumns l =
 none :: Sentence
 none = S "--"
 
-found :: Double -> Sentence
-found x = (addPercent . realToFrac) (x*100)
-
-typUncr :: (UncertainQuantity c) => c -> Sentence
-typUncr x = maybe none found (x ^. uncert)
+found :: Double -> Maybe Int -> Sentence
+found x Nothing = addPercent $ x * 100
+found x (Just p) = addPercent $ (realFracToDecimal (fromIntegral p) (x * 100) :: DecimalRaw Integer)
+
+typUncr :: (HasUncertainty c) => c -> Sentence
+typUncr x = found (uncVal x) (uncPrec x)
 
 constraintToExpr :: (Quantity c) => c -> Constraint -> Expr
 constraintToExpr c (Range _ ri) = real_interval c ri

code/drasil-data/Data/Drasil/Utils.hs

@@ -7,7 +7,7 @@ module Data.Drasil.Utils ( foldle, foldle1, mkEnumAbbrevList, zipFTable', zipSen
 import Language.Drasil
 
 import Control.Lens ((^.))
-import Data.List (transpose, elem)
+import Data.List (elem, transpose)
 
 import Data.Drasil.Concepts.Documentation (fterms, input_, output_, symbol_, useCaseTable)
 import Data.Drasil.Concepts.Math (unit_)
@@ -59,7 +59,7 @@ getRVal c = uns (c ^. reasVal)
  uns Nothing = error $ "getRVal found no Expr for " ++ (c ^. uid)
 
 -- | outputs sentence with % attached to it
-addPercent :: Float -> Sentence
+addPercent :: (Show a) => a -> Sentence -- commented out to suppress type default warning
 addPercent num = (S (show num) :+: Percent)
 
 -- | appends a sentence to the front of a list of list of sentences

code/drasil-data/drasil-data.cabal

@@ -45,6 +45,7 @@ library
  MissingH >= 1.4.0.1,
  parsec >= 3.1.9,
  data-fix (>= 0.0.4 && <= 1.0),
+ Decimal >= 0.5.1,
  drasil-lang >= 0.1.56
  default-language: Haskell2010
  ghc-options: -Wall -Wredundant-constraints

code/drasil-docLang/Drasil/Sections/SpecificSystemDescription.hs

@@ -203,7 +203,7 @@ mkDataConstraintTable col ref lab = llcc (makeTabRef ref) $ uncurry Table
  (mkTableFromColumns col) lab True
 
 -- Creates the input Data Constraints Table
-inDataConstTbl :: (UncertainQuantity c, Constrained c, HasReasVal c, MayHaveUnit c) => 
+inDataConstTbl :: (HasUncertainty c, Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) => 
  [c] -> LabelledContent
 inDataConstTbl qlst = mkDataConstraintTable [(S "Var", map ch $ sortBySymbol qlst),
  (titleize' physicalConstraint, map fmtPhys $ sortBySymbol qlst),

code/drasil-example/Drasil/GamePhysics/Unitals.hs

@@ -269,12 +269,12 @@ lengthCons, massCons, mmntOfInCons, gravAccelCons, posCons, orientCons,
  angVeloCons, forceCons, torqueCons, veloCons, restCoefCons :: ConstrConcept
 
 cpInputConstraints :: [UncertQ]
-cpInputConstraints = map (\x -> uq x (0.1 :: Double))
+cpInputConstraints = map (`uq` defaultUncrt)
  [lengthCons, massCons, mmntOfInCons, gravAccelCons, posCons, orientCons,
  veloCons, angVeloCons, forceCons, torqueCons, restCoefCons]
 
 cpOutputConstraints :: [UncertQ]
-cpOutputConstraints = map (\x -> uq x (0.1 :: Double)) 
+cpOutputConstraints = map (`uq` defaultUncrt) 
  [posCons, veloCons, orientCons, angVeloCons]
 
 nonNegativeConstraint :: Constraint -- should be pulled out and put somewhere for generic constraints

code/drasil-example/Drasil/GlassBR/Unitals.hs

@@ -42,9 +42,6 @@ glass_type, nomThick :: ConstrainedChunk
 
 {--}
 
-defaultUncrt :: Double
-defaultUncrt = 0.1
-
 gbInputs :: [QuantityDict]
 gbInputs = (map qw gbInputsWUnitsUncrtn) ++ (map qw gbInputsWUncrtn) ++ 
  (map qw gbInputsNoUncrtn) ++ (map qw sdVector)
@@ -83,8 +80,7 @@ aspect_ratio = uvc "aspect_ratio" (aR ^. term)
 
 pbTol = uvc "pbTol" (nounPhraseSP "tolerable probability of breakage") 
  (sub cP (Atomic "btol")) Real
- [ physc $ Bounded (Exc, 0) (Exc, 1)] (dbl 0.008) (0.001)
-
+ [ physc $ Bounded (Exc, 0) (Exc, 1)] (dbl 0.008) (uncty 0.001 Nothing)
 
 charWeight = uqcND "charWeight" (nounPhraseSP "charge weight") 
  lW kilogram Real

code/drasil-example/Drasil/NoPCM/Unitals.hs

@@ -9,4 +9,4 @@ temp_init :: UncertQ
 temp_init = uqc "temp_init" (nounPhraseSP "initial temperature")
  "The temperature at the beginning of the simulation"
  (sub (eqSymb temp)(Atomic "init")) centigrade Real
- [physc $ Bounded (Exc,0) (Exc,100)] (dbl 40) 0.1
+ [physc $ Bounded (Exc,0) (Exc,100)] (dbl 40) defaultUncrt

code/drasil-example/Drasil/SSP/Unitals.hs

@@ -61,9 +61,6 @@ monotonicIn = [physc $ \_ -> -- FIXME: Hack with "index" !
  (idx xi (sy index) $< idx xi (sy index + 1) $=> idx yi (sy index) $< idx yi (sy index + 1))]
 -}
 
-defultUncrt :: Double
-defultUncrt = 0.1
-
 slopeDist, slopeHght, waterDist, waterHght, xMaxExtSlip, xMaxEtrSlip, 
  xMinExtSlip, xMinEtrSlip, yMaxSlip, yMinSlip, effCohesion, fricAngle, 
  dryWeight, satWeight, waterWeight :: UncertQ
@@ -78,75 +75,75 @@ fs, coords :: ConstrConcept
 
 slopeDist = uqc "x_slope,i" (cn $ "x-coordinates of the slope")
  ("x-coordinates of points on the soil slope")
- (sub (vec lX) (Atomic "slope")) metre Real [] (dbl 0) defultUncrt
+ (sub (vec lX) (Atomic "slope")) metre Real [] (dbl 0) defaultUncrt
 
 slopeHght = uqc "y_slope,i" (cn $ "y-coordinates of the slope")
  ("y-coordinates of points on the soil slope")
- (sub (vec lY) (Atomic "slope")) metre Real [] (dbl 0) defultUncrt
+ (sub (vec lY) (Atomic "slope")) metre Real [] (dbl 0) defaultUncrt
 
 waterDist = uqc "x_wt,i" (cn $ "x-coordinates of the water table")
  ("x-positions of the water table")
- (sub (vec lX) (Atomic "wt")) metre Real [] (dbl 0) defultUncrt
+ (sub (vec lX) (Atomic "wt")) metre Real [] (dbl 0) defaultUncrt
 
 waterHght = uqc "y_wt,i" (cn $ "y-coordinates of the water table")
  ("heights of the water table")
- (sub (vec lY) (Atomic "wt")) metre Real [] (dbl 0) defultUncrt
+ (sub (vec lY) (Atomic "wt")) metre Real [] (dbl 0) defaultUncrt
 
 xMaxExtSlip = uqc "x_slip^maxExt" (cn $ "maximum exit x-coordinate")
  "maximum potential x-coordinate for the exit point of a slip surface"
  (sup (sub lX (Atomic "slip")) (Atomic "maxExt")) metre Real [] (dbl 100) 
- defultUncrt
+ defaultUncrt
 
 xMaxEtrSlip = uqc "x_slip^maxEtr" (cn $ "maximum entry x-coordinate")
  "maximum potential x-coordinate for the entry point of a slip surface"
  (sup (sub lX (Atomic "slip")) (Atomic "maxEtr")) metre Real [] (dbl 20)
- defultUncrt
+ defaultUncrt
 
 xMinExtSlip = uqc "x_slip^minExt" (cn $ "minimum exit x-coordinate")
  "minimum potential x-coordinate for the exit point of a slip surface"
  (sup (sub lX (Atomic "slip")) (Atomic "minExt")) metre Real [] (dbl 50) 
- defultUncrt
+ defaultUncrt
 
 xMinEtrSlip = uqc "x_slip^minEtr" (cn $ "minimum exit x-coordinate")
  "minimum potential x-coordinate for the entry point of a slip surface"
  (sup (sub lX (Atomic "slip")) (Atomic "minEtr")) metre Real [] (dbl 0) 
- defultUncrt
+ defaultUncrt
 
 yMaxSlip = uqc "y_slip^max" (cn $ "maximum y-coordinate") 
  "maximum potential y-coordinate of a point on a slip surface"
  (sup (sub lY (Atomic "slip")) (Atomic "max")) metre Real [] (dbl 30) 
- defultUncrt
+ defaultUncrt
 
 yMinSlip = uqc "y_slip^min" (cn $ "minimum y-coordinate") 
  "minimum potential y-coordinate of a point on a slip surface"
  (sup (sub lY (Atomic "slip")) (Atomic "min")) metre Real [] (dbl 0) 
- defultUncrt
+ defaultUncrt
 
 effCohesion = uqc "c'" (cn $ "effective cohesion")
  "internal pressure that sticks particles of soil together"
- (prime $ Atomic "c") pascal Real [gtZeroConstr] (dbl 10000) defultUncrt
+ (prime $ Atomic "c") pascal Real [gtZeroConstr] (dbl 10000) defaultUncrt
 
 fricAngle = uqc "varphi'" (cn $ "effective angle of friction")
  ("The angle of inclination with respect to the horizontal axis of " ++
  "the Mohr-Coulomb shear resistance line") --http://www.geotechdata.info
  (prime $ vPhi) degree Real [physc $ Bounded (Exc,0) (Exc,90)]
- (dbl 25) defultUncrt
+ (dbl 25) defaultUncrt
 
 dryWeight = uqc "gamma" (cn $ "soil dry unit weight")
  "The weight of a dry soil/ground layer divided by the volume of the layer."
  lGamma specificWeight Real [gtZeroConstr]
- (dbl 20000) defultUncrt
+ (dbl 20000) defaultUncrt
 
 satWeight = uqc "gamma_sat" (cn $ "soil saturated unit weight")
  ("The weight of saturated soil/ground " ++
  "layer divided by the volume of the layer.")
  (sub lGamma (Atomic "Sat")) specificWeight Real [gtZeroConstr]
- (dbl 20000) defultUncrt
+ (dbl 20000) defaultUncrt
 
 waterWeight = uqc "gamma_w" (cn $ "unit weight of water")
  "The weight of one cubic meter of water."
  (sub lGamma lW) specificWeight Real [gtZeroConstr]
- (dbl 9800) defultUncrt
+ (dbl 9800) defaultUncrt
 
 constF = dqd' (dcc "const_f" (nounPhraseSP $ "decision on f") 
  ("boolean decision on which form of f the user desires: constant if true," ++

code/drasil-example/Drasil/SWHS/Unitals.hs

@@ -244,21 +244,21 @@ tank_length = uqc "tank_length" (nounPhraseSP "length of tank")
  "The length of the tank" cL metre Rational
  [gtZeroConstr,
  sfwrc $ Bounded (Inc, sy tank_length_min) (Inc, sy tank_length_max)] (dbl 1.5)
- 0.1
+ defaultUncrt
 
 -- Constraint 2
 diam = uqc "diam" (nounPhraseSP "diameter of tank")
  "The diameter of the tank" cD metre Rational
  [gtZeroConstr]
- (dbl 0.412) 0.1
+ (dbl 0.412) defaultUncrt
 
 -- Constraint 3
 pcm_vol = uqc "pcm_vol" (nounPhraseSP "volume of PCM")
  "The amount of space occupied by a given quantity of phase change material"
  (sub (eqSymb vol) cP) m_3 Rational
  [physc $ Bounded (Exc,0) (Exc, sy tank_vol),
  sfwrc $ UpFrom (Inc, (sy frac_min)*(sy tank_vol))] 
- (dbl 0.05) 0.1
+ (dbl 0.05) defaultUncrt
  -- needs to add (D,L)*minfract to end of last constraint
 
 -- Constraint 4
@@ -272,21 +272,21 @@ pcm_SA = uqc "pcm_SA"
  (sub cA cP) m_2 Rational
  [gtZeroConstr,
  sfwrc $ Bounded (Inc, sy pcm_vol) (Inc, (2 / sy thickness) * sy tank_vol)]
- (dbl 1.2) 0.1
+ (dbl 1.2) defaultUncrt
 
 -- Constraint 5
 pcm_density = uqc "pcm_density" (nounPhraseSP "density of PCM")
  "Mass per unit volume of the phase change material"
  (sub (eqSymb density) cP) densityU Rational
- [ physc $ Bounded (Exc, sy pcm_density_min) (Exc, sy pcm_density_max)] (dbl 1007) 0.1
+ [ physc $ Bounded (Exc, sy pcm_density_min) (Exc, sy pcm_density_max)] (dbl 1007) defaultUncrt
 
 -- Constraint 6
 temp_melt_P = uqc "temp_melt_P"
  (nounPhraseSP "melting point temperature for PCM")
  ("Temperature at which the phase change " ++
  "material transitions from a solid to a liquid")
  (sup (sub (eqSymb temp) (Atomic "melt")) cP) centigrade Rational
- [physc $ Bounded (Exc,0) (Exc, sy temp_C)] (dbl 44.2) 0.1
+ [physc $ Bounded (Exc,0) (Exc, sy temp_C)] (dbl 44.2) defaultUncrt
 
 -- Constraint 7
 htCap_S_P = uqc "htCap_S_P"
@@ -296,7 +296,7 @@ htCap_S_P = uqc "htCap_S_P"
  (sup (sub (eqSymb heatCapSpec) cP) cS) UT.heatCapSpec Rational
  [gtZeroConstr,
  sfwrc $ Bounded (Exc, sy htCap_S_P_min) (Exc, sy htCap_S_P_max)]
- (dbl 1760) 0.1
+ (dbl 1760) defaultUncrt
 
 -- Constraint 8
 htCap_L_P = uqc "htCap_L_P"
@@ -306,15 +306,15 @@ htCap_L_P = uqc "htCap_L_P"
  (sup (sub (eqSymb heatCapSpec) cP) cL) UT.heatCapSpec Rational
  [gtZeroConstr,
  sfwrc $ Bounded (Exc, sy htCap_L_P_min) (Exc, sy htCap_L_P_max )]
- (dbl 2270) 0.1
+ (dbl 2270) defaultUncrt
 
 --Constraint 9
 htFusion = uqc "htFusion" (nounPhraseSP "specific latent heat of fusion")
  ("amount of thermal energy required to " ++
  "completely melt a unit mass of a substance")
  (sub cH lF) specificE Rational
  [gtZeroConstr,
- sfwrc $ Bounded (Exc, sy htFusion_min) (Exc, sy htFusion_max)] (dbl 211600) 0.1
+ sfwrc $ Bounded (Exc, sy htFusion_min) (Exc, sy htFusion_max)] (dbl 211600) defaultUncrt
 
 -- Constraint 10
 -- The "S "heating coil" " should be replaced by "phrase coil",
@@ -324,28 +324,28 @@ coil_SA = uqc "coil_SA"
  (nounPhrase'' (phrase surArea) (phrase surArea) CapFirst CapWords))
  "Area covered by the outermost layer of the coil" (sub cA cC) m_2 Rational
  [gtZeroConstr,
- sfwrc $ UpTo (Inc, sy coil_SA_max)] (dbl 0.12) 0.1
+ sfwrc $ UpTo (Inc, sy coil_SA_max)] (dbl 0.12) defaultUncrt
 
 -- Constraint 11
 temp_C = uqc "temp_C" (nounPhraseSP "temperature of the heating coil")
  "The average kinetic energy of the particles within the coil"
  (sub (eqSymb temp) cC) centigrade Rational
- [physc $ Bounded (Exc,0) (Exc,100)] (dbl 50) 0.1
+ [physc $ Bounded (Exc,0) (Exc,100)] (dbl 50) defaultUncrt
 
 -- Constraint 12
 w_density = uqc "w_density" (density `of_` water)
  "Mass per unit volume of water"
  (sub (eqSymb density) cW) densityU Rational
  [gtZeroConstr,
- sfwrc $ Bounded (Exc, sy w_density_min) (Inc, sy w_density_max)] (dbl 1000) 0.1
+ sfwrc $ Bounded (Exc, sy w_density_min) (Inc, sy w_density_max)] (dbl 1000) defaultUncrt
 
 -- Constraint 13
 htCap_W = uqc "htCap_W" (heatCapSpec `of_` water)
  ("The amount of energy required to raise the " ++
  "temperature of a given unit mass of water by a given amount")
  (sub (eqSymb heatCapSpec) cW) UT.heatCapSpec Rational
  [gtZeroConstr,
- sfwrc $ Bounded (Exc, sy htCap_W_min) (Exc, sy htCap_W_max)] (dbl 4186) 0.1 
+ sfwrc $ Bounded (Exc, sy htCap_W_min) (Exc, sy htCap_W_max)] (dbl 4186) defaultUncrt
 
 -- Constraint 14
 coil_HTC = uqc "coil_HTC" (nounPhraseSP
@@ -355,7 +355,7 @@ coil_HTC = uqc "coil_HTC" (nounPhraseSP
  (sub (eqSymb htTransCoeff) cC)
  UT.heatTransferCoef Rational
  [gtZeroConstr,
- sfwrc $ Bounded (Inc, sy coil_HTC_min) (Inc, sy coil_HTC_max)] (dbl 1000) 0.1
+ sfwrc $ Bounded (Inc, sy coil_HTC_min) (Inc, sy coil_HTC_max)] (dbl 1000) defaultUncrt
 
 -- Constraint 15
 pcm_HTC = uqc "pcm_HTC"
@@ -364,21 +364,21 @@ pcm_HTC = uqc "pcm_HTC"
  "the thermal flux from the phase change material to the surrounding water")
  (sub lH cP) UT.heatTransferCoef Rational
  [gtZeroConstr,
- sfwrc $ Bounded (Inc, sy pcm_HTC_min) (Inc, sy pcm_HTC_max)] (dbl 1000) 0.1
+ sfwrc $ Bounded (Inc, sy pcm_HTC_min) (Inc, sy pcm_HTC_max)] (dbl 1000) defaultUncrt
 
 -- Constraint 16
 temp_init = uqc "temp_init" (nounPhraseSP "initial temperature")
  "The temperature at the beginning of the simulation"
  (sub (eqSymb temp)(Atomic "init")) centigrade Rational
- [physc $ Bounded (Exc,0) (Exc, sy meltPt)] (dbl 40) 0.1
+ [physc $ Bounded (Exc,0) (Exc, sy meltPt)] (dbl 40) defaultUncrt
 
 -- Constraint 17
 time_final = uqc "time_final" (nounPhraseSP "final time")
  ("The amount of time elapsed from the beginning of the " ++
  "simulation to its conclusion") (sub (eqSymb time) 
  (Atomic "final")) second Rational
  [gtZeroConstr,
- sfwrc $ UpTo $ (Exc, sy time_final_max)] (dbl 50000) 0.1
+ sfwrc $ UpTo $ (Exc, sy time_final_max)] (dbl 50000) defaultUncrt
 
 
 -- Output Constraints
@@ -422,18 +422,18 @@ abs_tol, rel_tol, cons_tol :: UncertainChunk
 abs_tol = uvc "abs_tol" (nounPhraseSP "absolute tolerance") 
  (sub cA (Atomic "tol")) Real
  [ physc $ Bounded (Exc,0) (Exc,1)] 
- (dbl (10.0**(-10))) 0.01
+ (dbl (10.0**(-10))) (uncty 0.01 Nothing)
 
 rel_tol = uvc "pbTol" (nounPhraseSP "relative tolerance") 
  (sub cR (Atomic "tol")) Real
  [ physc $ Bounded (Exc,0) (Exc,1)] 
- (dbl (10.0**(-10))) 0.01
+ (dbl (10.0**(-10))) (uncty 0.01 Nothing)
 
 cons_tol = uvc "pbTol"
  (nounPhraseSP "relative tolerance for conservation of energy") 
  (sub cC (Atomic "tol")) Real
  [ physc $ Bounded (Exc,0) (Exc,1)] 
- (dbl (10.0**(-3))) 0.01
+ (dbl (10.0**(-3))) (uncty 0.01 Nothing)
 
 -------------------------
 -- Max / Min Variables --