{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2011 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 <https://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Describes a /ring/ and operations on its members.

	* <https://en.wikipedia.org/wiki/Ring_%28mathematics%29>.

	* <https://www.numericana.com/answer/rings.htm>.
-}

module Factory.Data.Ring(
-- * Type-classes
	Ring(..),
-- * Types
-- ** Data-types
--	Product,
--	Sum,
-- * Functions
	product',
	sum',
-- ** Operators
	(=^)
) where

import qualified	Data.Monoid
import qualified	Factory.Math.DivideAndConquer	as Math.DivideAndConquer

infixl 6 =+=	-- Same as (+).
infixl 6 =-=	-- Same as (-).
infixl 7 =*=	-- Same as (*).
infixr 8 =^	-- Same as (^).

{- |
	* Define both the operations applicable to all members of the /ring/, and its mandatory members.

	* Minimal definition; '=+=', '=*=', 'additiveInverse', 'multiplicativeIdentity', 'additiveIdentity'.
-}
class Ring r	where
	(=+=)			:: r -> r -> r	-- ^ Addition of two members; required to be /commutative/; <https://en.wikipedia.org/wiki/Commutativity>.
	(=*=)			:: r -> r -> r	-- ^ Multiplication of two members.
	additiveInverse		:: r -> r	-- ^ The operand required to yield /zero/ under addition; <https://en.wikipedia.org/wiki/Additive_inverse>.
	multiplicativeIdentity	:: r		-- ^ The /identity/-member under multiplication; <https://mathworld.wolfram.com/MultiplicativeIdentity.html>.
	additiveIdentity	:: r		-- ^ The /identity/-member under addition (AKA /zero/); <https://en.wikipedia.org/wiki/Additive_identity>.

	(=-=) :: r -> r -> r			-- ^ Subtract the two specified /ring/-members.
	r
l =-= r
r	= r
l r -> r -> r
forall r. Ring r => r -> r -> r
=+= r -> r
forall r. Ring r => r -> r
additiveInverse r
r	-- Default implementation.

	square :: r -> r			-- ^ Square the ring.
	square r
r	= r
r r -> r -> r
forall r. Ring r => r -> r -> r
=*= r
r		-- Default implementation; there may be a more efficient one.

{- |
	* Raise a /ring/-member to the specified positive integral power.

	* Exponentiation is implemented as a sequence of either squares of, or multiplications by, the /ring/-member;
	<https://en.wikipedia.org/wiki/Exponentiation_by_squaring>.
-}
(=^) :: (
	Eq		r,
	Integral	power,
	Ring		r,
	Show		power
 ) => r -> power -> r
r
_ =^ :: r -> power -> r
=^ power
0	= r
forall r. Ring r => r
multiplicativeIdentity
r
ring =^ power
power
	| power
power power -> power -> Bool
forall a. Ord a => a -> a -> Bool
< power
0							= [Char] -> r
forall a. HasCallStack => [Char] -> a
error ([Char] -> r) -> [Char] -> r
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Data.Ring.(=^):\tthe result isn't guaranteed to be a ring-member, for power=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ power -> [Char]
forall a. Show a => a -> [Char]
show power
power
	| r
ring r -> [r] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [r
forall r. Ring r => r
additiveIdentity, r
forall r. Ring r => r
multiplicativeIdentity]	= r
ring
	| Bool
otherwise							= power -> r
forall t. Integral t => t -> r
slave power
power
	where
		slave :: t -> r
slave t
1	= r
ring
		slave t
