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

+ :: 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` ()

(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
+ :: 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
```