{-# LANGUAGE RebindableSyntax #-}
module Algebra.Algebraic where

import qualified Algebra.Field as Field
import qualified Algebra.Laws as Laws
import qualified Algebra.ToRational as ToRational
import qualified Algebra.ToInteger  as ToInteger

import Number.Ratio (Rational, (%), numerator, denominator)
import Algebra.Field ((^-), recip, fromRational')
import Algebra.Ring ((*), (^), fromInteger)
import Algebra.Additive((+))

import NumericPrelude.Base
import qualified Prelude as P


infixr 8  ^/

{- | Minimal implementation: 'root' or '(^\/)'. -}

class (Field.C a) => C a where
    {-# MINIMAL root | (^/) #-}
    sqrt :: a -> a
    sqrt = Integer -> a -> a
forall a. C a => Integer -> a -> a
root Integer
2
    -- sqrt x  =  x ** (1/2)

    root :: P.Integer -> a -> a
    root Integer
n a
x = a
x a -> Rational -> a
forall a. C a => a -> Rational -> a
^/ (Integer
1 Integer -> Integer -> Rational
forall a. C a => a -> a -> T a
% Integer
n)

    (^/) :: a -> Rational -> a
    a
x ^/ Rational
y = Integer -> a -> a
forall a. C a => Integer -> a -> a
root (Rational -> Integer
forall a. T a -> a
denominator Rational
y) (a
x a -> Integer -> a
forall a. C a => a -> Integer -> a
^- Rational -> Integer
forall a. T a -> a
numerator Rational
y)

genericRoot :: (C a, ToInteger.C b) => b -> a -> a
genericRoot :: b -> a -> a
genericRoot b
n = Integer -> a -> a
forall a. C a => Integer -> a -> a
root (b -> Integer
forall a. C a => a -> Integer
ToInteger.toInteger b
n)

power :: (C a, ToRational.C b) => b -> a -> a
power :: b -> a -> a
power b
r = (a -> Rational -> a
forall a. C a => a -> Rational -> a
^/ b -> Rational
forall a. C a => a -> Rational
ToRational.toRational b
r)

instance C P.Float where
    sqrt :: Float -> Float
sqrt     = Float -> Float
forall a. Floating a => a -> a
P.sqrt
    root :: Integer -> Float -> Float
root Integer
n Float
x = Float
x Float -> Float -> Float
forall a. Floating a => a -> a -> a
P.** Float -> Float
forall a. C a => a -> a
recip (Integer -> Float
forall a. Num a => Integer -> a
P.fromInteger Integer
n)
    Float
x ^/ :: Float -> Rational -> Float
^/ Rational
y   = Float
x Float -> Float -> Float
forall a. Floating a => a -> a -> a
P.** Rational -> Float
forall a. C a => Rational -> a
fromRational' Rational
y

instance C P.Double where
    sqrt :: Double -> Double
sqrt     = Double -> Double
forall a. Floating a => a -> a
P.sqrt
    root :: Integer -> Double -> Double
root Integer
n Double
x = Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
P.** Double -> Double
forall a. C a => a -> a
recip (Integer -> Double
forall a. Num a => Integer -> a
P.fromInteger Integer
n)
    Double
x ^/ :: Double -> Rational -> Double
^/ Rational
y   = Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
P.** Rational -> Double
forall a. C a => Rational -> a
fromRational' Rational
y


{- * Properties -}

-- propSqrtSqr :: (Eq a, C a, Units.C a) => a -> Bool
-- propSqrtSqr x = sqrt (x^2) == Units.stdAssociate x

propSqrSqrt :: (Eq a, C a) => a -> Bool
propSqrSqrt :: a -> Bool
propSqrSqrt a
x = a -> a
forall a. C a => a -> a
sqrt a
x a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer
2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x

propPowerCascade      :: (Eq a, C a) => a -> Rational -> Rational -> Bool
propPowerProduct      :: (Eq a, C a) => a -> Rational -> Rational -> Bool
propPowerDistributive :: (Eq a, C a) => Rational -> a -> a -> Bool

propPowerCascade :: a -> Rational -> Rational -> Bool
propPowerCascade      a
x Rational
i Rational
j  =  (Rational -> Rational -> Rational)
-> (a -> Rational -> a) -> a -> Rational -> Rational -> Bool
forall a b.
Eq a =>
(b -> b -> b) -> (a -> b -> a) -> a -> b -> b -> Bool
Laws.rightCascade Rational -> Rational -> Rational
forall a. C a => a -> a -> a
(*) a -> Rational -> a
forall a. C a => a -> Rational -> a
(^/) a
x Rational
i Rational
j
propPowerProduct :: a -> Rational -> Rational -> Bool
propPowerProduct      a
x Rational
i Rational
j  =  (Rational -> a)
-> (Rational -> Rational -> Rational)
-> (a -> a -> a)
-> Rational
-> Rational
-> Bool
forall a b.
Eq a =>
(b -> a) -> (b -> b -> b) -> (a -> a -> a) -> b -> b -> Bool
Laws.homomorphism (a
xa -> Rational -> a
forall a. C a => a -> Rational -> a
^/) Rational -> Rational -> Rational
forall a. C a => a -> a -> a
(+) a -> a -> a
forall a. C a => a -> a -> a
(*) Rational
i Rational
j
propPowerDistributive :: Rational -> a -> a -> Bool
propPowerDistributive Rational
i a
x a
y  =  (a -> Rational -> a) -> (a -> a -> a) -> Rational -> a -> a -> Bool
forall a b.
Eq a =>
(a -> b -> a) -> (a -> a -> a) -> b -> a -> a -> Bool
Laws.leftDistributive a -> Rational -> a
forall a. C a => a -> Rational -> a
(^/) a -> a -> a
forall a. C a => a -> a -> a
(*) Rational
i a
x a
y