{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2011-2015 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Describes a <https://en.wikipedia.org/wiki/Monomial> and operations on it.

	* A /monomial/ is merely a /polynomial/ with a single non-zero term; cf. /Binomial/.
-}

module Factory.Data.Monomial(
-- * Types
-- ** Type-synonyms
	Monomial,
-- * Functions
	double,
	mod',
	negateCoefficient,
	realCoefficientToFrac,
	shiftCoefficient,
	shiftExponent,
	square,
-- ** Accessors
	getExponent,
	getCoefficient,
-- ** Operators
	(<=>),
	(</>),
	(<*>),	-- CAVEAT: this clashes with the Prelude from 'base-4.8'.
	(=~),
-- ** Predicates
	isMonomial
) where

import qualified	Control.Arrow

#if MIN_VERSION_base(4,8,0)
import Prelude hiding ((<*>))	-- The "Prelude" from 'base-4.8' exports this symbol.
#endif

infix 4 <=>	-- Same as (==).
infix 4 =~	-- Same as (==).
infixl 7 </>	-- Same as (/).
infixl 7 <*>	-- Same as (*).

{- |
	* The type of an arbitrary monomial.

	* CAVEAT: though a /monomial/ has an integral power, this contraint is only imposed at the function-level.
-}
type Monomial coefficient exponent	= (coefficient, exponent)

-- | Accessor.
{-# INLINE getCoefficient #-}
getCoefficient :: Monomial c e -> c
getCoefficient :: Monomial c e -> c
getCoefficient	= Monomial c e -> c
forall a b. (a, b) -> a
fst

-- | Accessor.
{-# INLINE getExponent #-}
getExponent :: Monomial c e -> e
getExponent :: Monomial c e -> e
getExponent	= Monomial c e -> e
forall a b. (a, b) -> b
snd

{- |
	* 'True' if the /exponent/ is both integral and non-/negative/.

	* CAVEAT: one can't even call this function unless the /exponent/ is integral.
-}
isMonomial :: Integral e => Monomial c e -> Bool
isMonomial :: Monomial c e -> Bool
isMonomial	= (e -> e -> Bool
forall a. Ord a => a -> a -> Bool
>= e
0) (e -> Bool) -> (Monomial c e -> e) -> Monomial c e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Monomial c e -> e
forall a b. (a, b) -> b
getExponent

-- | Compares the /exponents/ of the specified 'Monomial's.
{-# INLINE (<=>) #-}
(<=>) :: Ord e => Monomial c e -> Monomial c e -> Ordering
(c
_, e
l) <=> :: Monomial c e -> Monomial c e -> Ordering
<=> (c
_, e
r)	= e
l e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` e
r

-- | True if the /exponents/ are equal.
(=~) :: Eq e => Monomial c e -> Monomial c e -> Bool
(c
_, e
l) =~ :: Monomial c e -> Monomial c e -> Bool
=~ (c
_, e
r)	= e
l e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
r

-- | Multiply the two specified 'Monomial's.
{-# INLINE (<*>) #-}
(<*>) :: (Num c, Num e) => Monomial c e -> Monomial c e -> Monomial c e
(c
cL, e
eL) <*> :: Monomial c e -> Monomial c e -> Monomial c e
<*> (c
cR, e
eR)	= (c
cL c -> c -> c
forall a. Num a => a -> a -> a
* c
cR, e
eL e -> e -> e
forall a. Num a => a -> a -> a
+ e
eR)

-- | Divide the two specified 'Monomial's.
(</>) :: (Eq c, Fractional c, Num e)
	=> Monomial c e	-- ^ Numerator.
	-> Monomial c e	-- ^ Denominator.
	-> Monomial c e
(c
cN, e
eN) </> :: Monomial c e -> Monomial c e -> Monomial c e
</> (c
1, e
eD)	= (c
cN, e
eN e -> e -> e
forall a. Num a => a -> a -> a
- e
eD)
(c
cN, e
eN) </> (c
cD, e
eD)	= (c
cN c -> c -> c
forall a. Fractional a => a -> a -> a
/ c
cD, e
eN e -> e -> e
forall a. Num a => a -> a -> a
- e
eD)

-- | Square the specified 'Monomial'.
square :: (Num c, Num e) => Monomial c e -> Monomial c e
square :: Monomial c e -> Monomial c e
square (c
c, e
e)	= (c
c c -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int), e
2 e -> e -> e
forall a. Num a => a -> a -> a
* e
e)

-- | Double the specified 'Monomial'.
{-# INLINE double #-}
double :: Num c => Monomial c e -> Monomial c e
double :: Monomial c e -> Monomial c e
double (c
c, e
e)	= (c
2 c -> c -> c
forall a. Num a => a -> a -> a
* c
c, e
e)

-- | Shift the /coefficient/, by the specified amount.
{-# INLINE shiftCoefficient #-}
shiftCoefficient :: Num c
	=> Monomial c e
	-> c	-- ^ The magnitude of the shift.
	-> Monomial c e
-- m `shiftCoefficient` i	= Control.Arrow.first (+ i) m	-- CAVEAT: Too slow.
(c
c, e
e) shiftCoefficient :: Monomial c e -> c -> Monomial c e
`shiftCoefficient` c
i	= (c
c c -> c -> c
forall a. Num a => a -> a -> a
+ c
i, e
e)

-- | Shift the /exponent/, by the specified amount.
{-# INLINE shiftExponent #-}
shiftExponent :: Num e
	=> Monomial c e
	-> e	-- ^ The magnitude of the shift.
	-> Monomial c e
-- m `shiftExponent` i	= Control.Arrow.second (+ i) m	-- CAVEAT: Too slow.
(c
c, e
e) shiftExponent :: Monomial c e -> e -> Monomial c e
`shiftExponent` e
i	= (c
c, e
e e -> e -> e
forall a. Num a => a -> a -> a
+ e
i)

-- | Negate the coefficient.
negateCoefficient :: Num c => Monomial c e -> Monomial c e
negateCoefficient :: Monomial c e -> Monomial c e
negateCoefficient	= (c -> c) -> Monomial c e -> Monomial c e
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first c -> c
forall a. Num a => a -> a
negate

-- | Reduce the coefficient using /modular/ arithmetic.
{-# INLINE mod' #-}
mod' :: Integral c
	=> Monomial c e
	-> c	-- ^ Modulus.
	-> Monomial c e
Monomial c e
monomial mod' :: Monomial c e -> c -> Monomial c e
`mod'` c
modulus	= (c -> c) -> Monomial c e -> Monomial c e
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (c -> c -> c
forall a. Integral a => a -> a -> a
`mod` c
modulus) Monomial c e
monomial

-- | Convert the type of the /coefficient/.
realCoefficientToFrac :: (Real r, Fractional f) => Monomial r e -> Monomial f e
realCoefficientToFrac :: Monomial r e -> Monomial f e
realCoefficientToFrac	= (r -> f) -> Monomial r e -> Monomial f e
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first r -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac