-- | Multiplicative classes
module NumHask.Algebra.Multiplicative
  ( Multiplicative (..),
    Product (..),
    product,
    accproduct,
    Divisive (..),
  )
where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.Traversable (mapAccumL)
import Data.Word (Word, Word16, Word32, Word64, Word8)
import GHC.Natural (Natural (..))
import Prelude (Double, Eq, Float, Int, Integer, Ord, Show, fromInteger, fromRational)
import Prelude qualified as P

-- $setup
--
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude

-- | or [Multiplication](https://en.wikipedia.org/wiki/Multiplication)
--
-- For practical reasons, we begin the class tree with 'NumHask.Algebra.Additive.Additive' and 'Multiplicative'.  Starting with  'NumHask.Algebra.Group.Associative' and 'NumHask.Algebra.Group.Unital', or using 'Data.Semigroup.Semigroup' and 'Data.Monoid.Monoid' from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication.
--
--
-- prop> \a -> one * a == a
-- prop> \a -> a * one == a
-- prop> \a b c -> (a * b) * c == a * (b * c)
--
-- By convention, (*) is regarded as not necessarily commutative, but this is not universal, and the introduction of another symbol which means commutative multiplication seems a bit dogmatic.
--
-- >>> one * 2
-- 2
--
-- >>> 2 * 3
-- 6
class Multiplicative a where
  infixl 7 *
  (*) :: a -> a -> a

  one :: a

-- | A wrapper for an Multiplicative which distinguishes the multiplicative structure
--
-- @since 0.11.1
newtype Product a = Product
  { forall a. Product a -> a
getProduct :: a
  }
  deriving (Product a -> Product a -> Bool
(Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool) -> Eq (Product a)
forall a. Eq a => Product a -> Product a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Product a -> Product a -> Bool
== :: Product a -> Product a -> Bool
$c/= :: forall a. Eq a => Product a -> Product a -> Bool
/= :: Product a -> Product a -> Bool
Eq, Eq (Product a)
Eq (Product a) =>
(Product a -> Product a -> Ordering)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Bool)
-> (Product a -> Product a -> Product a)
-> (Product a -> Product a -> Product a)
-> Ord (Product a)
Product a -> Product a -> Bool
Product a -> Product a -> Ordering
Product a -> Product a -> Product a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Product a)
forall a. Ord a => Product a -> Product a -> Bool
forall a. Ord a => Product a -> Product a -> Ordering
forall a. Ord a => Product a -> Product a -> Product a
$ccompare :: forall a. Ord a => Product a -> Product a -> Ordering
compare :: Product a -> Product a -> Ordering
$c< :: forall a. Ord a => Product a -> Product a -> Bool
< :: Product a -> Product a -> Bool
$c<= :: forall a. Ord a => Product a -> Product a -> Bool
<= :: Product a -> Product a -> Bool
$c> :: forall a. Ord a => Product a -> Product a -> Bool
> :: Product a -> Product a -> Bool
$c>= :: forall a. Ord a => Product a -> Product a -> Bool
>= :: Product a -> Product a -> Bool
$cmax :: forall a. Ord a => Product a -> Product a -> Product a
max :: Product a -> Product a -> Product a
$cmin :: forall a. Ord a => Product a -> Product a -> Product a
min :: Product a -> Product a -> Product a
Ord, Int -> Product a -> ShowS
[Product a] -> ShowS
Product a -> String
(Int -> Product a -> ShowS)
-> (Product a -> String)
-> ([Product a] -> ShowS)
-> Show (Product a)
forall a. Show a => Int -> Product a -> ShowS
forall a. Show a => [Product a] -> ShowS
forall a. Show a => Product a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Product a -> ShowS
showsPrec :: Int -> Product a -> ShowS
$cshow :: forall a. Show a => Product a -> String
show :: Product a -> String
$cshowList :: forall a. Show a => [Product a] -> ShowS
showList :: [Product a] -> ShowS
Show)

instance (Multiplicative a) => P.Semigroup (Product a) where
  Product a
a <> :: Product a -> Product a -> Product a
<> Product a
b = a -> Product a
forall a. a -> Product a
Product (a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b)

instance (Multiplicative a) => P.Monoid (Product a) where
  mempty :: Product a
mempty = a -> Product a
forall a. a -> Product a
Product a
forall a. Multiplicative a => a
one

