Added dynamic prefix selection. Fixes bjornbm#163.

src/Numeric/Units/Dimensional/SIUnits.hs

@@ -57,19 +57,22 @@ module Numeric.Units.Dimensional.SIUnits
   -- $submultiples
   deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto,
   -- $reified-prefixes
-  Prefix, applyPrefix, siPrefixes
+  Prefix, applyPrefix, applyOptionalPrefix, siPrefixes, appropriatePrefix, withAppropriatePrefix, appropriatePrefix', withAppropriatePrefix'
 )
 where
 
+import Control.Monad (join)
 import Data.Ratio
+import Data.List (sortBy, find)
+import Data.Ord (comparing, Down(..))
 import Numeric.Units.Dimensional
 import Numeric.Units.Dimensional.Quantities
-import Numeric.Units.Dimensional.UnitNames (Prefix, siPrefixes)
+import Numeric.Units.Dimensional.UnitNames (Prefix, siPrefixes, scaleExponent)
 import qualified Numeric.Units.Dimensional.UnitNames as N
 import Numeric.Units.Dimensional.UnitNames.Internal (ucum, ucumMetric)
 import qualified Numeric.Units.Dimensional.UnitNames.Internal as I
 import Numeric.NumType.DK.Integers ( pos3 )
-import Prelude ( Eq(..), ($), Num, Fractional, Floating, otherwise, error)
+import Prelude ( Eq(..), ($), (.), Num, Fractional, Floating, RealFrac(..), Maybe(..), otherwise, error, Ord(..), fst, snd, Int, Bool, fmap, mod, (&&))
 import qualified Prelude
 
 {- $multiples
@@ -109,12 +112,18 @@ yotta = applyMultiple I.yotta
 Then the submultiples.
 -}
 
+-- | Applies a 'Prefix' to a 'Metric' 'Unit', creating a 'NonMetric' unit.
 applyPrefix :: (Fractional a) => Prefix -> Unit 'Metric d a -> Unit 'NonMetric d a
 applyPrefix p u = mkUnitQ n' x u
   where
     n' = N.applyPrefix p (name u)
     x = N.scaleFactor p
 
+-- | Applies an optional 'Prefix' to a 'Metric' 'Unit', creating a 'NonMetric' unit.
+applyOptionalPrefix :: (Fractional a) => Maybe Prefix -> Unit 'Metric d a -> Unit 'NonMetric d a
+applyOptionalPrefix Nothing = weaken
+applyOptionalPrefix (Just p) = applyPrefix p
+
 deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto
   :: Fractional a => Unit 'Metric d a -> Unit 'NonMetric d a
 deci  = applyPrefix I.deci
@@ -135,6 +144,54 @@ list of all prefixes defined by the SI.
 
 -}
 
+-- | Selects the appropriate 'Prefix' to use with a 'Metric' unit when using it to display
+-- a particular 'Quantity', or 'Nothing' if the supplied unit should be used without a prefix.
+--
+-- The appropriate prefix is defined to be the largest prefix such that the resulting value
+-- of the quantity, expressed in the prefixed unit, is greater than or equal to one.
+appropriatePrefix :: (Floating a, RealFrac a) => Unit 'Metric d a -> Quantity d a -> Maybe Prefix
+appropriatePrefix u q = selectPrefix (<= e)
+  where
+    val = q /~ u
+    e = Prelude.floor $ Prelude.logBase 10 val :: Prelude.Int
+
+-- | Selects the appropriate 'Prefix' to use with a 'Metric' unit when using it to display
+-- a particular 'Quantity', or 'Nothing' if the supplied unit should be used without a prefix.
+--
+-- The appropriate prefix is defined to be the largest prefix such that the resulting value
+-- of the quantity, expressed in the prefixed unit, is greater than or equal to one. Only those prefixes
+-- whose 'scaleExponent' is a multiple of @3@ are considered.
+appropriatePrefix' :: (Floating a, RealFrac a) => Unit 'Metric d a -> Quantity d a -> Maybe Prefix
+appropriatePrefix' u q = selectPrefix (\x -> x `mod` 3 == 0 && x <= e)
+  where
+    val = q /~ u
+    e = Prelude.floor $ Prelude.logBase 10 val :: Prelude.Int
+
+-- Selects the first prefix in the list of prefix candidates whose scale exponent matches the supplied predicate.
+selectPrefix :: (Int -> Bool) -> Maybe Prefix
+selectPrefix p = join $ fmap snd $ find (p . fst) prefixCandidates
+
+-- This is a list of candidate prefixes and the least scale exponent at which each applies.
+prefixCandidates :: [(Int, Maybe Prefix)]
+prefixCandidates = sortBy (comparing $ Down . fst) $ (0, Nothing) : fmap (\x -> (scaleExponent x, Just x)) siPrefixes
+
+-- | Constructs a version of a 'Metric' unit, by possibly applying a 'Prefix' to it, appropriate
+-- for display of a particular 'Quantity'.
+--
+-- The appropriate prefix is defined to be the largest prefix such that the resulting value
+-- of the quantity, expressed in the prefixed unit, is greater than or equal to one.
+withAppropriatePrefix :: (Floating a, RealFrac a) => Unit 'Metric d a -> Quantity d a -> Unit 'NonMetric d a
+withAppropriatePrefix u q = applyOptionalPrefix (appropriatePrefix u q) u
+
+-- | Constructs a version of a 'Metric' unit, by possibly applying a 'Prefix' to it, appropriate
+-- for display of a particular 'Quantity'.
+--
+-- The appropriate prefix is defined to be the largest prefix such that the resulting value
+-- of the quantity, expressed in the prefixed unit, is greater than or equal to one. Only those prefixes
+-- whose 'scaleExponent' is a multiple of @3@ are considered.
+withAppropriatePrefix' :: (Floating a, RealFrac a) => Unit 'Metric d a -> Quantity d a -> Unit 'NonMetric d a
+withAppropriatePrefix' u q = applyOptionalPrefix (appropriatePrefix' u q) u
+
 {- $base-units
 These are the base units from section 4.1. To avoid a
 myriad of one-letter functions that would doubtlessly cause clashes

src/Numeric/Units/Dimensional/UnitNames.hs

@@ -23,7 +23,7 @@ module Numeric.Units.Dimensional.UnitNames
   -- * Standard Names
   baseUnitName, siPrefixes, nOne,
   -- * Inspecting Prefixes
-  prefixName, scaleFactor,
+  prefixName, scaleExponent, scaleFactor,
   -- * Convenience Type Synonyms for Unit Name Transformations
   UnitNameTransformer, UnitNameTransformer2,
   -- * Forgetting Unwanted Phantom Types
@@ -35,3 +35,6 @@ where
 import Numeric.Units.Dimensional.UnitNames.Internal
 import Numeric.Units.Dimensional.Variants
 import Prelude hiding ((*), (/), (^), product)
+
+scaleFactor :: Prefix -> Rational
+scaleFactor p = 10 ^^ (scaleExponent p)

src/Numeric/Units/Dimensional/UnitNames/Internal.hs

@@ -141,12 +141,12 @@ data Prefix = Prefix
                 -- | The name of a metric prefix.
                 prefixName :: PrefixName,
                 -- | The scale factor denoted by a metric prefix.
-                scaleFactor :: Rational
+                scaleExponent :: Int
               }
   deriving (Eq, Data, Typeable, Generic)
 
 instance Ord Prefix where
