{-# 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