diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.4.2: [2019.06.06] +---------- +* Add `Euclidean` typeclass. +* Add `Mod2`, the integers modulo 2, along with its Semiring/Ring/Star + instances. 0.4.1: [2019.05.04] ------------------- * Remove unlawful and useless `Ring` instance for `GHC.Natural.Natural`. diff --git a/Data/Euclidean.hs b/Data/Euclidean.hs new file mode 100644 --- /dev/null +++ b/Data/Euclidean.hs @@ -0,0 +1,265 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} + +module Data.Euclidean + ( Euclidean(..) + , GcdDomain(..) + , WrappedIntegral(..) + , WrappedFractional(..) + ) where + +import Prelude hiding (quotRem, quot, rem, divMod, div, mod, gcd, lcm, (*)) +import qualified Prelude as P +import Data.Maybe +import Data.Ratio +import Data.Semiring +import GHC.Exts +import GHC.Integer.GMP.Internals +import Numeric.Natural + +-- | 'GcdDomain' represents a +-- . +-- This is a domain, where GCD can be defined, +-- but which does not necessarily allow a well-behaved +-- division with remainder (as in 'Euclidean' domains). +-- +-- For example, there is no way to define 'rem' over +-- polynomials with integer coefficients such that +-- remainder is always "smaller" than divisor. However, +-- 'gcd' is still definable, just not by means of +-- Euclidean algorithm. +-- +-- All methods of 'GcdDomain' have default implementations +-- in terms of 'Euclidean'. So most of the time +-- it is enough to write: +-- +-- > instance GcdDomain Foo +-- > instance Euclidean Foo where +-- > quotRem = ... +-- > degree = ... +class Semiring a => GcdDomain a where + + -- | Division without remainder. + -- + -- prop> \x y -> (x * y) `divide` y == Just x + -- prop> \x y -> maybe True (\z -> x == z * y) (x `divide` y) + divide :: a -> a -> Maybe a + + default divide :: (Eq a, Euclidean a) => a -> a -> Maybe a + divide x y = let (q, r) = quotRem x y in + if isZero r then Just q else Nothing + + -- | Greatest common divisor. Must satisfy + -- + -- prop> \x y -> isJust (x `divide` gcd x y) && isJust (y `divide` gcd x y) + -- prop> \x y z -> isJust (gcd (x * z) (y * z) `divide` z) + gcd :: a -> a -> a + + default gcd :: (Eq a, Euclidean a) => a -> a -> a + gcd a b + | isZero b = a + | otherwise = gcd b (a `rem` b) + + -- | Lowest common multiple. Must satisfy + -- + -- prop> \x y -> isJust (lcm x y `divide` x) && isJust (lcm x y `divide` y) + -- prop> \x y z -> isNothing (z `divide` x) || isNothing (z `divide` y) || isJust (z `divide` lcm x y) + lcm :: a -> a -> a + + default lcm :: Eq a => a -> a -> a + lcm a b + | isZero a || isZero b = zero + | otherwise = case a `divide` gcd a b of + Nothing -> error "lcm: violated gcd invariant" + Just c -> c * b + + -- | Test whether two arguments are + -- . + -- Must match its default definition: + -- + -- prop> \x y -> coprime x y == isJust (1 `divide` gcd x y) + coprime :: a -> a -> Bool + + default coprime :: Eq a => a -> a -> Bool + coprime x y = isJust (one `divide` gcd x y) + +infixl 7 `divide` + +-- | Informally speaking, 'Euclidean' is a superclass of 'Integral', +-- lacking 'toInteger', which allows to define division with remainder +-- for a wider range of types, e. g., complex integers +-- and polynomials with rational coefficients. +-- +-- 'Euclidean' represents a +-- +-- endowed by a given Euclidean function 'degree'. +class GcdDomain a => Euclidean a where + -- | Division with remainder. + -- + -- prop> \x y -> y == 0 || let (q, r) = x `quotRem` y in x == q * y + r + quotRem :: a -> a -> (a, a) + + -- | Division. Must match its default definition: + -- + -- prop> \x y -> quot x y == fst (quotRem x y) + quot :: a -> a -> a + quot x y = fst (quotRem x y) + + -- | Remainder. Must match its default definition: + -- + -- prop> \x y -> rem x y == snd (quotRem x y) + rem :: a -> a -> a + rem x y = snd (quotRem x y) + + -- | Euclidean (aka degree, valuation, gauge, norm) function on 'a'. Usually 'fromIntegral' . 'abs'. + -- + -- 'degree' is rarely used by itself. Its purpose + -- is to provide an evidence of soundness of 'quotRem' + -- by testing the following property: + -- + -- prop> \x y -> y == 0 || let (q, r) = x `quotRem` y in (r == 0 || degree r < degree y) + degree :: a -> Natural + +infixl 7 `quot` +infixl 7 `rem` + +coprimeIntegral :: Integral a => a -> a -> Bool +coprimeIntegral x y = (odd x || odd y) && P.gcd x y == 1 + +-- | Wrapper around 'Integral' with 'GcdDomain' +-- and 'Euclidean' instances. +newtype WrappedIntegral a = WrapIntegral { unwrapIntegral :: a } + deriving (Eq, Ord, Show, Num, Integral, Real, Enum) + +instance Num a => Semiring (WrappedIntegral a) where + plus = (P.+) + zero = 0 + times = (P.*) + one = 1 + fromNatural = fromIntegral + +instance Integral a => GcdDomain (WrappedIntegral a) where + gcd = P.gcd + lcm = P.lcm + coprime = coprimeIntegral + +instance Integral a => Euclidean (WrappedIntegral a) where + degree = fromIntegral . abs . unwrapIntegral + quotRem = P.quotRem + quot = P.quot + rem = P.rem + +instance GcdDomain Int where +#if MIN_VERSION_integer_gmp(0,5,1) + gcd (I# x) (I# y) = I# (gcdInt x y) +#else + gcd = P.gcd +#endif + lcm = P.lcm + coprime = coprimeIntegral + +instance Euclidean Int where + degree = fromIntegral . abs + quotRem = P.quotRem + quot = P.quot + rem = P.rem + +instance GcdDomain Word where +#if MIN_VERSION_integer_gmp(1,0,0) + gcd (W# x) (W# y) = W# (gcdWord x y) +#else + gcd = P.gcd +#endif + lcm = P.lcm + coprime = coprimeIntegral + +instance Euclidean Word where + degree = fromIntegral + quotRem = P.quotRem + quot = P.quot + rem = P.rem + +instance GcdDomain Integer where + gcd = gcdInteger + lcm = lcmInteger + coprime = coprimeIntegral + +instance Euclidean Integer where + degree = fromInteger . abs + quotRem = P.quotRem + quot = P.quot + rem = P.rem + +instance GcdDomain Natural where + gcd = P.gcd + lcm = P.lcm + coprime = coprimeIntegral + +instance Euclidean Natural where + degree = id + quotRem = P.quotRem + quot = P.quot + rem = P.rem + +-- | Wrapper around 'Fractional' +-- with trivial 'GcdDomain' +-- and 'Euclidean' instances. +newtype WrappedFractional a = WrapFractional { unwrapFractional :: a } + deriving (Eq, Ord, Show, Num, Fractional) + +instance Num a => Semiring (WrappedFractional a) where + plus = (P.+) + zero = 0 + times = (P.*) + one = 1 + fromNatural = fromIntegral + +instance (Eq a, Fractional a) => GcdDomain (WrappedFractional a) where + divide x y = Just (x / y) + gcd = const $ const 1 + lcm = const $ const 1 + coprime = const $ const True + +instance (Eq a, Fractional a) => Euclidean (WrappedFractional a) where + degree = const 0 + quotRem x y = (x / y, 0) + quot = (/) + rem = const $ const 0 + +instance Integral a => GcdDomain (Ratio a) where + divide x y = Just (x / y) + gcd = const $ const 1 + lcm = const $ const 1 + coprime = const $ const True + +instance Integral a => Euclidean (Ratio a) where + degree = const 0 + quotRem x y = (x / y, 0) + quot = (/) + rem = const $ const 0 + +instance GcdDomain Float where + divide x y = Just (x / y) + gcd = const $ const 1 + lcm = const $ const 1 + coprime = const $ const True + +instance Euclidean Float where + degree = const 0 + quotRem x y = (x / y, 0) + quot = (/) + rem = const $ const 0 + +instance GcdDomain Double where + divide x y = Just (x / y) + gcd = const $ const 1 + lcm = const $ const 1 + coprime = const $ const True + +instance Euclidean Double where + degree = const 0 + quotRem x y = (x / y, 0) + quot = (/) + rem = const $ const 0 diff --git a/Data/Semiring.hs b/Data/Semiring.hs --- a/Data/Semiring.hs +++ b/Data/Semiring.hs @@ -40,6 +40,7 @@ , Add(..) , Mul(..) , WrappedNum(..) + , Mod2(..) #if defined(VERSION_containers) && MIN_VERSION_base(4,7,0) , IntSetOf(..) , IntMapOf(..) @@ -61,7 +62,7 @@ import Data.Fixed (Fixed, HasResolution) import Data.Foldable (Foldable(foldMap)) import qualified Data.Foldable as Foldable -import Data.Function ((.), const) +import Data.Function ((.), const, id) #if defined(VERSION_unordered_containers) || defined(VERSION_containers) import Data.Function (flip) #endif @@ -392,6 +393,36 @@ instance Num.Num a => Ring (WrappedNum a) where negate = Num.negate + +-- | 'Mod2' represents the integers mod 2. +-- +-- It is useful in the computing of . +newtype Mod2 = Mod2 { getMod2 :: Bool } + deriving + ( Bounded + , Enum + , Eq + , Ord + , Read + , Show +#if MIN_VERSION_base(4,6,1) + , Generic +#endif + ) + +instance Semiring Mod2 where + -- we inline the definition of 'xor' + -- on Bools, since the instance did not exist until + -- base-4.7.0. + plus (Mod2 x) (Mod2 y) = Mod2 (x /= y) + times (Mod2 x) (Mod2 y) = Mod2 (x && y) + zero = Mod2 False + one = Mod2 True + +instance Ring Mod2 where + negate = id + {-# INLINE negate #-} + {-------------------------------------------------------------------- Classes diff --git a/Data/Star.hs b/Data/Star.hs --- a/Data/Star.hs +++ b/Data/Star.hs @@ -11,7 +11,7 @@ ) where import Data.Bool (Bool(..)) -import Data.Function (id, (.)) +import Data.Function (id, (.), const) import Data.Proxy (Proxy(..)) import Data.Semiring @@ -25,7 +25,7 @@ -- -- @'aplus' x = x '*' 'star' x@ class (Semiring a) => Star a where -#if __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL star | aplus #-} #endif star :: a -> a @@ -57,4 +57,7 @@ aplus _ = Proxy {-# INLINE star #-} {-# INLINE aplus #-} + +instance Star Mod2 where + star = const one diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ semirings ========== +[![Hackage](https://img.shields.io/hackage/v/semirings.svg)](https://hackage.haskell.org/package/semirings) [![Build Status](https://travis-ci.org/chessai/semirings.svg?branch=master)](https://travis-ci.org/chessai/semirings) Haskellers are usually familiar with monoids and semigroups. A monoid has an appending operation `<>` or `mappend` and an identity element `mempty`. A semigroup has an append `<>`, but does not require an `mempty` element. diff --git a/semirings.cabal b/semirings.cabal --- a/semirings.cabal +++ b/semirings.cabal @@ -1,6 +1,6 @@ name: semirings category: Algebra, Data, Data Structures, Math, Maths, Mathematics -version: 0.4.1 +version: 0.4.2 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -104,6 +104,7 @@ if impl(ghc >= 7.2) exposed-modules: + Data.Euclidean Data.Semiring Data.Star Data.Semiring.Tropical