{-
ToDo:
having the root exponent as type-level number would be nice
there is a package for basic type-level number support
-}
module Number.Root where

import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring

import qualified MathObj.RootSet as RootSet
import qualified Number.Ratio as Ratio

import Algebra.IntegralDomain (divChecked, )

import qualified NumericPrelude.Numeric as NP
import NumericPrelude.Numeric hiding (recip, )
import NumericPrelude.Base
import Prelude ()

{- |
The root degree must be positive.
This way we can implement multiplication
using only multiplication from type @a@.
-}
data T a = Cons Integer a
   deriving (Int -> T a -> ShowS
[T a] -> ShowS
T a -> String
(Int -> T a -> ShowS)
-> (T a -> String) -> ([T a] -> ShowS) -> Show (T a)
forall a. Show a => Int -> T a -> ShowS
forall a. Show a => [T a] -> ShowS
forall a. Show a => T a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T a] -> ShowS
$cshowList :: forall a. Show a => [T a] -> ShowS
show :: T a -> String
$cshow :: forall a. Show a => T a -> String
showsPrec :: Int -> T a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> T a -> ShowS
Show)

{- |
When you use @fmap@ you must assert that
@forall n. fmap f (Cons d x) == fmap f (Cons (n*d) (x^n))@
-}
instance Functor T where
   fmap :: (a -> b) -> T a -> T b
fmap a -> b
f (Cons Integer
d a
x) = Integer -> b -> T b
forall a. Integer -> a -> T a
Cons Integer
d (a -> b
f a
x)

fromNumber :: a -> T a
fromNumber :: a -> T a
fromNumber = Integer -> a -> T a
forall a. Integer -> a -> T a
Cons Integer
1

toNumber :: Algebraic.C a => T a -> a
toNumber :: T a -> a
toNumber (Cons Integer
n a
x) = Integer -> a -> a
forall a. C a => Integer -> a -> a
Algebraic.root Integer
n a
x

toRootSet :: Ring.C a => T a -> RootSet.T a
toRootSet :: T a -> T a
toRootSet (Cons Integer
d a
x) =
   [a] -> T a
forall a. [a] -> T a
RootSet.lift0 ([a -> a
forall a. C a => a -> a
negate a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
pred (Integer -> Int
forall a. C a => Integer -> a
fromInteger Integer
d)) a
forall a. C a => a
zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
forall a. C a => a
one])


commonDegree :: Ring.C a => T a -> T a -> T (a,a)
commonDegree :: T a -> T a -> T (a, a)
commonDegree (Cons Integer
xd a
x) (Cons Integer
yd a
y) =
   let zd :: Integer
zd = Integer -> Integer -> Integer
forall a. C a => a -> a -> a
lcm Integer
xd Integer
yd
   in  Integer -> (a, a) -> T (a, a)
forall a. Integer -> a -> T a
Cons Integer
zd (a
x a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divChecked Integer
zd Integer
xd, a
y a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divChecked Integer
zd Integer
yd)

instance (Eq a, Ring.C a) => Eq (T a) where
   T a
x == :: T a -> T a -> Bool
== T a
y  =
      case T a -> T a -> T (a, a)
forall a. C a => T a -> T a -> T (a, a)
commonDegree T a
x T a
y of
         Cons Integer
_ (a
xn,a
yn) -> a
xna -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
yn

instance (Ord a, Ring.C a) => Ord (T a) where
   compare :: T a -> T a -> Ordering
compare T a
x T a
y  =
      case T a -> T a -> T (a, a)
forall a. C a => T a -> T a -> T (a, a)
commonDegree T a
x T a
y of
         Cons Integer
_ (a
xn,a
yn) -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
xn a
yn


mul :: Ring.C a => T a -> T a -> T a
mul :: T a -> T a -> T a
mul T a
x T a
y = ((a, a) -> a) -> T (a, a) -> T a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. C a => a -> a -> a
(*)) (T (a, a) -> T a) -> T (a, a) -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T (a, a)
forall a. C a => T a -> T a -> T (a, a)
commonDegree T a
x T a
y

div :: Field.C a => T a -> T a -> T a
div :: T a -> T a -> T a
div T a
x T a
y = ((a, a) -> a) -> T (a, a) -> T a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. C a => a -> a -> a
(/)) (T (a, a) -> T a) -> T (a, a) -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T (a, a)
forall a. C a => T a -> T a -> T (a, a)
commonDegree T a
x T a
y

recip :: Field.C a => T a -> T a
recip :: T a -> T a
recip = (a -> a) -> T a -> T a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. C a => a -> a
NP.recip

{- |
exponent must be non-negative
-}
cardinalPower :: Ring.C a => Integer -> T a -> T a
cardinalPower :: Integer -> T a -> T a
cardinalPower Integer
n (Cons Integer
d a
x) =
   let m :: Integer
m = Integer -> Integer -> Integer
forall a. C a => a -> a -> a
gcd Integer
n Integer
d
   in  Integer -> a -> T a
forall a. Integer -> a -> T a
Cons (Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divChecked Integer
d Integer
m) (a
x a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divChecked Integer
n Integer
m)

{- |
exponent can be negative
-}
integerPower :: Field.C a => Integer -> T a -> T a
integerPower :: Integer -> T a -> T a
integerPower Integer
n =
   if Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0
     then Integer -> T a -> T a
forall a. C a => Integer -> T a -> T a
cardinalPower (-Integer
n) (T a -> T a) -> (T a -> T a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> T a
forall a. C a => T a -> T a
recip
     else Integer -> T a -> T a
forall a. C a => Integer -> T a -> T a
cardinalPower Integer
n

rationalPower :: Field.C a => Rational -> T a -> T a
rationalPower :: Rational -> T a -> T a
rationalPower Rational
n =
   Integer -> T a -> T a
forall a. C a => Integer -> T a -> T a
integerPower (Rational -> Integer
forall a. T a -> a
Ratio.numerator Rational
n) (T a -> T a) -> (T a -> T a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Integer -> T a -> T a
forall a. C a => Integer -> T a -> T a
root (Rational -> Integer
forall a. T a -> a
Ratio.denominator Rational
n)

{- |
exponent must be positive
-}
root :: Ring.C a => Integer -> T a -> T a
root :: Integer -> T a -> T a
root Integer
n (Cons Integer
d a
x) = Integer -> a -> T a
forall a. Integer -> a -> T a
Cons (Integer
dInteger -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
n) a
x

sqrt :: Ring.C a => T a -> T a
sqrt :: T a -> T a
sqrt = Integer -> T a -> T a
forall a. C a => Integer -> T a -> T a
root Integer
2