-- | Signs

{-# LANGUAGE CPP, BangPatterns #-}
module Math.Combinat.Sign where

--------------------------------------------------------------------------------

import Data.Monoid

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)     
import Data.Foldable
import Data.Semigroup
#endif

import System.Random

--------------------------------------------------------------------------------

data Sign
  = Plus                            -- hmm, this way @Plus < Minus@, not sure about that
  | Minus
  deriving (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq,Eq Sign
Eq Sign
-> (Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
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
min :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmax :: Sign -> Sign -> Sign
>= :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c< :: Sign -> Sign -> Bool
compare :: Sign -> Sign -> Ordering
$ccompare :: Sign -> Sign -> Ordering
$cp1Ord :: Eq Sign
Ord,Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show,ReadPrec [Sign]
ReadPrec Sign
Int -> ReadS Sign
ReadS [Sign]
(Int -> ReadS Sign)
-> ReadS [Sign] -> ReadPrec Sign -> ReadPrec [Sign] -> Read Sign
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sign]
$creadListPrec :: ReadPrec [Sign]
readPrec :: ReadPrec Sign
$creadPrec :: ReadPrec Sign
readList :: ReadS [Sign]
$creadList :: ReadS [Sign]
readsPrec :: Int -> ReadS Sign
$creadsPrec :: Int -> ReadS Sign
Read)

--------------------------------------------------------------------------------

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)        

instance Semigroup Sign where
  <> :: Sign -> Sign -> Sign
(<>)    = Sign -> Sign -> Sign
mulSign
  sconcat :: NonEmpty Sign -> Sign
sconcat = (Sign -> Sign -> Sign) -> NonEmpty Sign -> Sign
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Sign -> Sign -> Sign
mulSign

instance Monoid Sign where
  mempty :: Sign
mempty  = Sign
Plus
  mconcat :: [Sign] -> Sign
mconcat = [Sign] -> Sign
productOfSigns

#else

instance Monoid Sign where
  mempty  = Plus
  mappend = mulSign
  mconcat = productOfSigns

#endif

--------------------------------------------------------------------------------

instance Random Sign where
  random :: g -> (Sign, g)
random        g
g = let (Bool
b,g
g') = g -> (Bool, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g in (if Bool
b    then Sign
Plus else Sign
Minus, g
g')
  randomR :: (Sign, Sign) -> g -> (Sign, g)
randomR (Sign
u,Sign
v) g
g = let (Sign
y,g
g') = g -> (Sign, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g in (if Sign
uSign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
==Sign
v then Sign
u    else Sign
y    , g
g') 

isPlus, isMinus :: Sign -> Bool
isPlus :: Sign -> Bool
isPlus  Sign
s = case Sign
s of { Sign
Plus  -> Bool
True ; Sign
_ -> Bool
False }
isMinus :: Sign -> Bool
isMinus Sign
s = case Sign
s of { Sign
Minus -> Bool
True ; Sign
_ -> Bool
False }

{-# SPECIALIZE signValue :: Sign -> Int     #-}
{-# SPECIALIZE signValue :: Sign -> Integer #-}

-- | @+1@ or @-1@
signValue :: Num a => Sign -> a
signValue :: Sign -> a
signValue Sign
s = case Sign
s of 
  Sign
Plus  ->  a
1 
  Sign
Minus -> -a
1 

{-# SPECIALIZE signed :: Sign -> Int     -> Int     #-}
{-# SPECIALIZE signed :: Sign -> Integer -> Integer #-}

-- | Negate the second argument if the first is 'Minus'
signed :: Num a => Sign -> a -> a
signed :: Sign -> a -> a
signed Sign
s a
y = case Sign
s of
  Sign
Plus  -> a
y
  Sign
Minus -> a -> a
forall a. Num a => a -> a
negate a
y

{-# SPECIALIZE paritySign :: Int     -> Sign #-}
{-# SPECIALIZE paritySign :: Integer -> Sign #-}

-- | 'Plus' if even, 'Minus' if odd
paritySign :: Integral a => a -> Sign
paritySign :: a -> Sign
paritySign a
x = if a -> Bool
forall a. Integral a => a -> Bool
even a
x then Sign
Plus else Sign
Minus 

{-# SPECIALIZE paritySignValue :: Int     -> Integer #-}
{-# SPECIALIZE paritySignValue :: Integer -> Integer #-}

-- | @(-1)^k@
paritySignValue :: Integral a => a -> Integer
paritySignValue :: a -> Integer
paritySignValue a
k = if a -> Bool
forall a. Integral a => a -> Bool
odd a
k then (-Integer
1) else Integer
1

{-# SPECIALIZE negateIfOdd :: Int     -> Int     -> Int     #-}
{-# SPECIALIZE negateIfOdd :: Int     -> Integer -> Integer #-}

-- | Negate the second argument if the first is odd
negateIfOdd :: (Integral a, Num b) => a -> b -> b
negateIfOdd :: a -> b -> b
negateIfOdd a
k b
y = if a -> Bool
forall a. Integral a => a -> Bool
even a
k then b
y else b -> b
forall a. Num a => a -> a
negate b
y

oppositeSign :: Sign -> Sign
oppositeSign :: Sign -> Sign
oppositeSign Sign
s = case Sign
s of
  Sign
Plus  -> Sign
Minus
  Sign
Minus -> Sign
Plus

mulSign :: Sign -> Sign -> Sign
mulSign :: Sign -> Sign -> Sign
mulSign Sign
s1 Sign
s2 = case Sign
s1 of
  Sign
Plus  -> Sign
s2
  Sign
Minus -> Sign -> Sign
oppositeSign Sign
s2

productOfSigns :: [Sign] -> Sign
productOfSigns :: [Sign] -> Sign
productOfSigns = Sign -> [Sign] -> Sign
go Sign
Plus where
  go :: Sign -> [Sign] -> Sign
go !Sign
acc []     = Sign
acc
  go !Sign
acc (Sign
x:[Sign]
xs) = case Sign
x of
    Sign
Plus  -> Sign -> [Sign] -> Sign
go Sign
acc [Sign]
xs
    Sign
Minus -> Sign -> [Sign] -> Sign
go (Sign -> Sign
oppositeSign Sign
acc) [Sign]
xs

--------------------------------------------------------------------------------