{-# 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
class Semiring a => GcdDomain a where
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
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)
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
coprime :: a -> a -> Bool
default coprime :: Eq a => a -> a -> Bool
coprime x y = isJust (one `divide` gcd x y)
infixl 7 `divide`
class GcdDomain a => Euclidean a where
quotRem :: a -> a -> (a, a)
quot :: a -> a -> a
quot x y = fst (quotRem x y)
rem :: a -> a -> a
rem x y = snd (quotRem x 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
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
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