diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Changelog for Posit Numbers +# posit-2022.0.1.0 + + * Added Random and Uniform Instances + * `Uniform` provides a uniform distribution over all possible posits, sampling the entire projective real line + * `Random` provides a uniform distribution between 0 and 1, sampling the real numbers in that range + * Example: take 10 (randomRs (1,100) (mkStdGen 2023)) :: [Posit64] + * Added `hypot2`, `hypot3`, `hypot4`, to the `AltFloating` class + # posit-2022.0.0.1 * Added `PositF` constraint synonym to simplify the usage of `(PositC es, PositC (Next es))`, as is needed for `Floating` instances diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# posit 2022.0.0.1 +# posit 2022.0.1.0 The [Posit Standard 2022](https://posithub.org/docs/posit_standard-2.pdf), and [Posit Standard 3.2](https://posithub.org/docs/posit_standard.pdf), @@ -21,6 +21,8 @@ * AltShow * Read * Storable -- Formats for binary data, for computation and data interchange + * Random + * Uniform * RealFrac * RealFloat * Floating -- Mathematical functions such as logarithm, exponential, trigonometric, and hyperbolic functions. Warning! May induce trance. @@ -54,6 +56,9 @@ gamma :: p -> p sinc :: p -> p expm1 :: p -> p + hypot2 :: p -> p -> p + hypot3 :: p -> p -> p -> p + hypot4 :: p -> p -> p -> p -> p ``` ``` diff --git a/posit.cabal b/posit.cabal --- a/posit.cabal +++ b/posit.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 name: posit -version: 2022.0.0.1 +version: 2022.0.1.0 description: The Posit Number format attempting to conform to the Posit Standard Versions 3.2 and 2022. Where Real numbers are approximated by `Maybe Rational` and sampled in a similar way to the projective real line. homepage: https://github.com/waivio/posit#readme bug-reports: https://github.com/waivio/posit/issues author: Nathan Waivio maintainer: nathan.waivio@gmail.com -copyright: 2021-2022 Nathan Waivio +copyright: 2021-2023 Nathan Waivio license: BSD3 license-file: LICENSE build-type: Simple @@ -26,8 +26,8 @@ type: git location: https://github.com/waivio/posit -flag do-no-storable - description: Build without Storable Class support +flag do-no-storable-random + description: Build without Storable or Random/Uniform Class support manual: True default: False @@ -54,11 +54,11 @@ if flag(do-liquid) ghc-options: -fplugin=LiquidHaskell -fplugin-opt=LiquidHaskell:--fast -fplugin-opt=LiquidHaskell:--no-termination -fplugin-opt=LiquidHaskell:--max-case-expand=4 -fplugin-opt=LiquidHaskell:--short-names - if flag(do-no-storable) - cpp-options: -DO_NO_STORABLE + if flag(do-no-storable-random) + cpp-options: -DO_NO_STORABLE_RANDOM if flag(do-liquid) - cpp-options: -DO_LIQUID -DO_NO_STORABLE + cpp-options: -DO_LIQUID -DO_NO_STORABLE_RANDOM -- Other library packages from which modules are imported. @@ -68,6 +68,10 @@ if !flag(do-liquid) build-depends: base >=4.7 && <5 + + if !flag(do-no-storable-random) + build-depends: + random if flag(do-liquid) build-depends: diff --git a/src/Posit.hs b/src/Posit.hs --- a/src/Posit.hs +++ b/src/Posit.hs @@ -32,7 +32,7 @@ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- Turn off noise {-# OPTIONS_GHC -Wno-type-defaults #-} -- Turn off noise {-# OPTIONS_GHC -Wno-unused-top-binds #-} -- Turn off noise - +{-# LANGUAGE AllowAmbiguousTypes #-} -- ---- -- Posit numbers implementing: @@ -123,11 +123,18 @@ -- Imports for Vectorization Class Instances import Data.Foldable (toList) -- Used for fused operations on foldable/lists +#ifndef O_NO_STORABLE_RANDOM -- Imports for Storable Instance import Foreign.Storable (Storable, sizeOf, alignment, peek, poke) -- Used for Storable Instances of Posit import Foreign.Ptr (Ptr, castPtr) -- Used for dealing with Pointers for the Posit Storable Instance +import System.Random (Random(random,randomR)) +import System.Random.Stateful (Uniform, uniform, uniformM) + +import Data.Bits (shiftL, (.&.), (.|.)) +#endif + -- would like to: -- import Posit.Internal.ElementaryFunctions -- Perhaps on the chopping block if we are moving to ElementaryFunctions @@ -532,11 +539,11 @@ #endif +#ifndef O_NO_STORABLE_RANDOM -- ===================================================================== -- === Storable Instances === -- ===================================================================== -- -#ifndef O_NO_STORABLE -- instance PositC es => Storable (Posit es) where sizeOf _ = fromIntegral $ nBytes @es @@ -547,9 +554,44 @@ poke ptr (Posit int) = do poke (castPtr ptr :: Ptr (IntN es)) int -- -#endif +-- | Random instance for the Posit Sampling of R [0,1), this is for the +-- real numbers, not on the projective real numbers, for projective +-- real numbers, use Uniform. +instance forall es. PositC es => Random (Posit es) where +-- First we take a uniform distributed random posit, then we mask out +-- the sign, 2 bits of regime, and the exponent, then we write in the +-- sign, regime and exponent of 1.0, to get a posit [1,2) then subtract +-- 1.0 to adjust the range to [0,1). This approach is credited to a +-- coorispondance between Shin Yee Chung and John L. Gustafson titled: +-- "random number generators for posit" in the Unum Computing Google Group + random g = case uniform g of + (Posit int :: Posit es, g') -> (Posit ((int .&. maskFraction @es) .|. patt) - 1.0, g') + where + (Posit patt) = 1.0 :: Posit es + randomR (lo,hi) g + | lo > hi = randomR (hi,lo) g + | otherwise = case random g of + (p,g') -> let scaled_p = (hi - lo) * p + lo + in (scaled_p, g') + + +-- | Uniform instance for the Posit Sampling of the projective real line +instance PositC es => Uniform (Posit es) where + uniformM g = do + int <- uniformM g + return $ Posit int + + +maskFraction :: forall es. PositC es => IntN es +maskFraction = + let twoRegimeBits = 2 -- regimeBitSize set to 2, the good range is [1,2) + sreSize = signBitSize @es + twoRegimeBits + exponentSize @es + in (1 `shiftL` fromIntegral (nBits @es - sreSize) - 1) + +#endif + -- ===================================================================== -- === Real Frac === -- ===================================================================== @@ -926,9 +968,12 @@ gamma :: p -> p sinc :: p -> p expm1 :: p -> p + hypot2 :: p -> p -> p + hypot3 :: p -> p -> p -> p + hypot4 :: p -> p -> p -> p -> p -- -instance PositC es => AltFloating (Posit es) where +instance PositF es => AltFloating (Posit es) where phi = 1.6180339887498948482045868343656381177203091798057628621354486227052604628189024497072072041893911374847540880753868917521266338 -- approx_phi 1.6 eps = succ 1.0 - 1.0 gamma = approx_gamma @@ -936,6 +981,18 @@ expm1 x = let b = approx_atanh $ x / 2 in (2 * b) / (1 - b) + hypot2 a b = let a' :: Posit (Next es) = convert a + b' :: Posit (Next es) = convert b + in convert (approx_sqrt $ a'^2 + b'^2) :: Posit es + hypot3 a b c = let a' :: Posit (Next es) = convert a + b' :: Posit (Next es) = convert b + c' :: Posit (Next es) = convert c + in convert (approx_sqrt $ fsum3 (a'^2) (b'^2) (c'^2)) :: Posit es + hypot4 a b c d = let a' :: Posit (Next es) = convert a + b' :: Posit (Next es) = convert b + c' :: Posit (Next es) = convert c + d' :: Posit (Next es) = convert d + in convert (approx_sqrt $ fsum4 (a'^2) (b'^2) (c'^2) (d'^2)) :: Posit es diff --git a/src/Posit/Internal/PositC.hs b/src/Posit/Internal/PositC.hs --- a/src/Posit/Internal/PositC.hs +++ b/src/Posit/Internal/PositC.hs @@ -47,10 +47,14 @@ import Prelude hiding (exponent,significand) +#ifndef O_NO_STORABLE_RANDOM -- Imports for Storable Instance of Data.DoubleWord import Foreign.Storable (Storable, sizeOf, alignment, peek, poke) -- Used for Storable Instances of Data.DoubleWord import Foreign.Ptr (Ptr, plusPtr, castPtr) -- Used for dealing with Pointers for the Data.DoubleWord Storable Instance +import System.Random.Stateful (Uniform, uniformM) +#endif + -- Machine Integers and Operations {-@ embed Int128 * as int @-} {-@ embed Int256 * as int @-} @@ -59,6 +63,7 @@ import Data.Word (Word64) import Data.Bits (Bits(..), shiftL, shift, testBit, (.&.), shiftR,FiniteBits) + -- Import Naturals and Rationals {-@ embed Natural * as int @-} import GHC.Natural (Natural) -- Import the Natural Numbers ℕ (u+2115) @@ -90,37 +95,36 @@ IntN I_3_2 = Int16 IntN II_3_2 = Int32 IntN III_3_2 = Int64 -#ifdef O_NO_STORABLE +#ifdef O_NO_STORABLE_RANDOM IntN IV_3_2 = Int128 IntN V_3_2 = Int256 #else - IntN IV_3_2 = Int128_Storable - IntN V_3_2 = Int256_Storable + IntN IV_3_2 = Int128_Storable_Random + IntN V_3_2 = Int256_Storable_Random #endif IntN Z_2022 = Int8 IntN I_2022 = Int16 IntN II_2022 = Int32 IntN III_2022 = Int64 -#ifdef O_NO_STORABLE +#ifdef O_NO_STORABLE_RANDOM IntN IV_2022 = Int128 IntN V_2022 = Int256 #else - IntN IV_2022 = Int128_Storable - IntN V_2022 = Int256_Storable + IntN IV_2022 = Int128_Storable_Random + IntN V_2022 = Int256_Storable_Random -- | New Type Wrappers to resolve Orphan Instance Issue -newtype Int128_Storable = Int128_Storable Int128 +newtype Int128_Storable_Random = Int128_Storable_Random Int128 deriving (Bits,Bounded,Enum,Real,Integral,Eq,Ord,Num,Read,Show,DoubleWord,BinaryWord,FiniteBits) via Int128 -newtype Int256_Storable = Int256_Storable Int256 +newtype Int256_Storable_Random = Int256_Storable_Random Int256 deriving (Bits,Bounded,Enum,Real,Integral,Eq,Ord,Num,Read,Show,DoubleWord,BinaryWord,FiniteBits) via Int256 -newtype Word128_Storable = Word128_Storable Word128 +newtype Word128_Storable_Random = Word128_Storable_Random Word128 deriving (Bits,Bounded,Enum,Real,Integral,Eq,Ord,Num,Read,Show,DoubleWord,BinaryWord,FiniteBits) via Word128 #endif - -- | Type Max of Kind ES type family Max (es :: ES) where @@ -165,8 +169,9 @@ ,Num a ,Read a ,Show a -#ifndef O_NO_STORABLE +#ifndef O_NO_STORABLE_RANDOM ,Storable a + ,Uniform a #endif ) @@ -459,13 +464,13 @@ xnor a b = not $ (a || b) && not (b && a) -#ifndef O_NO_STORABLE +#ifndef O_NO_STORABLE_RANDOM -- ===================================================================== -- === Storable Instances === -- ===================================================================== -- -- Storable Instance for Word128 using the DoubleWord type class and Word128_Storable newtype -instance Storable Word128_Storable where +instance Storable Word128_Storable_Random where sizeOf _ = 16 alignment _ = 16 peek ptr = do @@ -481,7 +486,7 @@ offsetWord i = (castPtr ptr :: Ptr Word64) `plusPtr` (i*8) -- Storable Instance for Int128 using the DoubleWord type class and Int128_Storable newtype -instance Storable Int128_Storable where +instance Storable Int128_Storable_Random where sizeOf _ = 16 alignment _ = 16 peek ptr = do @@ -499,22 +504,47 @@ offsetWord i = (castPtr ptr :: Ptr Word64) `plusPtr` (i*8) -- Storable Instance for Int256 using the DoubleWord type class and Int256_Storable newtype -instance Storable Int256_Storable where +instance Storable Int256_Storable_Random where sizeOf _ = 32 alignment _ = 32 peek ptr = do - (Int128_Storable hi) <- peek $ offsetInt 0 - (Word128_Storable lo) <- peek $ offsetWord 1 + (Int128_Storable_Random hi) <- peek $ offsetInt 0 + (Word128_Storable_Random lo) <- peek $ offsetWord 1 return $ fromHiAndLo hi lo where - offsetInt i = (castPtr ptr :: Ptr Int128_Storable) `plusPtr` (i*16) - offsetWord i = (castPtr ptr :: Ptr Word128_Storable) `plusPtr` (i*16) + offsetInt i = (castPtr ptr :: Ptr Int128_Storable_Random) `plusPtr` (i*16) + offsetWord i = (castPtr ptr :: Ptr Word128_Storable_Random) `plusPtr` (i*16) poke ptr int = do - poke (offsetInt 0) (Int128_Storable $ hiWord int) - poke (offsetWord 1) (Word128_Storable $ loWord int) + poke (offsetInt 0) (Int128_Storable_Random $ hiWord int) + poke (offsetWord 1) (Word128_Storable_Random $ loWord int) where - offsetInt i = (castPtr ptr :: Ptr Int128_Storable) `plusPtr` (i*16) - offsetWord i = (castPtr ptr :: Ptr Word128_Storable) `plusPtr` (i*16) + offsetInt i = (castPtr ptr :: Ptr Int128_Storable_Random) `plusPtr` (i*16) + offsetWord i = (castPtr ptr :: Ptr Word128_Storable_Random) `plusPtr` (i*16) -- + +-- ===================================================================== +-- === Random Instances === +-- ===================================================================== +-- +-- Uniform Instance for Word128 using the Double Word type class and Word128_Storable newtype +instance Uniform Word128_Storable_Random where + uniformM g = do + hi <- uniformM g + lo <- uniformM g + return $ fromHiAndLo hi lo + +-- Uniform Instance for Int128 using the Double Word type class and Int128_Storable newtype +instance Uniform Int128_Storable_Random where + uniformM g = do + hi <- uniformM g + lo <- uniformM g + return $ fromHiAndLo hi lo + +-- Uniform Instance for Int256 using the Double Word type class and Int256_Storable newtype +instance Uniform Int256_Storable_Random where + uniformM g = do + Int128_Storable_Random hi <- uniformM g + Word128_Storable_Random lo <- uniformM g + return $ fromHiAndLo hi lo #endif diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,9 @@ # This file is attempting to maintain the working Liquid Haskell versions # that coorispond to a specific GHC or Stackage version -# resolver: nightly-2023-03-30 # nightly-2023-02-20 # ghc-9.4.4 -resolver: lts-20.16 # ghc-9.2.7 # Currently the only version that seems to work with LiquidHaskell -# resolver: lts-19.33 # ghc-9.0.2 +# resolver: nightly-2023-05-20 # ghc-9.4.5 +# resolver: lts-20.21 # ghc-9.2.7 +resolver: lts-19.33 # ghc-9.0.2 # resolver: lts-18.28 # ghc-8.10.7 # resolver: lts-18.6 # ghc-8.10.4 # resolver: lts-16.31 # ghc-8.8.4 # Fails To Build! ghc: panic! (the 'impossible' happened) @@ -24,8 +24,8 @@ - smtlib-backends-process-0.3 # ghc-9.2.7 - git: https://github.com/ucsd-progsys/liquidhaskell # commit: # ghc-9.4.4 "Generically" errors out! Ambiguous occurrence ‘Generically’: It could refer to... ‘GHC.Generics.Generically’ or 'Language.Haskell.Liquid.Types.Generics.Generically' - commit: 63337d432b47c1ba1ec9925db0994fc5cdce3eaf # ghc-9.2.7 - # commit: b8780ee8d73d123adb39675ef87a2883f8aa1ecd # ghc-9.0.2 + # commit: 63337d432b47c1ba1ec9925db0994fc5cdce3eaf # ghc-9.2.7 + commit: b8780ee8d73d123adb39675ef87a2883f8aa1ecd # ghc-9.0.2 # commit: f917323a1f9db1677e592d6ffc81467d53588d70 # ghc-8.10.7 subdirs: - . @@ -35,6 +35,6 @@ - liquid-containers - liquid-ghc-prim - git: https://github.com/ucsd-progsys/liquid-fixpoint - commit: 0e1a4725793740f495c26957044c56488d6e1efc # ghc-9.2.7 - # commit: 5aed39ec3210b9093ed635693d01bf351e25392f # ghc-9.0.2 + # commit: 0e1a4725793740f495c26957044c56488d6e1efc # ghc-9.2.7 + commit: 5aed39ec3210b9093ed635693d01bf351e25392f # ghc-9.0.2 # commit: 544f8b0ba6d03b060701961250cce012412039c4 # ghc-8.10.7 diff --git a/test/TestPosit.hs b/test/TestPosit.hs --- a/test/TestPosit.hs +++ b/test/TestPosit.hs @@ -62,7 +62,6 @@ print $ "exp(1)**(pi*sqrt 163) :: P16 " ++ show (exp(1 :: P16) ** (pi * sqrt 163)) -- print $ "exp(1)**(pi*sqrt 163) :: Posit8 " ++ show (exp(1 :: Posit8) ** (pi * sqrt 163)) -- print $ "exp(1)**(pi*sqrt 163) :: P8 " ++ show (exp(1 :: P8) ** (pi * sqrt 163)) -- - print $ "Inverse Posit Density Function: :: Posit256 , hmmm well If I could have a function to convert from different distribution funcitons" -- | 'EPS' print $ "Machine epsilon Posit8 ~1.0: " ++ show (eps :: Posit8) -- succ (Posit int) = Posit (succ int) print $ "Machine epsilon Posit16 ~1.0: " ++ show (eps :: Posit16) --