-  compare = comparing scaleFactor
+  compare = comparing scaleExponent
 
 instance NFData Prefix where -- instance is derived from Generic instance
 
@@ -190,27 +190,27 @@ baseUnitNames :: [UnitName 'NonMetric]
 baseUnitNames = [weaken nMeter, nKilogram, weaken nSecond, weaken nAmpere, weaken nKelvin, weaken nMole, weaken nCandela]
 
 deka, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta :: Prefix
-deka  = prefix "da" "da" "deka" 1e1
-hecto = prefix "h" "h" "hecto"  1e2
-kilo  = prefix "k" "k" "kilo"   1e3
-mega  = prefix "M" "M" "mega"   1e6
-giga  = prefix "G" "G" "giga"   1e9
-tera  = prefix "T" "T" "tera"   1e12
-peta  = prefix "P" "P" "peta"   1e15
-exa   = prefix "E" "E" "exa"    1e18
-zetta = prefix "Z" "Z" "zetta"  1e21
-yotta = prefix "Y" "Y" "yotta"  1e24
+deka  = prefix "da" "da" "deka" 1
+hecto = prefix "h" "h" "hecto"  2
+kilo  = prefix "k" "k" "kilo"   3
+mega  = prefix "M" "M" "mega"   6
+giga  = prefix "G" "G" "giga"   9
+tera  = prefix "T" "T" "tera"   12
+peta  = prefix "P" "P" "peta"   15
+exa   = prefix "E" "E" "exa"    18
+zetta = prefix "Z" "Z" "zetta"  21
+yotta = prefix "Y" "Y" "yotta"  24
 deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto :: Prefix
-deci  = prefix "d" "d" "deci"   1e-1
-centi = prefix "c" "c" "centi"  1e-2
-milli = prefix "m" "m" "milli"  1e-3
-micro = prefix "u" "μ" "micro"  1e-6
-nano  = prefix "n" "n" "nano"   1e-9
-pico  = prefix "p" "p" "pico"   1e-12
-femto = prefix "f" "f" "femto"  1e-15
-atto  = prefix "a" "a" "atto"   1e-18
-zepto = prefix "z" "z" "zepto"  1e-21
-yocto = prefix "y" "y" "yocto"  1e-24
+deci  = prefix "d" "d" "deci"   $ -1
+centi = prefix "c" "c" "centi"  $ -2
+milli = prefix "m" "m" "milli"  $ -3
+micro = prefix "u" "μ" "micro"  $ -6
+nano  = prefix "n" "n" "nano"   $ -9
+pico  = prefix "p" "p" "pico"   $ -12
+femto = prefix "f" "f" "femto"  $ -15
+atto  = prefix "a" "a" "atto"   $ -18
+zepto = prefix "z" "z" "zepto"  $ -21
+yocto = prefix "y" "y" "yocto"  $ -24
 
 -- | A list of all 'Prefix'es defined by the SI.
 siPrefixes :: [Prefix]
@@ -319,7 +319,7 @@ instance HasInterchangeName (UnitName m) where
                                  in InterchangeName { name = n', authority = authority . interchangeName $ n, I.isAtomic = False }
   interchangeName (Weaken n) = interchangeName n
 
-prefix :: String -> String -> String -> Rational -> Prefix
+prefix :: String -> String -> String -> Int -> Prefix
 prefix i a f q = Prefix n q
   where
     n = NameAtom (InterchangeName i UCUM True) a f