n	= (if t
r t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 {-even-} then r -> r
forall a. a -> a
id else (r -> r -> r
forall r. Ring r => r -> r -> r
=*= r
ring)) (r -> r) -> (r -> r) -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> r
forall r. Ring r => r -> r
square (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ t -> r
slave t
q	where
			(t
q, t
r)	= t
n t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` t
2

-- | Does for 'Ring', what 'Data.Monoid.Product' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under multiplication.
newtype Product p	= MkProduct {
	Product p -> p
getProduct :: p	-- ^ Access the polymorphic payload.
} deriving (ReadPrec [Product p]
ReadPrec (Product p)
Int -> ReadS (Product p)
ReadS [Product p]
(Int -> ReadS (Product p))
-> ReadS [Product p]
-> ReadPrec (Product p)
-> ReadPrec [Product p]
-> Read (Product p)
forall p. Read p => ReadPrec [Product p]
forall p. Read p => ReadPrec (Product p)
forall p. Read p => Int -> ReadS (Product p)
forall p. Read p => ReadS [Product p]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Product p]
$creadListPrec :: forall p. Read p => ReadPrec [Product p]
readPrec :: ReadPrec (Product p)
$creadPrec :: forall p. Read p => ReadPrec (Product p)
readList :: ReadS [Product p]
$creadList :: forall p. Read p => ReadS [Product p]
readsPrec :: Int -> ReadS (Product p)
$creadsPrec :: forall p. Read p => Int -> ReadS (Product p)
Read, Int -> Product p -> [Char] -> [Char]
[Product p] -> [Char] -> [Char]
Product p -> [Char]
(Int -> Product p -> [Char] -> [Char])
-> (Product p -> [Char])
-> ([Product p] -> [Char] -> [Char])
-> Show (Product p)
forall p. Show p => Int -> Product p -> [Char] -> [Char]
forall p. Show p => [Product p] -> [Char] -> [Char]
forall p. Show p => Product p -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Product p] -> [Char] -> [Char]
$cshowList :: forall p. Show p => [Product p] -> [Char] -> [Char]
show :: Product p -> [Char]
$cshow :: forall p. Show p => Product p -> [Char]
showsPrec :: Int -> Product p -> [Char] -> [Char]
$cshowsPrec :: forall p. Show p => Int -> Product p -> [Char] -> [Char]
Show)

-- Added for 'ghc-8.4', when 'Semigroup' became a superclass of 'Monoid'.
#if MIN_VERSION_base(4,11,0)
instance Ring r => Semigroup (Product r)	where
	MkProduct r
x <> :: Product r -> Product r -> Product r
<> MkProduct r
y	= r -> Product r
forall p. p -> Product p
MkProduct (r -> Product r) -> r -> Product r
forall a b. (a -> b) -> a -> b
$ r
x r -> r -> r
forall r. Ring r => r -> r -> r
=*= r
y
#endif

instance Ring r => Data.Monoid.Monoid (Product r)	where
	mempty :: Product r
mempty					= r -> Product r
forall p. p -> Product p
MkProduct r
forall r. Ring r => r
multiplicativeIdentity
#if !MIN_VERSION_base(4,11,0)
	MkProduct x `mappend` MkProduct y	= MkProduct $ x =*= y
#endif

-- | Returns the /product/ of the list of /ring/-members.
product' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r
-- product' _ _			= getProduct . Data.Monoid.mconcat . map MkProduct
product' :: BisectionRatio -> Int -> [r] -> r
product' BisectionRatio
ratio Int
minLength	= Product r -> r
forall p. Product p -> p
getProduct (Product r -> r) -> ([r] -> Product r) -> [r] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BisectionRatio -> Int -> [Product r] -> Product r
forall monoid.
Monoid monoid =>
BisectionRatio -> Int -> [monoid] -> monoid
Math.DivideAndConquer.divideAndConquer BisectionRatio
ratio Int
minLength ([Product r] -> Product r)
-> ([r] -> [Product r]) -> [r] -> Product r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Product r) -> [r] -> [Product r]
forall a b. (a -> b) -> [a] -> [b]
map r -> Product r
forall p. p -> Product p
MkProduct

-- | Does for 'Ring', what 'Data.Monoid.Sum' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under addition.
newtype Sum s	= MkSum {
	Sum s -> s
getSum :: s	-- ^ Access the polymorphic payload.
} deriving (ReadPrec [Sum s]
ReadPrec (Sum s)
Int -> ReadS (Sum s)
ReadS [Sum s]
(Int -> ReadS (Sum s))
-> ReadS [Sum s]
-> ReadPrec (Sum s)
-> ReadPrec [Sum s]
-> Read (Sum s)
forall s. Read s => ReadPrec [Sum s]
forall s. Read s => ReadPrec (Sum s)
forall s. Read s => Int -> ReadS (Sum s)
forall s. Read s => ReadS [Sum s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sum s]
$creadListPrec :: forall s. Read s => ReadPrec [Sum s]
readPrec :: ReadPrec (Sum s)
$creadPrec :: forall s. Read s => ReadPrec (Sum s)
readList :: ReadS [Sum s]
$creadList :: forall s. Read s => ReadS [Sum s]
readsPrec :: Int -> ReadS (Sum s)
$creadsPrec :: forall s. Read s => Int -> ReadS (Sum s)
Read, Int -> Sum s -> [Char] -> [Char]
[Sum s] -> [Char] -> [Char]
Sum s -> [Char]
(Int -> Sum s -> [Char] -> [Char])
-> (Sum s -> [Char])
-> ([Sum s] -> [Char] -> [Char])
-> Show (Sum s)
forall s. Show s => Int -> Sum s -> [Char] -> [Char]
forall s. Show s => [Sum s] -> [Char] -> [Char]
forall s. Show s => Sum s -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Sum s] -> [Char] -> [Char]
$cshowList :: forall s. Show s => [Sum s] -> [Char] -> [Char]
show :: Sum s -> [Char]
$cshow :: forall s. Show s => Sum s -> [Char]
showsPrec :: Int -> Sum s -> [Char] -> [Char]
$cshowsPrec :: forall s. Show s => Int -> Sum s -> [Char] -> [Char]
Show)

-- Added for 'ghc-8.4', when 'Semigroup' became a superclass of 'Monoid'.
#if MIN_VERSION_base(4,11,0)
instance Ring r => Semigroup (Sum r)	where
	MkSum r
x <> :: Sum r -> Sum r -> Sum r
<> MkSum r
y	= r -> Sum r
forall s. s -> Sum s
MkSum (r -> Sum r) -> r -> Sum r
forall a b. (a -> b) -> a -> b
$ r
x r -> r -> r
forall r. Ring r => r -> r -> r
=+= r
y
#endif

instance Ring r => Data.Monoid.Monoid (Sum r)	where
	mempty :: Sum r
mempty				= r -> Sum r
forall s. s -> Sum s
MkSum r
forall r. Ring r => r
additiveIdentity
#if !MIN_VERSION_base(4,11,0)
	MkSum x `mappend` MkSum y	= MkSum $ x =+= y
#endif

-- | Returns the /sum/ of the list of /ring/-members.
sum' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r
-- sum' _ _		= getSum . Data.Monoid.mconcat . map MkSum
sum' :: BisectionRatio -> Int -> [r] -> r
sum' BisectionRatio
ratio Int
minLength	= Sum r -> r
forall s. Sum s -> s
getSum (Sum r -> r) -> ([r] -> Sum r) -> [r] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BisectionRatio -> Int -> [Sum r] -> Sum r
forall monoid.
Monoid monoid =>
BisectionRatio -> Int -> [monoid] -> monoid
Math.DivideAndConquer.divideAndConquer BisectionRatio
ratio Int
minLength ([Sum r] -> Sum r) -> ([r] -> [Sum r]) -> [r] -> Sum r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Sum r) -> [r] -> [Sum r]
forall a b. (a -> b) -> [a] -> [b]
map r -> Sum r
forall s. s -> Sum s
MkSum