-- |
-- Module:      Math.NumberTheory.RootsOfUnity
-- Copyright:   (c) 2018 Bhavik Mehta
-- Licence:     MIT
-- Maintainer:  Bhavik Mehta <bhavikmehta8@gmail.com>
--
-- Implementation of roots of unity
--


module Math.NumberTheory.RootsOfUnity
(  
-- * Roots of unity
   RootOfUnity (..)
-- ** Conversions
   , toRootOfUnity
   , toComplex )

where

import Data.Complex                                        (Complex(..), cis)
import Data.Semigroup                                      (Semigroup(..))
import Data.Ratio                                          ((%), numerator, denominator)

-- | A representation of <https://en.wikipedia.org/wiki/Root_of_unity roots of unity>: complex
-- numbers \(z\) for which there is \(n\) such that \(z^n=1\).
newtype RootOfUnity =
  RootOfUnity { -- | Every root of unity can be expressed as \(e^{2 \pi i q}\) for some
                -- rational \(q\) satisfying \(0 \leq q < 1\), this function extracts it.
                RootOfUnity -> Rational
fromRootOfUnity :: Rational }
  deriving (RootOfUnity -> RootOfUnity -> Bool
(RootOfUnity -> RootOfUnity -> Bool)
-> (RootOfUnity -> RootOfUnity -> Bool) -> Eq RootOfUnity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootOfUnity -> RootOfUnity -> Bool
$c/= :: RootOfUnity -> RootOfUnity -> Bool
== :: RootOfUnity -> RootOfUnity -> Bool
$c== :: RootOfUnity -> RootOfUnity -> Bool
Eq)

instance Show RootOfUnity where
  show :: RootOfUnity -> String
show (RootOfUnity Rational
q)
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = String
"1"
    | Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1    = String
"-1"
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1    = String
"e^(πi/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    | Bool
otherwise = String
"e^(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"πi/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    where n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator (Rational
2Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
q)
          d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator (Rational
2Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
q)

-- | Given a rational \(q\), produce the root of unity \(e^{2 \pi i q}\).
toRootOfUnity :: Rational -> RootOfUnity
toRootOfUnity :: Rational -> RootOfUnity
toRootOfUnity Rational
q = Rational -> RootOfUnity
RootOfUnity ((Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
d) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d)
  where n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
q
        d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q
        -- effectively q `mod` 1
  -- This smart constructor ensures that the rational is always in the range 0 <= q < 1.

-- | This Semigroup is in fact a group, so @'stimes'@ can be called with a negative first argument.
instance Semigroup RootOfUnity where
  RootOfUnity Rational
q1 <> :: RootOfUnity -> RootOfUnity -> RootOfUnity
<> RootOfUnity Rational
q2 = Rational -> RootOfUnity
toRootOfUnity (Rational
q1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
q2)
  stimes :: b -> RootOfUnity -> RootOfUnity
stimes b
k (RootOfUnity Rational
q) = Rational -> RootOfUnity
toRootOfUnity (Rational
q Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (b -> Integer
forall a. Integral a => a -> Integer
toInteger b
k Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1))

instance Monoid RootOfUnity where
  mappend :: RootOfUnity -> RootOfUnity -> RootOfUnity
mappend = RootOfUnity -> RootOfUnity -> RootOfUnity
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: RootOfUnity
mempty = Rational -> RootOfUnity
RootOfUnity Rational
0

-- | Convert a root of unity into an inexact complex number. Due to floating point inaccuracies,
-- it is recommended to avoid use of this until the end of a calculation. Alternatively, with
-- the [cyclotomic](http://hackage.haskell.org/package/cyclotomic-0.5.1) package, one can use
-- @[polarRat](https://hackage.haskell.org/package/cyclotomic-0.5.1/docs/Data-Complex-Cyclotomic.html#v:polarRat)
-- 1 . @'fromRootOfUnity' to convert to a cyclotomic number.
toComplex :: Floating a => RootOfUnity -> Complex a
toComplex :: RootOfUnity -> Complex a
toComplex (RootOfUnity Rational
t)
  | Rational
t Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2 = (-a
1) a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
  | Rational
t Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
4 = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
1
  | Rational
t Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
4 = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (-a
1)
  | Bool
otherwise = a -> Complex a
forall a. Floating a => a -> Complex a
cis (a -> Complex a) -> (Rational -> a) -> Rational -> Complex a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pia -> a -> a
forall a. Num a => a -> a -> a
*) (a -> a) -> (Rational -> a) -> Rational -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> Complex a) -> Rational -> Complex a
forall a b. (a -> b) -> a -> b
$ Rational
t