{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses, ConstraintKinds, FlexibleContexts, FlexibleInstances, DeriveGeneric #-}
module Algebra.Classes where

import Prelude (Integer,Float,Double, (==), Monoid(..), Ord(..), Ordering(..), Foldable,
                foldMap, (||), (&&), ($),
                 Enum(..), snd, Rational, Functor(..), Eq(..), Bool(..), Semigroup(..), Show(..), uncurry, otherwise,String)

import qualified Prelude
import qualified Data.Ratio
import qualified Data.Map.Strict as M
import Data.Map (Map)
import Foreign.C
import Data.Word
import Data.Binary
import Data.Complex
import GHC.Generics
import GHC.Int
import Test.QuickCheck
import Control.Applicative

-- import Data.Functor.Utils ((#.))

infixl 6 -
infixl 6 +

infixr 7 *^
infixr 7 *<

infixl 7 *
infixl 7 /
infixl 7 `div`
infixl 7 `mod`
infixl 7 `quot`
infixl 7 `rem`

infixr 8 ^
infixr 8 ^+
infixr 8 ^/
infixr 8 **
infixr 8 ^?

type Natural = Integer

timesDefault :: (Additive a1, Additive a2, Prelude.Integral a1) => a1 -> a2 -> a2
timesDefault :: forall a1 a2.
(Additive a1, Additive a2, Integral a1) =>
a1 -> a2 -> a2
timesDefault a1
n0 = if a1
n0 a1 -> a1 -> Bool
forall a. Ord a => a -> a -> Bool
< a1
forall a. Additive a => a
zero then [Char] -> a2 -> a2
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Algebra.Classes.times: negative number of times" else a1 -> a2 -> a2
forall {a} {a}. (Additive a, Integral a) => a -> a -> a
go a1
n0
    where go :: a -> a -> a
go a
0 a
_ = a
forall a. Additive a => a
zero
          go a
n a
x = if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y else a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y
            where (a
m,a
r) = a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`Prelude.divMod` a
2
                  y :: a
y = a -> a -> a
go a
m a
x

-- | Additive monoid
class Additive a where
  (+) :: a -> a -> a
  zero :: a
  times :: Natural -> a -> a
  times = Natural -> a -> a
forall a1 a2.
(Additive a1, Additive a2, Integral a1) =>
a1 -> a2 -> a2
timesDefault

class (Show a) => TestEqual a where
  (=.=) :: a -> a -> Property

law_refl :: TestEqual a => a -> Property
law_refl :: forall a. TestEqual a => a -> Property
law_refl a
x = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"=.=-reflexive" (a
x a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
x)

laws_testEqual :: forall a. Arbitrary a => TestEqual a => Property
laws_testEqual :: forall a. (Arbitrary a, TestEqual a) => Property
laws_testEqual = (a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a. TestEqual a => a -> Property
law_refl @a)

infix 0 =.=

instance Multiplicative Property where
  one :: Property
one = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
  * :: Property -> Property -> Property
(*) = Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
(.&&.)

nameLaw :: Testable prop => Prelude.String -> prop -> Property
nameLaw :: forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
x prop
p = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label [Char]
x ([Char] -> prop -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
x prop
p)

law_assoc :: forall a. (TestEqual a) => String -> (a -> a -> a) -> a -> a -> a -> Property
law_assoc :: forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> a -> Property
law_assoc [Char]
opName a -> a -> a
(⊕) a
m a
n a
o = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw ([Char]
opName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-assoc") (a
n a -> a -> a
⊕ (a
m a -> a -> a
⊕ a
o) a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= (a
n a -> a -> a
⊕ a
m) a -> a -> a
⊕ a
o)

law_left_id :: forall a. (TestEqual a) => String -> (a -> a -> a) -> a -> a ->  Property
law_left_id :: forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_left_id [Char]
opName a -> a -> a
(⊕) a
z a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw ([Char]
opName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-leftId") (a
z a -> a -> a
⊕ a
n a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
n)

law_right_id :: forall a. (TestEqual a) => String -> (a -> a -> a) -> a -> a ->  Property
law_right_id :: forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_right_id [Char]
opName a -> a -> a
(⊕) a
z a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw ([Char]
opName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-rightId") (a
n a -> a -> a
⊕ a
z a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
n)

laws_monoid :: forall a. (Arbitrary a, TestEqual a) => String -> (a -> a -> a) -> a -> Property
laws_monoid :: forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_monoid [Char]
opName a -> a -> a
(⊕) a
z = [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product
   [(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_left_id @a [Char]
opName a -> a -> a
(⊕) a
z)
   ,(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_right_id @a [Char]
opName a -> a -> a
(⊕) a
z)
   ,(a -> a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> a -> Property
law_assoc @a [Char]
opName a -> a -> a
(⊕))]

law_commutative :: (TestEqual a) => String -> (a -> a -> a) -> a -> a -> Property
law_commutative :: forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_commutative [Char]
opName a -> a -> a
(⊕) a
m a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw ([Char]
opName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-comm") (a
m a -> a -> a
⊕ a
n a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
n a -> a -> a
⊕ a
m)

laws_comm_monoid :: forall a. (Arbitrary a, TestEqual a) => String -> (a -> a -> a) -> a -> Property
laws_comm_monoid :: forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_comm_monoid [Char]
opName a -> a -> a
(⊕) a
z = [Char] -> (a -> a -> a) -> a -> Property
forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_monoid [Char]
opName a -> a -> a
(⊕) a
z Property -> Property -> Property
forall a. Multiplicative a => a -> a -> a
* (a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ([Char] -> (a -> a -> a) -> a -> a -> Property
forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_commutative [Char]
opName a -> a -> a
(⊕)) 
                                          

law_times :: (TestEqual a, Additive a) => Positive Integer -> a -> Property
law_times :: forall a.
(TestEqual a, Additive a) =>
Positive Natural -> a -> Property
law_times (Positive Natural
m) a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"times" (Natural -> a -> a
forall a. Additive a => Natural -> a -> a
times Natural
m a
n a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= Natural -> a -> a
forall a1 a2.
(Additive a1, Additive a2, Integral a1) =>
a1 -> a2 -> a2
timesDefault Natural
m a
n)

laws_additive :: forall a. Arbitrary a => (Additive a, TestEqual a) => Property
laws_additive :: forall a. (Arbitrary a, Additive a, TestEqual a) => Property
laws_additive = [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [Property -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_monoid @a [Char]
"plus" a -> a -> a
forall a. Additive a => a -> a -> a
(+) a
forall a. Additive a => a
zero)
                        ,(Positive Natural -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
(TestEqual a, Additive a) =>
Positive Natural -> a -> Property
law_times @a)]

law_exp_pos :: (TestEqual a, Multiplicative a) => a -> Property
law_exp_pos :: forall a. (TestEqual a, Multiplicative a) => a -> Property
law_exp_pos a
n = [Char] -> Gen Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"positive exponent" (Gen Property -> Property) -> Gen Property -> Property
forall a b. (a -> b) -> a -> b
$ do
  Natural
m <- (Natural, Natural) -> Gen Natural
forall a. Random a => (a, a) -> Gen a
choose (Natural
0,Natural
5) -- for dense polynomials, elevating to a large power can be very expensive.
  Property -> Gen Property
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n a -> Natural -> a
forall a. Multiplicative a => a -> Natural -> a
^+ Natural
m a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a -> Natural -> a
forall a. Multiplicative a => a -> Natural -> a
positiveExponentDefault a
n Natural
m)

laws_multiplicative :: forall a. Arbitrary a => (Multiplicative a, TestEqual a) => Property
laws_multiplicative :: forall a. (Arbitrary a, Multiplicative a, TestEqual a) => Property
laws_multiplicative = [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [Property -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_monoid @a [Char]
"mul" a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) a
forall a. Multiplicative a => a
one)
                              ,(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a. (TestEqual a, Multiplicative a) => a -> Property
law_exp_pos @a)]

law_fromInteger :: forall a. (TestEqual a, Ring a) => Integer -> Property
law_fromInteger :: forall a. (TestEqual a, Ring a) => Natural -> Property
law_fromInteger Natural
m = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"fromInteger" (forall a. Ring a => Natural -> a
fromInteger @a Natural
m a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= Natural -> a
forall a. PreRing a => Natural -> a
fromIntegerDefault Natural
m)

laws_ring :: forall a. Arbitrary a => (Ring a, TestEqual a) => Property
laws_ring :: forall a. (Arbitrary a, Ring a, TestEqual a) => Property
laws_ring = [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [(Natural -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a. (TestEqual a, Ring a) => Natural -> Property
law_fromInteger @a)
                    ,forall a. (Arbitrary a, Group a, TestEqual a) => Property
laws_group @a
                    ,forall s a.
(Arbitrary a, Module s a, TestEqual a, Arbitrary s, Show s) =>
Property
laws_module @a @a
                    ,forall a. (Arbitrary a, Multiplicative a, TestEqual a) => Property
laws_multiplicative @a]

instance TestEqual Int where =.= :: Int -> Int -> Property
(=.=) = Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
(===)
instance TestEqual Double where
  Double
x =.= :: Double -> Double -> Property
=.= Double
y = [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Double -> [Char]
forall a. Show a => a -> [Char]
show Double
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char]
interpret Bool
res [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Double -> [Char]
forall a. Show a => a -> [Char]
show Double
y) Bool
res
   where
    res :: Bool
res = (Double -> Double
forall a. Num a => a -> a
Prelude.abs (Double
xDouble -> Double -> Double
forall a. Group a => a -> a -> a
-Double
y) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01)
    interpret :: Bool -> [Char]
interpret Bool
True  = [Char]
" == "  
    interpret Bool
False = [Char]
" /= "

sum :: (Foldable t, Additive a) => t a -> a
sum :: forall (t :: * -> *) a. (Foldable t, Additive a) => t a -> a
sum t a
xs = Sum a -> a
forall a. Sum a -> a
fromSum ((a -> Sum a) -> t a -> Sum a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Sum a
forall a. a -> Sum a
Sum t a
xs)

instance Additive Integer where
  + :: Natural -> Natural -> Natural
(+) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Natural
zero = Natural
0
  times :: Natural -> Natural -> Natural
times Natural
n Natural
x = Natural
n Natural -> Natural -> Natural
forall a. Multiplicative a => a -> a -> a
* Natural
x

instance Additive Word32 where
  + :: Word32 -> Word32 -> Word32
(+) = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Word32
zero = Word32
0
  times :: Natural -> Word32 -> Word32
times Natural
n Word32
x = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Word32 -> Word32 -> Word32
forall a. Multiplicative a => a -> a -> a
* Word32
x

instance Additive Word16 where
  + :: Word16 -> Word16 -> Word16
(+) = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Word16
zero = Word16
0
  times :: Natural -> Word16 -> Word16
times Natural
n Word16
x = Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Word16 -> Word16 -> Word16
forall a. Multiplicative a => a -> a -> a
* Word16
x

instance Additive Word8 where
  + :: Word8 -> Word8 -> Word8
(+) = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Word8
zero = Word8
0
  times :: Natural -> Word8 -> Word8
times Natural
n Word8
x = Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Word8 -> Word8 -> Word8
forall a. Multiplicative a => a -> a -> a
* Word8
x

instance Additive Int32 where
  + :: Int32 -> Int32 -> Int32
(+) = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Int32
zero = Int32
0
  times :: Natural -> Int32 -> Int32
times Natural
n Int32
x = Natural -> Int32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Int32 -> Int32 -> Int32
forall a. Multiplicative a => a -> a -> a
* Int32
x
instance Additive Int16 where
  + :: Int16 -> Int16 -> Int16
(+) = Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Int16
zero = Int16
0
  times :: Natural -> Int16 -> Int16
times Natural
n Int16
x = Natural -> Int16
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Int16 -> Int16 -> Int16
forall a. Multiplicative a => a -> a -> a
* Int16
x
instance Additive Int8 where
  + :: Int8 -> Int8 -> Int8
(+) = Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Int8
zero = Int8
0
  times :: Natural -> Int8 -> Int8
times Natural
n Int8
x = Natural -> Int8
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Int8 -> Int8 -> Int8
forall a. Multiplicative a => a -> a -> a
* Int8
x

instance Additive CInt where
  + :: CInt -> CInt -> CInt
(+) = CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: CInt
zero = CInt
0
  times :: Natural -> CInt -> CInt
times Natural
n CInt
x = Natural -> CInt
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n CInt -> CInt -> CInt
forall a. Multiplicative a => a -> a -> a
* CInt
x

instance Additive Int where
  + :: Int -> Int -> Int
(+) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Int
zero = Int
0
  times :: Natural -> Int -> Int
times Natural
n Int
x = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
x

instance Additive Double where
  + :: Double -> Double -> Double
(+) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Double
zero = Double
0
  times :: Natural -> Double -> Double
times Natural
n Double
x = Natural -> Double
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x

instance Additive Bool where
  + :: Bool -> Bool -> Bool
(+) = Bool -> Bool -> Bool
(Prelude.||)
  zero :: Bool
zero = Bool
False

instance Additive Float where
  + :: Float -> Float -> Float
(+) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(Prelude.+)
  zero :: Float
zero = Float
0
  times :: Natural -> Float -> Float
times Natural
n Float
x = Natural -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Natural
n Float -> Float -> Float
forall a. Multiplicative a => a -> a -> a
* Float
x

instance (Ord k,AbelianAdditive v) => Additive (Map k v) where
  + :: Map k v -> Map k v -> Map k v
(+) = (v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith v -> v -> v
forall a. Additive a => a -> a -> a
(+)
  zero :: Map k v
zero = Map k v
forall k a. Map k a
M.empty
  times :: Natural -> Map k v -> Map k v
times Natural
n = (v -> v) -> Map k v -> Map k v
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural -> v -> v
forall a. Additive a => Natural -> a -> a
times Natural
n)

instance (Additive v) => Additive (k -> v) where
  + :: (k -> v) -> (k -> v) -> k -> v
(+) = (v -> v -> v) -> (k -> v) -> (k -> v) -> k -> v
forall a b c. (a -> b -> c) -> (k -> a) -> (k -> b) -> k -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall a. Additive a => a -> a -> a
(+)
  zero :: k -> v
zero = v -> k -> v
forall a. a -> k -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. Additive a => a
zero
  times :: Natural -> (k -> v) -> k -> v
times Natural
n = (v -> v) -> (k -> v) -> k -> v
forall a b. (a -> b) -> (k -> a) -> k -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural -> v -> v
forall a. Additive a => Natural -> a -> a
times Natural
n)

class Additive r => DecidableZero r where
  isZero :: r -> Bool

law_decidable_zero :: forall a. (DecidableZero a, TestEqual a) => Property
law_decidable_zero :: forall a. (DecidableZero a, TestEqual a) => Property
law_decidable_zero = Bool -> Property
forall prop. Testable prop => prop -> Property
property (a -> Bool
forall r. DecidableZero r => r -> Bool
isZero (forall a. Additive a => a
zero @a))


instance DecidableZero Integer where
  isZero :: Natural -> Bool
isZero = (Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0)
instance DecidableZero CInt where
  isZero :: CInt -> Bool
isZero = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
instance DecidableZero Word32 where
  isZero :: Word32 -> Bool
isZero = (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0)
instance DecidableZero Word16 where
  isZero :: Word16 -> Bool
isZero = (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0)
instance DecidableZero Word8 where
  isZero :: Word8 -> Bool
isZero = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
instance DecidableZero Int where
  isZero :: Int -> Bool
isZero = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
instance DecidableZero Double where
  isZero :: Double -> Bool
isZero = (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0)
instance DecidableZero Float where
  isZero :: Float -> Bool
isZero = (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0)
instance (Prelude.Integral x, DecidableZero x) => DecidableZero (Data.Ratio.Ratio x) where
  isZero :: Ratio x -> Bool
isZero Ratio x
x = x -> Bool
forall r. DecidableZero r => r -> Bool
isZero (Ratio x -> x
forall a. Ratio a -> a
Data.Ratio.numerator Ratio x
x)
instance (Ord k,DecidableZero v,AbelianAdditive v) => DecidableZero (Map k v) where
  isZero :: Map k v -> Bool
isZero = (v -> Bool) -> Map k v -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.all v -> Bool
forall r. DecidableZero r => r -> Bool
isZero
instance DecidableZero x => DecidableZero (Complex x) where
  isZero :: Complex x -> Bool
isZero (x
x :+ x
y) = x -> Bool
forall r. DecidableZero r => r -> Bool
isZero x
x Bool -> Bool -> Bool
&& x -> Bool
forall r. DecidableZero r => r -> Bool
isZero x
y

class Additive a => AbelianAdditive a
  -- just a law.

laws_abelian_additive :: forall a. (Arbitrary a, AbelianAdditive a, TestEqual a) => Property
laws_abelian_additive :: forall a. (Arbitrary a, AbelianAdditive a, TestEqual a) => Property
laws_abelian_additive = forall a.
(Arbitrary a, TestEqual a) =>
[Char] -> (a -> a -> a) -> a -> Property
laws_comm_monoid @a [Char]
"plus" a -> a -> a
forall a. Additive a => a -> a -> a
(+) a
forall a. Additive a => a
zero

instance AbelianAdditive Integer
instance AbelianAdditive CInt
instance AbelianAdditive Int
instance AbelianAdditive Int8
instance AbelianAdditive Int16
instance AbelianAdditive Int32
instance AbelianAdditive Word8
instance AbelianAdditive Word16
instance AbelianAdditive Word32
instance AbelianAdditive Bool
instance AbelianAdditive Double
instance AbelianAdditive Float
instance (Ord k,AbelianAdditive v) => AbelianAdditive (Map k v)
instance (AbelianAdditive v) => AbelianAdditive (k -> v)

multDefault :: Group a => Natural -> a -> a
multDefault :: forall a. Group a => Natural -> a -> a
multDefault Natural
n a
x = if Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
0 then a -> a
forall a. Group a => a -> a
negate (Natural -> a -> a
forall a. Additive a => Natural -> a -> a
times (Natural -> Natural
forall a. Group a => a -> a
negate Natural
n) a
x) else Natural -> a -> a
forall a. Additive a => Natural -> a -> a
times Natural
n a
x

class Additive a => Group a where
  {-# MINIMAL (negate | (-) | subtract) #-}
  (-) :: a -> a -> a
  a
a - a
b = a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. Group a => a -> a
negate a
b
  subtract :: a -> a -> a
  subtract a
b a
a = a
a a -> a -> a
forall a. Group a => a -> a -> a
- a
b
  negate :: a -> a
  negate a
b = a
forall a. Additive a => a
zero a -> a -> a
forall a. Group a => a -> a -> a
- a
b
  mult :: Integer -> a -> a
  mult = Natural -> a -> a
forall a. Group a => Natural -> a -> a
multDefault

law_negate_minus :: (TestEqual a, Group a) => a -> a -> Property
law_negate_minus :: forall a. (TestEqual a, Group a) => a -> a -> Property
law_negate_minus a
m a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"minus/negate" (a
m a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. Group a => a -> a
negate a
n a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
m a -> a -> a
forall a. Group a => a -> a -> a
- a
n)

law_mult :: (TestEqual a, Group a) => Integer -> a -> Property
law_mult :: forall a. (TestEqual a, Group a) => Natural -> a -> Property
law_mult Natural
m a
n = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"mult" (Natural -> a -> a
forall a. Group a => Natural -> a -> a
mult Natural
m a
n a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= Natural -> a -> a
forall a. Group a => Natural -> a -> a
multDefault Natural
m a
n)


laws_group :: forall a. Arbitrary a => (Group a, TestEqual a) => Property
laws_group :: forall a. (Arbitrary a, Group a, TestEqual a) => Property
laws_group = forall a. (Arbitrary a, Additive a, TestEqual a) => Property
laws_additive @a Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [(a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a. (TestEqual a, Group a) => a -> a -> Property
law_negate_minus @a)
                                           ,(Natural -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a. (TestEqual a, Group a) => Natural -> a -> Property
law_mult @a)]

laws_abelian_group :: forall a. Arbitrary a => (Group a, TestEqual a) => Property
laws_abelian_group :: forall a. (Arbitrary a, Group a, TestEqual a) => Property
laws_abelian_group = forall a. (Arbitrary a, Group a, TestEqual a) => Property
laws_group @a Property -> Property -> Property
forall a. Multiplicative a => a -> a -> a
* [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [(a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall a.
TestEqual a =>
[Char] -> (a -> a -> a) -> a -> a -> Property
law_commutative @a [Char]
"plus" a -> a -> a
forall a. Additive a => a -> a -> a
(+))]

instance Group Integer where
  (-) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Natural -> Natural
negate = Natural -> Natural
forall a. Num a => a -> a
Prelude.negate

instance Group Int where
  (-) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Int -> Int
negate = Int -> Int
forall a. Num a => a -> a
Prelude.negate

instance Group CInt where
  (-) = CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: CInt -> CInt
negate = CInt -> CInt
forall a. Num a => a -> a
Prelude.negate

instance Group Int32 where
  (-) = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Int32 -> Int32
negate = Int32 -> Int32
forall a. Num a => a -> a
Prelude.negate
instance Group Int16 where
  (-) = Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Int16 -> Int16
negate = Int16 -> Int16
forall a. Num a => a -> a
Prelude.negate
instance Group Int8 where
  (-) = Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Int8 -> Int8
negate = Int8 -> Int8
forall a. Num a => a -> a
Prelude.negate

instance Group Word32 where
  (-) = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Word32 -> Word32
negate = Word32 -> Word32
forall a. Num a => a -> a
Prelude.negate
instance Group Word16 where
  (-) = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Word16 -> Word16
negate = Word16 -> Word16
forall a. Num a => a -> a
Prelude.negate
instance Group Word8 where
  (-) = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Word8 -> Word8
negate = Word8 -> Word8
forall a. Num a => a -> a
Prelude.negate

instance Group Double where
  (-) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Double -> Double
negate = Double -> Double
forall a. Num a => a -> a
Prelude.negate

instance Group Float where
  (-) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(Prelude.-)
  negate :: Float -> Float
negate = Float -> Float
forall a. Num a => a -> a
Prelude.negate

instance (Ord k,Group v,AbelianAdditive v) => Group (Map k v) where
  -- This definition does not work:
  -- (-) = M.unionWith (-)
  -- because if a key is not present on the lhs. then the rhs won't be negated.
  negate :: Map k v -> Map k v
negate = (v -> v) -> Map k v -> Map k v
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall a. Group a => a -> a
negate

instance (Group v) => Group (k -> v) where
  negate :: (k -> v) -> k -> v
negate = (v -> v) -> (k -> v) -> k -> v
forall a b. (a -> b) -> (k -> a) -> k -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall a. Group a => a -> a
negate
  (-) = (v -> v -> v) -> (k -> v) -> (k -> v) -> k -> v
forall a b c. (a -> b -> c) -> (k -> a) -> (k -> b) -> k -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)

-- | Functorial scaling. Compared to (*^) this operator disambiguates
-- the scalar type, by using the functor structure and using the
-- multiplicative instance for scalars.
(*<) :: (Functor f, Multiplicative a) => a -> f a -> f a
a
s *< :: forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
a -> f a -> f a
*< f a
v = (a
sa -> a -> a
forall a. Multiplicative a => a -> a -> a
*) (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v

-- | Any instance must preserve the following invariants: 1. if
-- Multiplicative a and Scalable a a, then (*) = (*^) for a.
-- 2. Scalable must define a partial order relation, in particular,
-- instances of the form (Scalable s a) => Scalable s (T ... a ...)
-- are acceptable, and should be declared overlappable.

class Scalable s a where
  (*^) :: s -> a -> a

instance {-# Overlappable #-} Scalable s a => Scalable s (Map k a) where
  s
s *^ :: s -> Map k a -> Map k a
*^ Map k a
x = (a -> a) -> Map k a -> Map k a
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^) Map k a
x

instance {-# Overlappable #-} Scalable s a => Scalable s (k -> a) where
  s
s *^ :: s -> (k -> a) -> k -> a
*^ k -> a
x = (a -> a) -> (k -> a) -> k -> a
forall a b. (a -> b) -> (k -> a) -> k -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^) k -> a
x

-- | "Most natural" scaling. Also disambiguates the scalar type, but using a fundep.
class Scalable' a where
  type Scalar a
  (!*^) :: Scalar a -> a -> a

  
-- | A prefix variant of (*^), useful when using type applications.
-- scale :: forall s a. Scalable s a => s -> a -> a
-- scale = (*^)

type SemiModule s a = (AbelianAdditive a, SemiRing s, Scalable s a)

type Module s a = (SemiModule s a, Group s, Group a)

law_module_zero :: forall s a. (Module s a, TestEqual a) => s -> Property
law_module_zero :: forall s a. (Module s a, TestEqual a) => s -> Property
law_module_zero s
s = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"module/zero" (s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
forall a. Additive a => a
zero a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= forall a. Additive a => a
zero @a)

law_module_one :: forall s a. (Module s a, TestEqual a) => a -> Property
law_module_one :: forall s a. (Module s a, TestEqual a) => a -> Property
law_module_one a
x = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"module/one" ((forall a. Multiplicative a => a
one @s) s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
x a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= a
x)

law_module_sum :: forall s a. (Module s a, TestEqual a) => s -> a -> a -> Property
law_module_sum :: forall s a. (Module s a, TestEqual a) => s -> a -> a -> Property
law_module_sum s
s a
x a
y = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"module/distr/left" (s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y) a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= s
ss -> a -> a
forall s a. Scalable s a => s -> a -> a
*^a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
y)

law_module_sum_left :: forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_sum_left :: forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_sum_left s
s s
t a
x = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"module/distr/right" ((s
s s -> s -> s
forall a. Additive a => a -> a -> a
+ s
t) s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
x a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= s
ss -> a -> a
forall s a. Scalable s a => s -> a -> a
*^a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ s
t s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
x)

law_module_mul :: forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_mul :: forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_mul s
s s
t a
x = [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
nameLaw [Char]
"module/mul/assoc" ((s
s s -> s -> s
forall a. Multiplicative a => a -> a -> a
* s
t) s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
x a -> a -> Property
forall a. TestEqual a => a -> a -> Property
=.= s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ s
t s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^ a
x)

laws_module :: forall s a. Arbitrary a => (Module s a, TestEqual a, Arbitrary s, Show s) => Property
laws_module :: forall s a.
(Arbitrary a, Module s a, TestEqual a, Arbitrary s, Show s) =>
Property
laws_module = forall a. (Arbitrary a, Additive a, TestEqual a) => Property
laws_additive @a Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. [Property] -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product [(s -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall s a. (Module s a, TestEqual a) => s -> Property
law_module_zero @s @a)
                                            ,(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall s a. (Module s a, TestEqual a) => a -> Property
law_module_one @s @a)
                                            ,(s -> a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall s a. (Module s a, TestEqual a) => s -> a -> a -> Property
law_module_sum @s @a)
                                            ,(s -> s -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_sum_left @s @a)
                                            ,(s -> s -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (forall s a. (Module s a, TestEqual a) => s -> s -> a -> Property
law_module_mul @s @a)
                                            ]

-- Comparision of maps with absence of a key equivalent to zero value.
instance (Ord x, Show x, Arbitrary x,TestEqual a,Additive a) => TestEqual (Map x a) where
  Map x a
x =.= :: Map x a -> Map x a -> Property
=.= Map x a
y = Map x Property -> Property
forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product ((a -> a -> Property) -> (a, a) -> Property
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Property
forall a. TestEqual a => a -> a -> Property
(=.=) ((a, a) -> Property) -> Map x (a, a) -> Map x Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> (a, a) -> (a, a))
-> Map x (a, a) -> Map x (a, a) -> Map x (a, a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (a, a) -> (a, a) -> (a, a)
forall b c d. (a, b) -> (c, d) -> (a, d)
collapse ((,a
forall a. Additive a => a
zero) (a -> (a, a)) -> Map x a -> Map x (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map x a
x) ((a
forall a. Additive a => a
zero,) (a -> (a, a)) -> Map x a -> Map x (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map x a
y))
    where collapse :: (a,b) -> (c,d) -> (a,d)
          collapse :: forall b c d. (a, b) -> (c, d) -> (a, d)
collapse (a
a,b
_) (c
_,d
b) = (a
a,d
b)


instance Scalable Integer Integer where
  *^ :: Natural -> Natural -> Natural
(*^) = Natural -> Natural -> Natural
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable Int Int where *^ :: Int -> Int -> Int
(*^) = Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable Int8 Int8 where *^ :: Int8 -> Int8 -> Int8
(*^) = Int8 -> Int8 -> Int8
forall a. Multiplicative a => a -> a -> a
(*)
instance Scalable Int16 Int16 where *^ :: Int16 -> Int16 -> Int16
(*^) = Int16 -> Int16 -> Int16
forall a. Multiplicative a => a -> a -> a
(*)
instance Scalable Int32 Int32 where *^ :: Int32 -> Int32 -> Int32
(*^) = Int32 -> Int32 -> Int32
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable Word8 Word8 where *^ :: Word8 -> Word8 -> Word8
(*^) = Word8 -> Word8 -> Word8
forall a. Multiplicative a => a -> a -> a
(*)
instance Scalable Word16 Word16 where *^ :: Word16 -> Word16 -> Word16
(*^) = Word16 -> Word16 -> Word16
forall a. Multiplicative a => a -> a -> a
(*)
instance Scalable Word32 Word32 where *^ :: Word32 -> Word32 -> Word32
(*^) = Word32 -> Word32 -> Word32
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable CInt CInt where
  *^ :: CInt -> CInt -> CInt
(*^) = CInt -> CInt -> CInt
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable Double Double where
  *^ :: Double -> Double -> Double
(*^) = Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
(*)

instance Scalable Float Float where
  *^ :: Float -> Float -> Float
(*^) = Float -> Float -> Float
forall a. Multiplicative a => a -> a -> a
(*)

-- | Multiplicative monoid
class Multiplicative a where
  (*) :: a -> a -> a
  one :: a
  (^+) :: a -> Natural -> a
  (^+) = a -> Natural -> a
forall a. Multiplicative a => a -> Natural -> a
positiveExponentDefault

positiveExponentDefault :: Multiplicative a => a -> Natural -> a
positiveExponentDefault :: forall a. Multiplicative a => a -> Natural -> a
positiveExponentDefault a
x0 Natural
n0 = if Natural
n0 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
0 then [Char] -> a
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Algebra.Classes.^+: negative exponent" else a -> Natural -> a
forall {a} {a}. (Multiplicative a, Integral a) => a -> a -> a
go a
x0 Natural
n0
    where go :: a -> a -> a
go a
_ a
0 = a
forall a. Multiplicative a => a
one
          go a
x a
n = if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y else a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y
            where (a
m,a
r) = a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`Prelude.divMod` a
2
                  y :: a
y = a -> a -> a
go a
x a
m

product :: (Multiplicative a, Foldable f) => f a -> a
product :: forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product f a
xs = Product a -> a
forall a. Product a -> a
fromProduct ((a -> Product a) -> f a -> Product a
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Product a
forall a. a -> Product a
Product f a
xs)

instance Multiplicative Integer where
  * :: Natural -> Natural -> Natural
(*) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Natural
one = Natural
1
  ^+ :: Natural -> Natural -> Natural
(^+) = Natural -> Natural -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative CInt where
  * :: CInt -> CInt -> CInt
(*) = CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: CInt
one = CInt
1
  ^+ :: CInt -> Natural -> CInt
(^+) = CInt -> Natural -> CInt
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Word32 where
  * :: Word32 -> Word32 -> Word32
(*) = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Word32
one = Word32
1
  ^+ :: Word32 -> Natural -> Word32
(^+) = Word32 -> Natural -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Word16 where
  * :: Word16 -> Word16 -> Word16
(*) = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Word16
one = Word16
1
  ^+ :: Word16 -> Natural -> Word16
(^+) = Word16 -> Natural -> Word16
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Word8 where
  * :: Word8 -> Word8 -> Word8
(*) = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Word8
one = Word8
1
  ^+ :: Word8 -> Natural -> Word8
(^+) = Word8 -> Natural -> Word8
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Int32 where
  * :: Int32 -> Int32 -> Int32
(*) = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Int32
one = Int32
1
  ^+ :: Int32 -> Natural -> Int32
(^+) = Int32 -> Natural -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Int16 where
  * :: Int16 -> Int16 -> Int16
(*) = Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Int16
one = Int16
1
  ^+ :: Int16 -> Natural -> Int16
(^+) = Int16 -> Natural -> Int16
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Int8 where
  * :: Int8 -> Int8 -> Int8
(*) = Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Int8
one = Int8
1
  ^+ :: Int8 -> Natural -> Int8
(^+) = Int8 -> Natural -> Int8
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Int where
  * :: Int -> Int -> Int
(*) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Int
one = Int
1
  ^+ :: Int -> Natural -> Int
(^+) = Int -> Natural -> Int
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Double where
  * :: Double -> Double -> Double
(*) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Double
one = Double
1
  ^+ :: Double -> Natural -> Double
(^+) = Double -> Natural -> Double
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Float where
  * :: Float -> Float -> Float
(*) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(Prelude.*)
  one :: Float
one = Float
1
  ^+ :: Float -> Natural -> Float
(^+) = Float -> Natural -> Float
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Multiplicative Bool where
  * :: Bool -> Bool -> Bool
(*) = Bool -> Bool -> Bool
(Prelude.&&)
  one :: Bool
one = Bool
True


type SemiRing a = (Multiplicative a, AbelianAdditive a)
type PreRing a = (SemiRing a, Group a)

fromIntegerDefault :: PreRing a => Integer -> a
fromIntegerDefault :: forall a. PreRing a => Natural -> a
fromIntegerDefault Natural
n = Natural -> a -> a
forall a. Group a => Natural -> a -> a
mult Natural
n a
forall a. Multiplicative a => a
one

class (Module a a, PreRing a) => Ring a where
  fromInteger :: Integer -> a
  fromInteger = Natural -> a
forall a. PreRing a => Natural -> a
fromIntegerDefault

instance Ring Integer where
  fromInteger :: Natural -> Natural
fromInteger = Natural -> Natural
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring Int8 where fromInteger :: Natural -> Int8
fromInteger = Natural -> Int8
forall a. Num a => Natural -> a
Prelude.fromInteger
instance Ring Int16 where fromInteger :: Natural -> Int16
fromInteger = Natural -> Int16
forall a. Num a => Natural -> a
Prelude.fromInteger
instance Ring Int32 where fromInteger :: Natural -> Int32
fromInteger = Natural -> Int32
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring Word8 where fromInteger :: Natural -> Word8
fromInteger = Natural -> Word8
forall a. Num a => Natural -> a
Prelude.fromInteger
instance Ring Word16 where fromInteger :: Natural -> Word16
fromInteger = Natural -> Word16
forall a. Num a => Natural -> a
Prelude.fromInteger
instance Ring Word32 where fromInteger :: Natural -> Word32
fromInteger = Natural -> Word32
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring CInt where
  fromInteger :: Natural -> CInt
fromInteger = Natural -> CInt
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring Int where
  fromInteger :: Natural -> Int
fromInteger = Natural -> Int
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring Double where
  fromInteger :: Natural -> Double
fromInteger = Natural -> Double
forall a. Num a => Natural -> a
Prelude.fromInteger

instance Ring Float where
  fromInteger :: Natural -> Float
fromInteger = Natural -> Float
forall a. Num a => Natural -> a
Prelude.fromInteger

class Multiplicative a => Division a where
  {-# MINIMAL (recip | (/)) #-}
  recip :: a -> a
  recip a
x         =  a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Division a => a -> a -> a
/ a
x

  (/) :: a -> a -> a
  a
x / a
y           =  a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Division a => a -> a
recip a
y

  (^) :: a -> Integer -> a
  a
b ^ Natural
n | Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
0 = a -> a
forall a. Division a => a -> a
recip a
b a -> Natural -> a
forall a. Multiplicative a => a -> Natural -> a
^+ Natural -> Natural
forall a. Group a => a -> a
negate Natural
n
        | Bool
True  = a
b a -> Natural -> a
forall a. Multiplicative a => a -> Natural -> a
^+ Natural
n

instance Division Double where
  / :: Double -> Double -> Double
(/) = Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(Prelude./)
  recip :: Double -> Double
recip = Double -> Double
forall a. Fractional a => a -> a
Prelude.recip
  ^ :: Double -> Natural -> Double
(^) = Double -> Natural -> Double
forall a b. (Fractional a, Integral b) => a -> b -> a
(Prelude.^^)

instance Division Float where
  / :: Float -> Float -> Float
(/) = Float -> Float -> Float
forall a. Fractional a => a -> a -> a
(Prelude./)
  recip :: Float -> Float
recip = Float -> Float
forall a. Fractional a => a -> a
Prelude.recip
  ^ :: Float -> Natural -> Float
(^) = Float -> Natural -> Float
forall a b. (Fractional a, Integral b) => a -> b -> a
(Prelude.^^)

class (Ring a, Division a) => Field a where
  fromRational :: Rational -> a
  fromRational Rational
x  =  Natural -> a
forall a. Ring a => Natural -> a
fromInteger (Rational -> Natural
forall a. Ratio a -> a
Data.Ratio.numerator Rational
x) a -> a -> a
forall a. Division a => a -> a -> a
/
                     Natural -> a
forall a. Ring a => Natural -> a
fromInteger (Rational -> Natural
forall a. Ratio a -> a
Data.Ratio.denominator Rational
x)

instance Field Double where
  fromRational :: Rational -> Double
fromRational = Rational -> Double
forall a. Fractional a => Rational -> a
Prelude.fromRational

instance Field Float where
  fromRational :: Rational -> Float
fromRational = Rational -> Float
forall a. Fractional a => Rational -> a
Prelude.fromRational


class (Ring a, DecidableZero a) => EuclideanDomain a where
    {-# MINIMAL (stdUnit | normalize) , (quotRem | (quot , rem)) #-}
    stdAssociate    :: a -> a
    stdUnit         :: a -> a
    normalize       :: a -> (a, a)

    quot, rem        :: a -> a -> a
    quotRem          :: a -> a -> (a,a)

    stdAssociate a
x  =  a
x a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`quot` a -> a
forall a. EuclideanDomain a => a -> a
stdUnit a
x
    stdUnit a
x       =  (a, a) -> a
forall a b. (a, b) -> b
snd (a -> (a, a)
forall a. EuclideanDomain a => a -> (a, a)
normalize a
x)
    normalize a
x     =  (a -> a
forall a. EuclideanDomain a => a -> a
stdAssociate a
x, a -> a
forall a. EuclideanDomain a => a -> a
stdUnit a
x)

    a
n `quotRem` a
d    =  (a
n a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`quot` a
d, a
n a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`rem` a
d)
    a
n `quot` a
d       =  a
q  where (a
q,a
_) = a -> a -> (a, a)
forall a. EuclideanDomain a => a -> a -> (a, a)
quotRem a
n a
d
    a
n `rem` a
d       =  a
r  where (a
_,a
r) = a -> a -> (a, a)
forall a. EuclideanDomain a => a -> a -> (a, a)
quotRem a
n a
d

gcd             :: EuclideanDomain a => a -> a -> a
{-# NOINLINE [1] gcd #-}
gcd :: forall a. EuclideanDomain a => a -> a -> a
gcd a
x a
y         =  a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
gcd' (a -> a
forall a. EuclideanDomain a => a -> a
stdAssociate a
x) (a -> a
forall a. EuclideanDomain a => a -> a
stdAssociate a
y)
 where
   gcd'             :: (EuclideanDomain a) => a -> a -> a
   gcd' :: forall a. EuclideanDomain a => a -> a -> a
gcd' a
a a
b | a -> Bool
forall r. DecidableZero r => r -> Bool
isZero a
b  =  a
a
            | Bool
otherwise  =  a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
gcd' a
b (a
a a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`rem` a
b)

-- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide.
lcm :: (EuclideanDomain a) => a -> a -> a
{-# SPECIALISE lcm :: Int -> Int -> Int #-}
{-# NOINLINE [1] lcm #-}
lcm :: forall a. EuclideanDomain a => a -> a -> a
lcm a
x a
y | a -> Bool
forall r. DecidableZero r => r -> Bool
isZero a
x Bool -> Bool -> Bool
|| a -> Bool
forall r. DecidableZero r => r -> Bool
isZero a
y = a
forall a. Additive a => a
zero
        | Bool
otherwise =  a -> a
forall a. EuclideanDomain a => a -> a
stdAssociate ((a
x a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
`quot` (a -> a -> a
forall a. EuclideanDomain a => a -> a -> a
gcd a
x a
y)) a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y)

instance  EuclideanDomain Integer  where
    quot :: Natural -> Natural -> Natural
quot             =  Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.quot
    rem :: Natural -> Natural -> Natural
rem             =  Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.rem
    stdAssociate :: Natural -> Natural
stdAssociate Natural
x  =  Natural -> Natural
forall a. Num a => a -> a
Prelude.abs Natural
x
    stdUnit :: Natural -> Natural
stdUnit Natural
x       =  if Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
0 then -Natural
1 else Natural
1

instance  EuclideanDomain CInt  where
    quot :: CInt -> CInt -> CInt
quot             =  CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
Prelude.quot
    rem :: CInt -> CInt -> CInt
rem             =  CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
Prelude.rem
    stdAssociate :: CInt -> CInt
stdAssociate CInt
x  =  CInt -> CInt
forall a. Num a => a -> a
Prelude.abs CInt
x
    stdUnit :: CInt -> CInt
stdUnit CInt
x       =  if CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then -CInt
1 else CInt
1

instance  EuclideanDomain Int  where
    quot :: Int -> Int -> Int
quot             =  Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.quot
    rem :: Int -> Int -> Int
rem             =  Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.rem
    stdAssociate :: Int -> Int
stdAssociate Int
x  =  Int -> Int
forall a. Num a => a -> a
Prelude.abs Int
x
    stdUnit :: Int -> Int
stdUnit Int
x       =  if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then -Int
1 else Int
1


-- Note: base.Integral has "Real", superclass, which also defines "toRational"
class (Ord a, Ring a, Enum a, EuclideanDomain a) => Integral a  where
    div, mod       :: a -> a -> a
    divMod         :: a -> a -> (a,a)
    toInteger       :: a -> Integer

    a
n `div` a
d      =  a
q  where (a
q,a
_) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
n a
d
    a
n `mod` a
d       =  a
r  where (a
_,a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
n a
d
    divMod a
n a
d     =  if a -> a
forall a. EuclideanDomain a => a -> a
stdUnit a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Group a => a -> a
negate (a -> a
forall a. EuclideanDomain a => a -> a
stdUnit a
d) then (a
qa -> a -> a
forall a. Additive a => a -> a -> a
+a
forall a. Multiplicative a => a
one, a
ra -> a -> a
forall a. Group a => a -> a -> a
-a
d) else (a, a)
qr
      where qr :: (a, a)
qr@(a
q,a
r) = a -> a -> (a, a)
forall a. EuclideanDomain a => a -> a -> (a, a)
quotRem a
n a
d

instance  Integral Integer  where
    div :: Natural -> Natural -> Natural
div      =  Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Natural -> Natural -> Natural
mod       =  Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.mod
    toInteger :: Natural -> Natural
toInteger = Natural -> Natural
forall a. Integral a => a -> Natural
Prelude.toInteger

instance  Integral Int  where
    div :: Int -> Int -> Int
div      =  Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int -> Int -> Int
mod       =  Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.mod
    toInteger :: Int -> Natural
toInteger = Int -> Natural
forall a. Integral a => a -> Natural
Prelude.toInteger

---------------------------------------
-- Data.Ratio.Ratio instances
instance Prelude.Integral a => Additive (Data.Ratio.Ratio a) where
  zero :: Ratio a
zero = Natural -> Ratio a
forall a. Num a => Natural -> a
Prelude.fromInteger Natural
0
  + :: Ratio a -> Ratio a -> Ratio a
(+) = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.+)

instance Prelude.Integral a => AbelianAdditive (Data.Ratio.Ratio a) where

instance Prelude.Integral a => Group (Data.Ratio.Ratio a) where
  negate :: Ratio a -> Ratio a
negate = Ratio a -> Ratio a
forall a. Num a => a -> a
Prelude.negate
  (-) = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.-)

instance Prelude.Integral a => Multiplicative (Data.Ratio.Ratio a) where
  one :: Ratio a
one = Natural -> Ratio a
forall a. Num a => Natural -> a
Prelude.fromInteger Natural
1
  * :: Ratio a -> Ratio a -> Ratio a
(*) = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.*)
  ^+ :: Ratio a -> Natural -> Ratio a
(^+) = Ratio a -> Natural -> Ratio a
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)

instance Prelude.Integral a => Division (Data.Ratio.Ratio a) where
  recip :: Ratio a -> Ratio a
recip = Ratio a -> Ratio a
forall a. Fractional a => a -> a
Prelude.recip
  / :: Ratio a -> Ratio a -> Ratio a
(/) = Ratio a -> Ratio a -> Ratio a
forall a. Fractional a => a -> a -> a
(Prelude./)
  ^ :: Ratio a -> Natural -> Ratio a
(^) = Ratio a -> Natural -> Ratio a
forall a b. (Fractional a, Integral b) => a -> b -> a
(Prelude.^^)
instance Prelude.Integral a => Scalable (Data.Ratio.Ratio a) (Data.Ratio.Ratio a) where
  *^ :: Ratio a -> Ratio a -> Ratio a
(*^) = Ratio a -> Ratio a -> Ratio a
forall a. Multiplicative a => a -> a -> a
(*)
instance Prelude.Integral a => Ring (Data.Ratio.Ratio a) where
  fromInteger :: Natural -> Ratio a
fromInteger = Natural -> Ratio a
forall a. Num a => Natural -> a
Prelude.fromInteger
instance Prelude.Integral a => Field (Data.Ratio.Ratio a) where
  fromRational :: Rational -> Ratio a
fromRational = Rational -> Ratio a
forall a. Fractional a => Rational -> a
Prelude.fromRational

instance Scalable Rational Double where
    Rational
r *^ :: Rational -> Double -> Double
*^ Double
d = Rational -> Double
forall a. Field a => Rational -> a
fromRational Rational
r Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
d

----------------------
-- Complex instances
instance Additive a => Additive (Complex a) where
    (a
x:+a
y) + :: Complex a -> Complex a -> Complex a
+ (a
x':+a
y')   =  (a
xa -> a -> a
forall a. Additive a => a -> a -> a
+a
x') a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
ya -> a -> a
forall a. Additive a => a -> a -> a
+a
y')
    zero :: Complex a
zero = a
forall a. Additive a => a
zero a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
forall a. Additive a => a
zero
instance Ring a => Multiplicative (Complex a) where
    (a
x:+a
y) * :: Complex a -> Complex a -> Complex a
* (a
x':+a
y')   =  (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x'a -> a -> a
forall a. Group a => a -> a -> a
-a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y') a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y'a -> a -> a
forall a. Additive a => a -> a -> a
+a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x')
    one :: Complex a
one = a
forall a. Multiplicative a => a
one a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
forall a. Additive a => a
zero
instance Group a => Group  (Complex a) where
    (a
x:+a
y) - :: Complex a -> Complex a -> Complex a
- (a
x':+a
y')   =  (a
xa -> a -> a
forall a. Group a => a -> a -> a
-a
x') a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
ya -> a -> a
forall a. Group a => a -> a -> a
-a
y')
    negate :: Complex a -> Complex a
negate (a
x:+a
y)       =  a -> a
forall a. Group a => a -> a
negate a
x a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a
forall a. Group a => a -> a
negate a
y
instance AbelianAdditive a => AbelianAdditive (Complex a)
instance Ring a => Scalable (Complex a) (Complex a) where
  *^ :: Complex a -> Complex a -> Complex a
(*^) = Complex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
(*)
instance {-# Overlappable #-} Scalable s a => Scalable s (Complex a) where
  s
s *^ :: s -> Complex a -> Complex a
*^ Complex a
x = (a -> a) -> Complex a -> Complex a
forall a b. (a -> b) -> Complex a -> Complex b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
s s -> a -> a
forall s a. Scalable s a => s -> a -> a
*^) Complex a
x
instance Ring a => Ring (Complex a) where
    fromInteger :: Natural -> Complex a
fromInteger Natural
n  =  Natural -> a
forall a. Ring a => Natural -> a
fromInteger Natural
n a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
forall a. Additive a => a
zero

instance  Field a => Division (Complex a)  where
    {-# SPECIALISE instance Division (Complex Double) #-}
    (a
x:+a
y) / :: Complex a -> Complex a -> Complex a
/ (a
x':+a
y')   =  (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x'a -> a -> a
forall a. Additive a => a -> a -> a
+a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y') a -> a -> a
forall a. Division a => a -> a -> a
/ a
d a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
ya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x'a -> a -> a
forall a. Group a => a -> a -> a
-a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y') a -> a -> a
forall a. Division a => a -> a -> a
/ a
d
      where d :: a
d   = a
x'a -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x' a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y'a -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y'

instance Field a => Field (Complex a) where
    fromRational :: Rational -> Complex a
fromRational Rational
a =  Rational -> a
forall a. Field a => Rational -> a
fromRational Rational
a a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
forall a. Additive a => a
zero

-- Syntax

ifThenElse :: Bool -> t -> t -> t
ifThenElse :: forall t. Bool -> t -> t -> t
ifThenElse Bool
True t
a t
_ = t
a
ifThenElse Bool
False t
_ t
a = t
a


class Division a => Roots a where
  {-# MINIMAL root | (^/) #-}
  sqrt :: a -> a
  sqrt = Natural -> a -> a
forall a. Roots a => Natural -> a -> a
root Natural
2
  {-# INLINE sqrt #-}

  root :: Integer -> a -> a
  root Natural
n a
x = a
x a -> Rational -> a
forall a. Roots a => a -> Rational -> a
^/ (Natural
1 Natural -> Natural -> Rational
forall a. Integral a => a -> a -> Ratio a
Data.Ratio.% Natural
n)

  (^/) :: a -> Rational -> a
  a
x ^/ Rational
y = Natural -> a -> a
forall a. Roots a => Natural -> a -> a
root (Rational -> Natural
forall a. Ratio a -> a
Data.Ratio.denominator Rational
y) (a
x a -> Natural -> a
forall a. Division a => a -> Natural -> a
^ Rational -> Natural
forall a. Ratio a -> a
Data.Ratio.numerator Rational
y)

type Algebraic a = (Roots a, Field a)

instance Roots Float where
  sqrt :: Float -> Float
sqrt = Float -> Float
forall a. Floating a => a -> a
Prelude.sqrt
  Float
x ^/ :: Float -> Rational -> Float
^/ Rational
y = Float
x Float -> Float -> Float
forall a. Transcendental a => a -> a -> a
** Rational -> Float
forall a. Field a => Rational -> a
fromRational Rational
y

instance Roots Double where
  sqrt :: Double -> Double
sqrt = Double -> Double
forall a. Floating a => a -> a
Prelude.sqrt
  Double
x ^/ :: Double -> Rational -> Double
^/ Rational
y = Double
x Double -> Double -> Double
forall a. Transcendental a => a -> a -> a
** Rational -> Double
forall a. Field a => Rational -> a
fromRational Rational
y

-- | Class providing transcendental functions
class Algebraic a => Transcendental a where 
    pi                  :: a
    exp, log            :: a -> a
    (**), logBase       :: a -> a -> a
    sin, cos, tan       :: a -> a
    asin, acos, atan    :: a -> a
    sinh, cosh, tanh    :: a -> a
    asinh, acosh, atanh :: a -> a

    -- | @'log1p' x@ computes @'log' (1 + x)@, but provides more precise
    -- results for small (absolute) values of @x@ if possible.
    --
    -- @since 4.9.0.0
    log1p               :: a -> a

    -- | @'expm1' x@ computes @'exp' x - 1@, but provides more precise
    -- results for small (absolute) values of @x@ if possible.
    --
    -- @since 4.9.0.0
    expm1               :: a -> a

    -- | @'log1pexp' x@ computes @'log' (1 + 'exp' x)@, but provides more
    -- precise results if possible.
    --
    -- Examples:
    --
    -- * if @x@ is a large negative number, @'log' (1 + 'exp' x)@ will be
    --   imprecise for the reasons given in 'log1p'.
    --
    -- * if @'exp' x@ is close to @-1@, @'log' (1 + 'exp' x)@ will be
    --   imprecise for the reasons given in 'expm1'.
    --
    -- @since 4.9.0.0
    log1pexp            :: a -> a

    -- | @'log1mexp' x@ computes @'log' (1 - 'exp' x)@, but provides more
    -- precise results if possible.
    --
    -- Examples:
    --
    -- * if @x@ is a large negative number, @'log' (1 - 'exp' x)@ will be
    --   imprecise for the reasons given in 'log1p'.
    --
    -- * if @'exp' x@ is close to @1@, @'log' (1 - 'exp' x)@ will be
    --   imprecise for the reasons given in 'expm1'.
    --
    -- @since 4.9.0.0
    log1mexp            :: a -> a

    {-# INLINE (**) #-}
    {-# INLINE logBase #-}
    {-# INLINE tan #-}
    {-# INLINE tanh #-}
    a
x ** a
y              =  a -> a
forall a. Transcendental a => a -> a
exp (a -> a
forall a. Transcendental a => a -> a
log a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y)
    logBase a
x a
y         =  a -> a
forall a. Transcendental a => a -> a
log a
y a -> a -> a
forall a. Division a => a -> a -> a
/ a -> a
forall a. Transcendental a => a -> a
log a
x
    tan  a
x              =  a -> a
forall a. Transcendental a => a -> a
sin  a
x a -> a -> a
forall a. Division a => a -> a -> a
/ a -> a
forall a. Transcendental a => a -> a
cos  a
x
    tanh a
x              =  a -> a
forall a. Transcendental a => a -> a
sinh a
x a -> a -> a
forall a. Division a => a -> a -> a
/ a -> a
forall a. Transcendental a => a -> a
cosh a
x

    {-# INLINE log1p #-}
    {-# INLINE expm1 #-}
    {-# INLINE log1pexp #-}
    {-# INLINE log1mexp #-}
    log1p a
x = a -> a
forall a. Transcendental a => a -> a
log (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x)
    expm1 a
x = a -> a
forall a. Transcendental a => a -> a
exp a
x a -> a -> a
forall a. Group a => a -> a -> a
- a
forall a. Multiplicative a => a
one
    log1pexp a
x = a -> a
forall a. Transcendental a => a -> a
log1p (a -> a
forall a. Transcendental a => a -> a
exp a
x)
    log1mexp a
x = a -> a
forall a. Transcendental a => a -> a
log1p (a -> a
forall a. Group a => a -> a
negate (a -> a
forall a. Transcendental a => a -> a
exp a
x))

(^?) :: Transcendental a => a -> a -> a
^? :: forall a. Transcendental a => a -> a -> a
(^?) = a -> a -> a
forall a. Transcendental a => a -> a -> a
(**)

instance Transcendental Double where
  pi :: Double
pi = Double
forall a. Floating a => a
Prelude.pi
  exp :: Double -> Double
exp = Double -> Double
forall a. Floating a => a -> a
Prelude.exp
  log :: Double -> Double
log = Double -> Double
forall a. Floating a => a -> a
Prelude.log
  ** :: Double -> Double -> Double
(**) = Double -> Double -> Double
forall a. Floating a => a -> a -> a
(Prelude.**)
  logBase :: Double -> Double -> Double
logBase = Double -> Double -> Double
forall a. Floating a => a -> a -> a
Prelude.logBase
  sin :: Double -> Double
sin = Double -> Double
forall a. Floating a => a -> a
Prelude.sin
  cos :: Double -> Double
cos = Double -> Double
forall a. Floating a => a -> a
Prelude.cos
  tan :: Double -> Double
tan = Double -> Double
forall a. Floating a => a -> a
Prelude.tan
  asin :: Double -> Double
asin = Double -> Double
forall a. Floating a => a -> a
Prelude.asin
  acos :: Double -> Double
acos = Double -> Double
forall a. Floating a => a -> a
Prelude.acos
  atan :: Double -> Double
atan = Double -> Double
forall a. Floating a => a -> a
Prelude.atan
  sinh :: Double -> Double
sinh = Double -> Double
forall a. Floating a => a -> a
Prelude.sinh
  cosh :: Double -> Double
cosh = Double -> Double
forall a. Floating a => a -> a
Prelude.cosh
  tanh :: Double -> Double
tanh = Double -> Double
forall a. Floating a => a -> a
Prelude.tanh
  asinh :: Double -> Double
asinh = Double -> Double
forall a. Floating a => a -> a
Prelude.asinh
  acosh :: Double -> Double
acosh = Double -> Double
forall a. Floating a => a -> a
Prelude.acosh
  atanh :: Double -> Double
atanh = Double -> Double
forall a. Floating a => a -> a
Prelude.atanh

instance Transcendental Float where
  pi :: Float
pi = Float
forall a. Floating a => a
Prelude.pi
  exp :: Float -> Float
exp = Float -> Float
forall a. Floating a => a -> a
Prelude.exp
  log :: Float -> Float
log = Float -> Float
forall a. Floating a => a -> a
Prelude.log
  ** :: Float -> Float -> Float
(**) = Float -> Float -> Float
forall a. Floating a => a -> a -> a
(Prelude.**)
  logBase :: Float -> Float -> Float
logBase = Float -> Float -> Float
forall a. Floating a => a -> a -> a
Prelude.logBase
  sin :: Float -> Float
sin = Float -> Float
forall a. Floating a => a -> a
Prelude.sin
  cos :: Float -> Float
cos = Float -> Float
forall a. Floating a => a -> a
Prelude.cos
  tan :: Float -> Float
tan = Float -> Float
forall a. Floating a => a -> a
Prelude.tan
  asin :: Float -> Float
asin = Float -> Float
forall a. Floating a => a -> a
Prelude.asin
  acos :: Float -> Float
acos = Float -> Float
forall a. Floating a => a -> a
Prelude.acos
  atan :: Float -> Float
atan = Float -> Float
forall a. Floating a => a -> a
Prelude.atan
  sinh :: Float -> Float
sinh = Float -> Float
forall a. Floating a => a -> a
Prelude.sinh
  cosh :: Float -> Float
cosh = Float -> Float
forall a. Floating a => a -> a
Prelude.cosh
  tanh :: Float -> Float
tanh = Float -> Float
forall a. Floating a => a -> a
Prelude.tanh
  asinh :: Float -> Float
asinh = Float -> Float
forall a. Floating a => a -> a
Prelude.asinh
  acosh :: Float -> Float
acosh = Float -> Float
forall a. Floating a => a -> a
Prelude.acosh
  atanh :: Float -> Float
atanh = Float -> Float
forall a. Floating a => a -> a
Prelude.atanh



instance (Prelude.RealFloat a, Ord a, Algebraic a) => Roots (Complex a) where
    root :: Natural -> Complex a -> Complex a
root Natural
n Complex a
x = a -> a -> Complex a
forall a. Floating a => a -> a -> Complex a
mkPolar (Natural -> a -> a
forall a. Roots a => Natural -> a -> a
root Natural
n a
ρ) (a
θ a -> a -> a
forall a. Division a => a -> a -> a
/ Natural -> a
forall a. Ring a => Natural -> a
fromInteger Natural
n)
      where (a
ρ,a
θ) = Complex a -> (a, a)
forall a. RealFloat a => Complex a -> (a, a)
polar Complex a
x
    sqrt :: Complex a -> Complex a
sqrt z :: Complex a
z@(a
x:+a
y)
      | Complex a
z Complex a -> Complex a -> Bool
forall a. Eq a => a -> a -> Bool
== Complex a
forall a. Additive a => a
zero = Complex a
forall a. Additive a => a
zero
      | Bool
otherwise 
                     =  a
u a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (if a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then -a
v else a
v)
                      where (a
u,a
v) = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then (a
v',a
u') else (a
u',a
v')
                            v' :: a
v'    = a -> a
forall a. Num a => a -> a
Prelude.abs a
y a -> a -> a
forall a. Division a => a -> a -> a
/ (a
u'a -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
2)
                            u' :: a
u'    = a -> a
forall a. Roots a => a -> a
sqrt ((Complex a -> a
forall a. RealFloat a => Complex a -> a
magnitude Complex a
z a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. Num a => a -> a
Prelude.abs a
x) a -> a -> a
forall a. Division a => a -> a -> a
/ a
2)


instance  (Prelude.RealFloat a, Transcendental a) => AlgebraicallyClosed (Complex a) where
  imaginaryUnit :: Complex a
imaginaryUnit = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
1
  rootOfUnity :: Natural -> Natural -> Complex a
rootOfUnity Natural
n Natural
i = Complex a -> Complex a
forall a. Transcendental a => a -> a
exp (a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
2a -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
forall a. Transcendental a => a
pia -> a -> a
forall a. Multiplicative a => a -> a -> a
*Natural -> a
forall a. Ring a => Natural -> a
fromInteger Natural
ia -> a -> a
forall a. Division a => a -> a -> a
/Natural -> a
forall a. Ring a => Natural -> a
fromInteger Natural
n)
  

instance  (Prelude.RealFloat a, Transcendental a) => Transcendental (Complex a) where
    {-# SPECIALISE instance Transcendental (Complex Float) #-}
    {-# SPECIALISE instance Transcendental (Complex Double) #-}
    pi :: Complex a
pi             =  a
forall a. Transcendental a => a
pi a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
    exp :: Complex a -> Complex a
exp (a
x:+a
y)     =  a
expx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
cos a
y a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
expx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
sin a
y
                      where expx :: a
expx = a -> a
forall a. Transcendental a => a -> a
exp a
x
    log :: Complex a -> Complex a
log Complex a
z          =  a -> a
forall a. Transcendental a => a -> a
log (Complex a -> a
forall a. RealFloat a => Complex a -> a
magnitude Complex a
z) a -> a -> Complex a
forall a. a -> a -> Complex a
:+ Complex a -> a
forall a. RealFloat a => Complex a -> a
phase Complex a
z

    Complex a
x ** :: Complex a -> Complex a -> Complex a
** Complex a
y = case (Complex a
x,Complex a
y) of
      (Complex a
_ , (a
0:+a
0))  -> a
1 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
      ((a
0:+a
0), (a
exp_re:+a
_)) -> case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
exp_re a
0 of
                 Ordering
GT -> a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
                 Ordering
LT -> a
inf a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
                 Ordering
EQ -> a
nan a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
nan
      ((a
re:+a
im), (a
exp_re:+a
_))
        | (a -> Bool
forall a. RealFloat a => a -> Bool
Prelude.isInfinite a
re Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
Prelude.isInfinite a
im) -> case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
exp_re a
0 of
                 Ordering
GT -> a
inf a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
                 Ordering
LT -> a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
                 Ordering
EQ -> a
nan a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
nan
        | Bool
otherwise -> Complex a -> Complex a
forall a. Transcendental a => a -> a
exp (Complex a -> Complex a
forall a. Transcendental a => a -> a
log Complex a
x Complex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
* Complex a
y)
      where
        inf :: a
inf = a
1a -> a -> a
forall a. Division a => a -> a -> a
/a
0
        nan :: a
nan = a
0a -> a -> a
forall a. Division a => a -> a -> a
/a
0

    sin :: Complex a -> Complex a
sin (a
x:+a
y)     =  a -> a
forall a. Transcendental a => a -> a
sin a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
cosh a
y a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a
forall a. Transcendental a => a -> a
cos a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
sinh a
y
    cos :: Complex a -> Complex a
cos (a
x:+a
y)     =  a -> a
forall a. Transcendental a => a -> a
cos a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
cosh a
y a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (- a -> a
forall a. Transcendental a => a -> a
sin a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
sinh a
y)
    tan :: Complex a -> Complex a
tan (a
x:+a
y)     =  (a
sinxa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
coshya -> a -> Complex a
forall a. a -> a -> Complex a
:+a
cosxa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
sinhy)Complex a -> Complex a -> Complex a
forall a. Division a => a -> a -> a
/(a
cosxa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
coshya -> a -> Complex a
forall a. a -> a -> Complex a
:+(-a
sinxa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
sinhy))
                      where sinx :: a
sinx  = a -> a
forall a. Transcendental a => a -> a
sin a
x
                            cosx :: a
cosx  = a -> a
forall a. Transcendental a => a -> a
cos a
x
                            sinhy :: a
sinhy = a -> a
forall a. Transcendental a => a -> a
sinh a
y
                            coshy :: a
coshy = a -> a
forall a. Transcendental a => a -> a
cosh a
y

    sinh :: Complex a -> Complex a
sinh (a
x:+a
y)    =  a -> a
forall a. Transcendental a => a -> a
cos a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
sinh a
x a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a
forall a. Transcendental a => a -> a
sin  a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
cosh a
x
    cosh :: Complex a -> Complex a
cosh (a
x:+a
y)    =  a -> a
forall a. Transcendental a => a -> a
cos a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
cosh a
x a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a
forall a. Transcendental a => a -> a
sin a
y a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Transcendental a => a -> a
sinh a
x
    tanh :: Complex a -> Complex a
tanh (a
x:+a
y)    =  (a
cosya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
sinhxa -> a -> Complex a
forall a. a -> a -> Complex a
:+a
sinya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
coshx)Complex a -> Complex a -> Complex a
forall a. Division a => a -> a -> a
/(a
cosya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
coshxa -> a -> Complex a
forall a. a -> a -> Complex a
:+a
sinya -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
sinhx)
                      where siny :: a
siny  = a -> a
forall a. Transcendental a => a -> a
sin a
y
                            cosy :: a
cosy  = a -> a
forall a. Transcendental a => a -> a
cos a
y
                            sinhx :: a
sinhx = a -> a
forall a. Transcendental a => a -> a
sinh a
x
                            coshx :: a
coshx = a -> a
forall a. Transcendental a => a -> a
cosh a
x

    asin :: Complex a -> Complex a
asin z :: Complex a
z@(a
x:+a
y)  =  a
y'a -> a -> Complex a
forall a. a -> a -> Complex a
:+(-a
x')
                      where  (a
x':+a
y') = Complex a -> Complex a
forall a. Transcendental a => a -> a
log (((-a
y)a -> a -> Complex a
forall a. a -> a -> Complex a
:+a
x) Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+ Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
1 Complex a -> Complex a -> Complex a
forall a. Group a => a -> a -> a
- Complex a
zComplex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
*Complex a
z))
    acos :: Complex a -> Complex a
acos Complex a
z         =  a
y''a -> a -> Complex a
forall a. a -> a -> Complex a
:+(-a
x'')
                      where (a
x'':+a
y'') = Complex a -> Complex a
forall a. Transcendental a => a -> a
log (Complex a
z Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+ ((-a
y')a -> a -> Complex a
forall a. a -> a -> Complex a
:+a
x'))
                            (a
x':+a
y')   = Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
1 Complex a -> Complex a -> Complex a
forall a. Group a => a -> a -> a
- Complex a
zComplex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
*Complex a
z)
    atan :: Complex a -> Complex a
atan z :: Complex a
z@(a
x:+a
y)  =  a
y'a -> a -> Complex a
forall a. a -> a -> Complex a
:+(-a
x')
                      where (a
x':+a
y') = Complex a -> Complex a
forall a. Transcendental a => a -> a
log (((a
1a -> a -> a
forall a. Group a => a -> a -> a
-a
y)a -> a -> Complex a
forall a. a -> a -> Complex a
:+a
x) Complex a -> Complex a -> Complex a
forall a. Division a => a -> a -> a
/ Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
1Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+Complex a
zComplex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
*Complex a
z))

    asinh :: Complex a -> Complex a
asinh Complex a
z        =  Complex a -> Complex a
forall a. Transcendental a => a -> a
log (Complex a
z Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+ Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
1Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+Complex a
zComplex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
*Complex a
z))
    -- Take care to allow (-1)::Complex, fixing #8532
    acosh :: Complex a -> Complex a
acosh Complex a
z        =  Complex a -> Complex a
forall a. Transcendental a => a -> a
log (Complex a
z Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+ (Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
zComplex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+Complex a
1)) Complex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
* (Complex a -> Complex a
forall a. Roots a => a -> a
sqrt (Complex a
zComplex a -> Complex a -> Complex a
forall a. Group a => a -> a -> a
-Complex a
1)))
    atanh :: Complex a -> Complex a
atanh Complex a
z        =  Complex a
0.5 Complex a -> Complex a -> Complex a
forall a. Multiplicative a => a -> a -> a
* Complex a -> Complex a
forall a. Transcendental a => a -> a
log ((Complex a
1.0Complex a -> Complex a -> Complex a
forall a. Additive a => a -> a -> a
+Complex a
z) Complex a -> Complex a -> Complex a
forall a. Division a => a -> a -> a
/ (Complex a
1.0Complex a -> Complex a -> Complex a
forall a. Group a => a -> a -> a
-Complex a
z))


class Algebraic a => AlgebraicallyClosed a where
  imaginaryUnit :: a
  imaginaryUnit = Natural -> Natural -> a
forall a. AlgebraicallyClosed a => Natural -> Natural -> a
rootOfUnity Natural
2 Natural
1
  -- | rootOfUnity n give the nth roots of unity. The 2nd argument specifies which one is demanded
  rootOfUnity :: Integer -> Integer -> a

----------------
-- The following should go in Morphism.Monoids but sum/product depend on it.

newtype Sum a = Sum {forall a. Sum a -> a
fromSum :: a} deriving ((forall x. Sum a -> Rep (Sum a) x)
-> (forall x. Rep (Sum a) x -> Sum a) -> Generic (Sum a)
forall x. Rep (Sum a) x -> Sum a
forall x. Sum a -> Rep (Sum a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Sum a) x -> Sum a
forall a x. Sum a -> Rep (Sum a) x
$cfrom :: forall a x. Sum a -> Rep (Sum a) x
from :: forall x. Sum a -> Rep (Sum a) x
$cto :: forall a x. Rep (Sum a) x -> Sum a
to :: forall x. Rep (Sum a) x -> Sum a
Generic,Eq (Sum a)
Eq (Sum a) =>
(Sum a -> Sum a -> Ordering)
-> (Sum a -> Sum a -> Bool)
-> (Sum a -> Sum a -> Bool)
-> (Sum a -> Sum a -> Bool)
-> (Sum a -> Sum a -> Bool)
-> (Sum a -> Sum a -> Sum a)
-> (Sum a -> Sum a -> Sum a)
-> Ord (Sum a)
Sum a -> Sum a -> Bool
Sum a -> Sum a -> Ordering
Sum a -> Sum a -> Sum a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Sum a)
forall a. Ord a => Sum a -> Sum a -> Bool
forall a. Ord a => Sum a -> Sum a -> Ordering
forall a. Ord a => Sum a -> Sum a -> Sum a
$ccompare :: forall a. Ord a => Sum a -> Sum a -> Ordering
compare :: Sum a -> Sum a -> Ordering
$c< :: forall a. Ord a => Sum a -> Sum a -> Bool
< :: Sum a -> Sum a -> Bool
$c<= :: forall a. Ord a => Sum a -> Sum a -> Bool
<= :: Sum a -> Sum a -> Bool
$c> :: forall a. Ord a => Sum a -> Sum a -> Bool
> :: Sum a -> Sum a -> Bool
$c>= :: forall a. Ord a => Sum a -> Sum a -> Bool
>= :: Sum a -> Sum a -> Bool
$cmax :: forall a. Ord a => Sum a -> Sum a -> Sum a
max :: Sum a -> Sum a -> Sum a
$cmin :: forall a. Ord a => Sum a -> Sum a -> Sum a
min :: Sum a -> Sum a -> Sum a
Ord,Sum a -> Sum a -> Bool
(Sum a -> Sum a -> Bool) -> (Sum a -> Sum a -> Bool) -> Eq (Sum a)
forall a. Eq a => Sum a -> Sum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Sum a -> Sum a -> Bool
== :: Sum a -> Sum a -> Bool
$c/= :: forall a. Eq a => Sum a -> Sum a -> Bool
/= :: Sum a -> Sum a -> Bool
Eq,Int -> Sum a -> [Char] -> [Char]
[Sum a] -> [Char] -> [Char]
Sum a -> [Char]
(Int -> Sum a -> [Char] -> [Char])
-> (Sum a -> [Char])
-> ([Sum a] -> [Char] -> [Char])
-> Show (Sum a)
forall a. Show a => Int -> Sum a -> [Char] -> [Char]
forall a. Show a => [Sum a] -> [Char] -> [Char]
forall a. Show a => Sum a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Sum a -> [Char] -> [Char]
showsPrec :: Int -> Sum a -> [Char] -> [Char]
$cshow :: forall a. Show a => Sum a -> [Char]
show :: Sum a -> [Char]
$cshowList :: forall a. Show a => [Sum a] -> [Char] -> [Char]
showList :: [Sum a] -> [Char] -> [Char]
Show)

instance Binary a => Binary (Sum a)

instance Additive a => Monoid (Sum a) where
  mempty :: Sum a
mempty = a -> Sum a
forall a. a -> Sum a
Sum a
forall a. Additive a => a
zero
  mappend :: Sum a -> Sum a -> Sum a
mappend = Sum a -> Sum a -> Sum a
forall a. Semigroup a => a -> a -> a
(<>)

instance Additive a => Semigroup (Sum a) where
  <> :: Sum a -> Sum a -> Sum a
(<>) (Sum a
x) (Sum a
y) = a -> Sum a
forall a. a -> Sum a
Sum (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y)


newtype Product a = Product {forall a. Product a -> a
fromProduct :: a} deriving ((forall x. Product a -> Rep (Product a) x)
-> (forall x. Rep (Product a) x -> Product a)
-> Generic (Product a)
forall x. Rep (Product a) x -> Product a
forall x. Product a -> Rep (Product a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Product a) x -> Product a
forall a x. Product a -> Rep (Product a) x
$cfrom :: forall a x. Product a -> Rep (Product a) x
from :: forall x. Product a -> Rep (Product a) x
$cto :: forall a x. Rep (Product a) x -> Product a
to :: forall x. Rep (Product a) x -> Product a
Generic,Eq (Product a)
Eq (Product a) =>
(Product a -> Product a -> Ordering)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Product a)
-> (Product a -> Product a -> Product a)
-> Ord (Product a)
Product a -> Product a -> Bool
Product a -> Product a -> Ordering
Product a -> Product a -> Product a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Product a)
forall a. Ord a => Product a -> Product a -> Bool
forall a. Ord a => Product a -> Product a -> Ordering
forall a. Ord a => Product a -> Product a -> Product a
$ccompare :: forall a. Ord a => Product a -> Product a -> Ordering
compare :: Product a -> Product a -> Ordering
$c< :: forall a. Ord a => Product a -> Product a -> Bool
< :: Product a -> Product a -> Bool
$c<= :: forall a. Ord a => Product a -> Product a -> Bool
<= :: Product a -> Product a -> Bool
$c> :: forall a. Ord a => Product a -> Product a -> Bool
> :: Product a -> Product a -> Bool
$c>= :: forall a. Ord a => Product a -> Product a -> Bool
>= :: Product a -> Product a -> Bool
$cmax :: forall a. Ord a => Product a -> Product a -> Product a
max :: Product a -> Product a -> Product a
$cmin :: forall a. Ord a => Product a -> Product a -> Product a
min :: Product a -> Product a -> Product a
Ord,Product a -> Product a -> Bool
(Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool) -> Eq (Product a)
forall a. Eq a => Product a -> Product a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Product a -> Product a -> Bool
== :: Product a -> Product a -> Bool
$c/= :: forall a. Eq a => Product a -> Product a -> Bool
/= :: Product a -> Product a -> Bool
Eq,Int -> Product a -> [Char] -> [Char]
[Product a] -> [Char] -> [Char]
Product a -> [Char]
(Int -> Product a -> [Char] -> [Char])
-> (Product a -> [Char])
-> ([Product a] -> [Char] -> [Char])
-> Show (Product a)
forall a. Show a => Int -> Product a -> [Char] -> [Char]
forall a. Show a => [Product a] -> [Char] -> [Char]
forall a. Show a => Product a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Product a -> [Char] -> [Char]
showsPrec :: Int -> Product a -> [Char] -> [Char]
$cshow :: forall a. Show a => Product a -> [Char]
show :: Product a -> [Char]
$cshowList :: forall a. Show a => [Product a] -> [Char] -> [Char]
showList :: [Product a] -> [Char] -> [Char]
Show)

instance Multiplicative a => Semigroup (Product a) where
  <> :: Product a -> Product a -> Product a
(<>) (Product a
x) (Product a
y) = a -> Product a
forall a. a -> Product a
Product (a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y)

instance Multiplicative a => Monoid (Product a) where
  mempty :: Product a
mempty = a -> Product a
forall a. a -> Product a
Product a
forall a. Multiplicative a => a
one
  mappend :: Product a -> Product a -> Product a
mappend = Product a -> Product a -> Product a
forall a. Semigroup a => a -> a -> a
(<>)

---------------------
-- Functor application, useful for "deriving via".

newtype App f x = App (f x) deriving ((forall a b. (a -> b) -> App f a -> App f b)
-> (forall a b. a -> App f b -> App f a) -> Functor (App f)
forall a b. a -> App f b -> App f a
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => a -> App f b -> App f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> App f a -> App f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> App f a -> App f b
fmap :: forall a b. (a -> b) -> App f a -> App f b
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> App f b -> App f a
<$ :: forall a b. a -> App f b -> App f a
Functor, Functor (App f)
Functor (App f) =>
(forall a. a -> App f a)
-> (forall a b. App f (a -> b) -> App f a -> App f b)
-> (forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c)
-> (forall a b. App f a -> App f b -> App f b)
-> (forall a b. App f a -> App f b -> App f a)
-> Applicative (App f)
forall a. a -> App f a
forall a b. App f a -> App f b -> App f a
forall a b. App f a -> App f b -> App f b
forall a b. App f (a -> b) -> App f a -> App f b
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (App f)
forall (f :: * -> *) a. Applicative f => a -> App f a
forall (f :: * -> *) a b.
Applicative f =>
App f a -> App f b -> App f a
forall (f :: * -> *) a b.
Applicative f =>
App f a -> App f b -> App f b
forall (f :: * -> *) a b.
Applicative f =>
App f (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> App f a -> App f b -> App f c
$cpure :: forall (f :: * -> *) a. Applicative f => a -> App f a
pure :: forall a. a -> App f a
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
App f (a -> b) -> App f a -> App f b
<*> :: forall a b. App f (a -> b) -> App f a -> App f b
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> App f a -> App f b -> App f c
liftA2 :: forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
App f a -> App f b -> App f b
*> :: forall a b. App f a -> App f b -> App f b
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
App f a -> App f b -> App f a
<* :: forall a b. App f a -> App f b -> App f a
Applicative) -- should be somewhere in base but can't find it.

instance (Applicative f, AbelianAdditive a) => AbelianAdditive (App f a) where
instance (Applicative f, Additive a) => Additive (App f a) where
  + :: App f a -> App f a -> App f a
(+) = (a -> a -> a) -> App f a -> App f a -> App f a
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Additive a => a -> a -> a
(+)
  zero :: App f a
zero = a -> App f a
forall a. a -> App f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Additive a => a
zero
instance (Applicative f, Group a) => Group (App f a) where
  (-) = (a -> a -> a) -> App f a -> App f a -> App f a
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  negate :: App f a -> App f a
negate = (a -> a) -> App f a -> App f a
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Group a => a -> a
negate

instance (Applicative f, Multiplicative a) => Multiplicative (App f a) where
  * :: App f a -> App f a -> App f a
(*) = (a -> a -> a) -> App f a -> App f a -> App f a
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*)
  one :: App f a
one = a -> App f a
forall a. a -> App f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Multiplicative a => a
one

instance (Applicative f, Scalable s a) =>  Scalable (App f s) (App f a) where
  *^ :: App f s -> App f a -> App f a
(*^) = (s -> a -> a) -> App f s -> App f a -> App f a
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 s -> a -> a
forall s a. Scalable s a => s -> a -> a
(*^)

instance (Applicative f, Division s) => Division (App f s) where
  recip :: App f s -> App f s
recip = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Division a => a -> a
recip
  / :: App f s -> App f s -> App f s
(/) = (s -> s -> s) -> App f s -> App f s -> App f s
forall a b c. (a -> b -> c) -> App f a -> App f b -> App f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 s -> s -> s
forall a. Division a => a -> a -> a
(/)

instance (Applicative f, Roots s) => Roots (App f s) where
  App f s
x ^/ :: App f s -> Rational -> App f s
^/ Rational
r = (s -> Rational -> s
forall a. Roots a => a -> Rational -> a
^/ Rational
r) (s -> s) -> App f s -> App f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App f s
x
  root :: Natural -> App f s -> App f s
root Natural
i = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural -> s -> s
forall a. Roots a => Natural -> a -> a
root Natural
i)

instance (Applicative f, Field s) => Field (App f s) where
  fromRational :: Rational -> App f s
fromRational Rational
x = s -> App f s
forall a. a -> App f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> s
forall a. Field a => Rational -> a
fromRational Rational
x)
  
instance (Applicative f, Transcendental s) => Transcendental (App f s) where
  pi :: App f s
pi = s -> App f s
forall a. a -> App f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
forall a. Transcendental a => a
pi
  exp :: App f s -> App f s
exp = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
exp
  log :: App f s -> App f s
log = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
log 
  sin :: App f s -> App f s
sin = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
sin 
  cos :: App f s -> App f s
cos = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
cos 
  asin :: App f s -> App f s
asin = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
asin 
  acos :: App f s -> App f s
acos = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
acos 
  atan :: App f s -> App f s
atan = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
atan 
  sinh :: App f s -> App f s
sinh = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
sinh 
  cosh :: App f s -> App f s
cosh = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
cosh 
  asinh :: App f s -> App f s
asinh = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
asinh 
  acosh :: App f s -> App f s
acosh = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
acosh 
  atanh :: App f s -> App f s
atanh = (s -> s) -> App f s -> App f s
forall a b. (a -> b) -> App f a -> App f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
forall a. Transcendental a => a -> a
atanh 
  
instance (Applicative f, Ring a) => Ring (App f a) where
  fromInteger :: Natural -> App f a
fromInteger Natural
x = a -> App f a
forall a. a -> App f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> a
forall a. Ring a => Natural -> a
fromInteger Natural
x)