```{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies                   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | This Library provides some *dangerous* instances for @Double@s and @Complex@.
module Algebra.Instances () where
import Algebra.Scalar

import           AlgebraicPrelude
import           Control.DeepSeq       (NFData (..))
import           Control.Monad.Random  (Random (..), getRandom)
import           Control.Monad.Random  (getRandomR, runRand)
import           Data.Complex          (Complex (..))
import           Data.Convertible.Base (Convertible (..))
import qualified Data.Ratio            as P
import qualified Data.Vector           as DV
import           Data.Vector.Instances ()
import qualified Numeric.Algebra       as NA
import qualified Prelude               as P

instance Additive r => Additive (DV.Vector r) where
+ :: Vector r -> Vector r -> Vector r
(+) = (r -> r -> r) -> Vector r -> Vector r -> Vector r
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
DV.zipWith r -> r -> r
forall r. Additive r => r -> r -> r
(+)

-- | These Instances are not algebraically right, but for the sake of convenience.
instance DecidableZero r => DecidableZero (Complex r) where
isZero :: Complex r -> Bool
isZero (r
a :+ r
b) = r -> Bool
forall r. DecidableZero r => r -> Bool
isZero r
a Bool -> Bool -> Bool
&& r -> Bool
forall r. DecidableZero r => r -> Bool
isZero r
b

instance (NFData a) => NFData (Fraction a) where
rnf :: Fraction a -> ()
rnf Fraction a
a = a -> ()
forall a. NFData a => a -> ()
rnf (Fraction a -> a
forall t. Fraction t -> t
numerator Fraction a
a) () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf (Fraction a -> a
forall t. Fraction t -> t
denominator Fraction a
a) () -> () -> ()
`seq` ()

instance Additive r => Additive (Complex r) where
(r
a :+ r
b) + :: Complex r -> Complex r -> Complex r
+ (r
c :+ r
d) = (r
a r -> r -> r
forall r. Additive r => r -> r -> r
+ r
c) r -> r -> Complex r
forall a. a -> a -> Complex a
:+ (r
b r -> r -> r
forall r. Additive r => r -> r -> r
+ r
d)
instance Abelian r => Abelian (Complex r) where
instance (Group r, Semiring r) => Semiring (Complex r) where
instance (Group r, Rig r) => Rig (Complex r) where
fromNatural :: Natural -> Complex r
fromNatural = (r -> r -> Complex r
forall a. a -> a -> Complex a
:+ r
forall m. Monoidal m => m
zero) (r -> Complex r) -> (Natural -> r) -> Natural -> Complex r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> r
forall r. Rig r => Natural -> r
fromNatural
instance (Group r, Commutative r) => Commutative (Complex r) where
instance Ring r => Ring (Complex r) where
fromInteger :: Integer -> Complex r
fromInteger = (r -> r -> Complex r
forall a. a -> a -> Complex a
:+ r
forall m. Monoidal m => m
zero) (r -> Complex r) -> (Integer -> r) -> Integer -> Complex r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> r
forall r. Ring r => Integer -> r
fromInteger'
instance Group r => Group (Complex r) where
(r
a :+ r
b) - :: Complex r -> Complex r -> Complex r
- (r
c :+ r
d) = (r
a r -> r -> r
forall r. Group r => r -> r -> r
- r
c) r -> r -> Complex r
forall a. a -> a -> Complex a
:+ (r
b r -> r -> r
forall r. Group r => r -> r -> r
- r
d)
negate :: Complex r -> Complex r
negate (r
a :+ r
b) = r -> r
forall r. Group r => r -> r
negate r
a r -> r -> Complex r
forall a. a -> a -> Complex a
:+ r -> r
forall r. Group r => r -> r
negate r
b
times :: n -> Complex r -> Complex r
times n
n (r
a :+ r
b) = n -> r -> r
forall r n. (Group r, Integral n) => n -> r -> r
times n
n r
a r -> r -> Complex r
forall a. a -> a -> Complex a
:+ n -> r -> r
forall r n. (Group r, Integral n) => n -> r -> r
times n
n r
b
instance LeftModule a r => LeftModule a (Complex r) where
a
r .* :: a -> Complex r -> Complex r
.* (r
a :+ r
b) = (a
r a -> r -> r
forall r m. LeftModule r m => r -> m -> m
.* r
a) r -> r -> Complex r
forall a. a -> a -> Complex a
:+ (a
r a -> r -> r
forall r m. LeftModule r m => r -> m -> m
.* r
b)
instance RightModule a r => RightModule a (Complex r) where
(r
a :+ r
b) *. :: Complex r -> a -> Complex r
*. a
r = (r
a r -> a -> r
forall r m. RightModule r m => m -> r -> m
*. a
r) r -> r -> Complex r
forall a. a -> a -> Complex a
:+ (r
b r -> a -> r
forall r m. RightModule r m => m -> r -> m
*. a
r)
instance Monoidal r => Monoidal (Complex r) where
zero :: Complex r
zero = r
forall m. Monoidal m => m
zero r -> r -> Complex r
forall a. a -> a -> Complex a
:+ r
forall m. Monoidal m => m
zero
instance (Group r, Monoidal r, Unital r) => Unital (Complex r) where
one :: Complex r
one = r
forall r. Unital r => r
one r -> r -> Complex r
forall a. a -> a -> Complex a
:+ r
forall m. Monoidal m => m
zero
instance Additive Double where
+ :: Double -> Double -> Double
(+) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.+)
instance (Group r, Multiplicative r) => Multiplicative (Complex r) where
(r
a :+ r
b) * :: Complex r -> Complex r -> Complex r
* (r
c :+ r
d) = (r
ar -> r -> r
forall r. Multiplicative r => r -> r -> r
*r
c r -> r -> r
forall r. Group r => r -> r -> r
- r
br -> r -> r
forall r. Multiplicative r => r -> r -> r
*r
d) r -> r -> Complex r
forall a. a -> a -> Complex a
:+ (r
ar -> r -> r
forall r. Multiplicative r => r -> r -> r
*r
d r -> r -> r
forall r. Additive r => r -> r -> r
+ r
br -> r -> r
forall r. Multiplicative r => r -> r -> r
*r
c)
instance LeftModule Natural Double where
Natural
n .* :: Natural -> Double -> Double
.* Double
d = Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n Double -> Double -> Double
forall a. Num a => a -> a -> a
P.* Double
d
instance RightModule Natural Double where
Double
d *. :: Double -> Natural -> Double
*. Natural
n = Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
P.* Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n
instance Monoidal Double where
zero :: Double
zero = Double
0
instance Unital Double where
one :: Double
one = Double
1
instance Multiplicative Double where
* :: Double -> Double -> Double
(*) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.*)
instance Commutative Double where
instance Group Double where
(-) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.-)
negate :: Double -> Double
negate = Double -> Double
forall a. Num a => a -> a
P.negate
subtract :: Double -> Double -> Double
subtract = Double -> Double -> Double
forall a. Num a => a -> a -> a
P.subtract
times :: n -> Double -> Double
times n
n Double
r = n -> Double
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral n
n Double -> Double -> Double
forall a. Num a => a -> a -> a
P.* Double
r
instance LeftModule Integer Double where
Integer
n .* :: Integer -> Double -> Double
.* Double
r = Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger Integer
n Double -> Double -> Double
forall r. Multiplicative r => r -> r -> r
* Double
r
instance RightModule Integer Double where
Double
r *. :: Double -> Integer -> Double
*. Integer
n = Double
r Double -> Double -> Double
forall r. Multiplicative r => r -> r -> r
* Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger Integer
n
instance Rig Double where
fromNatural :: Natural -> Double
fromNatural = Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger (Integer -> Double) -> (Natural -> Integer) -> Natural -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall r. Rig r => Natural -> r
fromNatural
instance Semiring Double where
instance Abelian Double where
instance Ring Double where
fromInteger :: Integer -> Double
fromInteger = Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger
instance DecidableZero Double where
isZero :: Double -> Bool
isZero Double
0 = Bool
True
isZero Double
_ = Bool
False

instance Division Double where
recip :: Double -> Double
recip = Double -> Double
forall a. Fractional a => a -> a
P.recip
/ :: Double -> Double -> Double
(/)   = Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(P./)

instance P.Integral r => Additive (P.Ratio r) where
+ :: Ratio r -> Ratio r -> Ratio r
(+) = Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
(P.+)

instance P.Integral r => Abelian (P.Ratio r)

instance P.Integral r => LeftModule Natural (P.Ratio r) where
Natural
n .* :: Natural -> Ratio r -> Ratio r
.* Ratio r
r = Natural -> Ratio r
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.* Ratio r
r

instance P.Integral r => RightModule Natural (P.Ratio r) where
Ratio r
r *. :: Ratio r -> Natural -> Ratio r
*. Natural
n = Ratio r
r Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.* Natural -> Ratio r
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n

instance P.Integral r => LeftModule Integer (P.Ratio r) where
Integer
n .* :: Integer -> Ratio r -> Ratio r
.* Ratio r
r = Integer -> Ratio r
forall a. Num a => Integer -> a
P.fromInteger Integer
n Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.* Ratio r
r

instance P.Integral r => RightModule Integer (P.Ratio r) where
Ratio r
r *. :: Ratio r -> Integer -> Ratio r
*. Integer
n = Ratio r
r Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.* Integer -> Ratio r
forall a. Num a => Integer -> a
P.fromInteger Integer
n

instance P.Integral r => Group (P.Ratio r) where
(-)    = Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
(P.-)
negate :: Ratio r -> Ratio r
negate = Ratio r -> Ratio r
forall a. Num a => a -> a
P.negate
subtract :: Ratio r -> Ratio r -> Ratio r
subtract = Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.subtract
times :: n -> Ratio r -> Ratio r
times n
n Ratio r
r = n -> Ratio r
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral n
n Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
P.* Ratio r
r

instance P.Integral r => Commutative (P.Ratio r)

instance (Semiring r, P.Integral r) => LeftModule (Scalar r) (P.Ratio r) where
Scalar r
n .* :: Scalar r -> Ratio r -> Ratio r
.* Ratio r
r = (r
n r -> r -> Ratio r
forall a. Integral a => a -> a -> Ratio a
P.% r
1) Ratio r -> Ratio r -> Ratio r
forall r. Multiplicative r => r -> r -> r
* Ratio r
r

instance (Semiring r, P.Integral r) => RightModule (Scalar r) (P.Ratio r) where
Ratio r
r *. :: Ratio r -> Scalar r -> Ratio r
*. Scalar r
n = Ratio r
r Ratio r -> Ratio r -> Ratio r
forall r. Multiplicative r => r -> r -> r
* (r
n r -> r -> Ratio r
forall a. Integral a => a -> a -> Ratio a
P.% r
1)

instance P.Integral r => Multiplicative (P.Ratio r) where
* :: Ratio r -> Ratio r -> Ratio r
(*) = Ratio r -> Ratio r -> Ratio r
forall a. Num a => a -> a -> a
(P.*)

instance P.Integral r => Unital (P.Ratio r) where
one :: Ratio r
one = Ratio r
1

instance P.Integral r => Division (P.Ratio r) where
/ :: Ratio r -> Ratio r -> Ratio r
(/) = Ratio r -> Ratio r -> Ratio r
forall a. Fractional a => a -> a -> a
(P./)
recip :: Ratio r -> Ratio r
recip = Ratio r -> Ratio r
forall a. Fractional a => a -> a
P.recip

instance P.Integral r => Monoidal (P.Ratio r) where
zero :: Ratio r
zero = Ratio r
0

instance P.Integral r => Semiring (P.Ratio r)

instance P.Integral r => Rig (P.Ratio r) where
fromNatural :: Natural -> Ratio r
fromNatural = Natural -> Ratio r
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

instance P.Integral r => Ring (P.Ratio r) where
fromInteger :: Integer -> Ratio r
fromInteger = Integer -> Ratio r
forall a. Num a => Integer -> a
P.fromInteger

instance P.Integral r => DecidableZero (P.Ratio r) where
isZero :: Ratio r -> Bool
isZero Ratio r
0 = Bool
True
isZero Ratio r
_ = Bool
False

instance P.Integral r => DecidableUnits (P.Ratio r) where
isUnit :: Ratio r -> Bool
isUnit Ratio r
0 = Bool
False
isUnit Ratio r
_ = Bool
True
recipUnit :: Ratio r -> Maybe (Ratio r)
recipUnit Ratio r
0 = Maybe (Ratio r)
forall a. Maybe a
Nothing
recipUnit Ratio r
n = Ratio r -> Maybe (Ratio r)
forall a. a -> Maybe a
Just (Ratio r -> Ratio r
forall a. Fractional a => a -> a
P.recip Ratio r
n)
Ratio r
r ^? :: Ratio r -> n -> Maybe (Ratio r)
^? n
n
| Ratio r
r Ratio r -> Ratio r -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio r
0 = Ratio r -> Maybe (Ratio r)
forall a. a -> Maybe a
Just Ratio r
1
| Ratio r
r Ratio r -> Ratio r -> Bool
forall a. Eq a => a -> a -> Bool
/= Ratio r
0 = Ratio r -> Maybe (Ratio r)
forall a. a -> Maybe a
Just (Ratio r
r Ratio r -> n -> Ratio r
forall a b. (Fractional a, Integral b) => a -> b -> a
P.^^ n
n)
| Ratio r
r Ratio r -> Ratio r -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio r
0 Bool -> Bool -> Bool
&& n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
P.> n
0 = Ratio r -> Maybe (Ratio r)
forall a. a -> Maybe a
Just Ratio r
0
| Bool
otherwise = Maybe (Ratio r)
forall a. Maybe a
Nothing

instance Convertible (Fraction Integer) Double where
safeConvert :: Fraction Integer -> ConvertResult Double
safeConvert Fraction Integer
a = Double -> ConvertResult Double
forall a b. b -> Either a b
Right (Double -> ConvertResult Double) -> Double -> ConvertResult Double
forall a b. (a -> b) -> a -> b
\$ Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger (Fraction Integer -> Integer
forall t. Fraction t -> t
numerator Fraction Integer
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
P./ Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger (Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
a)

instance Convertible (Fraction Integer) (Complex Double) where
safeConvert :: Fraction Integer -> ConvertResult (Complex Double)
safeConvert Fraction Integer
a = Complex Double -> ConvertResult (Complex Double)
forall a b. b -> Either a b
Right (Complex Double -> ConvertResult (Complex Double))
-> Complex Double -> ConvertResult (Complex Double)
forall a b. (a -> b) -> a -> b
\$ Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger (Fraction Integer -> Integer
forall t. Fraction t -> t
numerator Fraction Integer
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
P./ Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger (Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
a) Double -> Double -> Complex Double
forall a. a -> a -> Complex a
:+ Double
0

instance (Random (Fraction Integer)) where
random :: g -> (Fraction Integer, g)
random = Rand g (Fraction Integer) -> g -> (Fraction Integer, g)
forall g a. Rand g a -> g -> (a, g)
runRand (Rand g (Fraction Integer) -> g -> (Fraction Integer, g))
-> Rand g (Fraction Integer) -> g -> (Fraction Integer, g)
forall a b. (a -> b) -> a -> b
\$ do
Integer
i <- RandT g Identity Integer
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
Integer
j <- RandT g Identity Integer
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
Fraction Integer -> Rand g (Fraction Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fraction Integer -> Rand g (Fraction Integer))
-> Fraction Integer -> Rand g (Fraction Integer)
forall a b. (a -> b) -> a -> b
\$ Integer
i Integer -> Integer -> Fraction Integer
forall d. GCDDomain d => d -> d -> Fraction d
% (Integer -> Integer
forall a. Num a => a -> a
P.abs Integer
j Integer -> Integer -> Integer
forall r. Additive r => r -> r -> r
+ Integer
1)
randomR :: (Fraction Integer, Fraction Integer) -> g -> (Fraction Integer, g)
randomR (Fraction Integer
a, Fraction Integer
b) = Rand g (Fraction Integer) -> g -> (Fraction Integer, g)
forall g a. Rand g a -> g -> (a, g)
runRand (Rand g (Fraction Integer) -> g -> (Fraction Integer, g))
-> Rand g (Fraction Integer) -> g -> (Fraction Integer, g)
forall a b. (a -> b) -> a -> b
\$ do
Integer
j <- Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
P.abs (Integer -> Integer)
-> RandT g Identity Integer -> RandT g Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> RandT g Identity Integer
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
let g :: Integer
g = (Integer -> Integer -> Integer) -> [Integer] -> Integer
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
P.lcm  [Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
a, Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
b, Integer
j]
lb :: Integer
lb = Integer
g Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Fraction Integer -> Integer
forall t. Fraction t -> t
numerator Fraction Integer
a Integer -> Integer -> Integer
forall d. Euclidean d => d -> d -> d
`quot` Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
a
ub :: Integer
ub = Integer
g Integer -> Integer -> Integer
forall r. Multiplicative r => r -> r -> r
* Fraction Integer -> Integer
forall t. Fraction t -> t
numerator Fraction Integer
b Integer -> Integer -> Integer
forall d. Euclidean d => d -> d -> d
`quot` Fraction Integer -> Integer
forall t. Fraction t -> t
denominator Fraction Integer
b
Integer
i <- (Integer, Integer) -> RandT g Identity Integer
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Integer
lb, Integer
ub)
Fraction Integer -> Rand g (Fraction Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fraction Integer -> Rand g (Fraction Integer))
-> Fraction Integer -> Rand g (Fraction Integer)
forall a b. (a -> b) -> a -> b
\$ Integer
i Integer -> Integer -> Fraction Integer
forall d. GCDDomain d => d -> d -> Fraction d
% Integer
g
```