-- | Compute the product of a 'Data.Foldable.Foldable'.
--
-- >>> product [1..5]
-- 120
product :: (Multiplicative a, P.Foldable f) => f a -> a
product :: forall a (f :: * -> *). (Multiplicative a, Foldable f) => f a -> a
product = Product a -> a
forall a. Product a -> a
getProduct (Product a -> a) -> (f a -> Product a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. (a -> Product a) -> f a -> Product a
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
P.foldMap a -> Product a
forall a. a -> Product a
Product

-- | Compute the accumulating product of a 'Data.Traversable.Traversable'.
--
-- >>> accproduct [1..5]
-- [1,2,6,24,120]
accproduct :: (Multiplicative a, P.Traversable f) => f a -> f a
accproduct :: forall a (f :: * -> *).
(Multiplicative a, Traversable f) =>
f a -> f a
accproduct = (a, f a) -> f a
forall a b. (a, b) -> b
P.snd ((a, f a) -> f a) -> (f a -> (a, f a)) -> f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. (a -> a -> (a, a)) -> a -> f a -> (a, f a)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\a
a a
b -> (a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b, a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b)) a
forall a. Multiplicative a => a
one

-- | or [Division](https://en.wikipedia.org/wiki/Division_(mathematics\))
--
-- Though unusual, the term Divisive usefully fits in with the grammer of other classes and avoids name clashes that occur with some popular libraries.
--
-- prop> \(a :: Double) -> a / a ~= one || a == zero
-- prop> \(a :: Double) -> recip a ~= one / a || a == zero
-- prop> \(a :: Double) -> recip a * a ~= one || a == zero
-- prop> \(a :: Double) -> a * recip a ~= one || a == zero
--
-- >>> recip 2.0
-- 0.5
--
-- >>> 1 / 2
-- 0.5
class (Multiplicative a) => Divisive a where
  {-# MINIMAL (/) | recip #-}

  recip :: a -> a
  recip a
a = a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
a

  infixl 7 /

  (/) :: a -> a -> a
  (/) a
a a
b = a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. Divisive a => a -> a
recip a
b

instance Multiplicative Double where
  * :: Double -> Double -> Double
(*) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.*)
  one :: Double
one = Double
1.0

instance Divisive Double where
  recip :: Double -> Double
recip = Double -> Double
forall a. Fractional a => a -> a
P.recip

instance Multiplicative Float where
  * :: Float -> Float -> Float
(*) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(P.*)
  one :: Float
one = Float
1.0

instance Divisive Float where
  recip :: Float -> Float
recip = Float -> Float
forall a. Fractional a => a -> a
P.recip

instance Multiplicative Int where
  * :: Int -> Int -> Int
(*) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.*)
  one :: Int
one = Int
1

instance Multiplicative Integer where
  * :: Integer -> Integer -> Integer
(*) = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(P.*)
  one :: Integer
one = Integer
1

instance Multiplicative P.Bool where
  * :: Bool -> Bool -> Bool
(*) = Bool -> Bool -> Bool
(P.&&)
  one :: Bool
one = Bool
P.True

instance Multiplicative Natural where
  * :: Natural -> Natural -> Natural
(*) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(P.*)
  one :: Natural
one = Natural
1

instance Multiplicative Int8 where
  * :: Int8 -> Int8 -> Int8
(*) = Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(P.*)
  one :: Int8
one = Int8
1

instance Multiplicative Int16 where
  * :: Int16 -> Int16 -> Int16
(*) = Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(P.*)
  one :: Int16
one = Int16
1

instance Multiplicative Int32 where
  * :: Int32 -> Int32 -> Int32
(*) = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(P.*)
  one :: Int32
one = Int32
1

instance Multiplicative Int64 where
  * :: Int64 -> Int64 -> Int64
(*) = Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(P.*)
  one :: Int64
one = Int64
1

instance Multiplicative Word where
  * :: Word -> Word -> Word
(*) = Word -> Word -> Word
forall a. Num a => a -> a -> a
(P.*)
  one :: Word
one = Word
1

instance Multiplicative Word8 where
  * :: Word8 -> Word8 -> Word8
(*) = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(P.*)
  one :: Word8
one = Word8
1

instance Multiplicative Word16 where
  * :: Word16 -> Word16 -> Word16
(*) = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(P.*)
  one :: Word16
one = Word16
1

instance Multiplicative Word32 where
  * :: Word32 -> Word32 -> Word32
(*) = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(P.*)
  one :: Word32
one = Word32
1

instance Multiplicative Word64 where
  * :: Word64 -> Word64 -> Word64
(*) = Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(P.*)
  one :: Word64
one = Word64
1

instance (Multiplicative b) => Multiplicative (a -> b) where
  a -> b
f * :: (a -> b) -> (a -> b) -> a -> b
* a -> b
f' = \a
a -> a -> b
f a
a b -> b -> b
forall a. Multiplicative a => a -> a -> a
* a -> b
f' a
a
  one :: a -> b
one a
_ = b
forall a. Multiplicative a => a
one

instance (Divisive b) => Divisive (a -> b) where
  recip :: (a -> b) -> a -> b
recip a -> b
f = b -> b
forall a. Divisive a => a -> a
recip (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. a -> b
f