{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module NumHask.Data.Positive
( Positive (..),
positive,
maybePositive,
positive_,
Monus (..),
Addus (..),
MonusSemiField,
)
where
import Control.Category ((>>>))
import Data.Bool (bool)
import Data.Maybe
import NumHask.Algebra.Action
import NumHask.Algebra.Additive
import NumHask.Algebra.Field
import NumHask.Algebra.Lattice
import NumHask.Algebra.Metric
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import NumHask.Data.Integral
import NumHask.Data.Rational
import NumHask.Data.Wrapped
import Prelude (Eq, Ord, Show)
import Prelude qualified as P
newtype Positive a = UnsafePositive {forall a. Positive a -> a
unPositive :: a}
deriving stock
(Positive a -> Positive a -> Bool
(Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool) -> Eq (Positive a)
forall a. Eq a => Positive a -> Positive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Positive a -> Positive a -> Bool
== :: Positive a -> Positive a -> Bool
$c/= :: forall a. Eq a => Positive a -> Positive a -> Bool
/= :: Positive a -> Positive a -> Bool
Eq, Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Ordering)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> Ord (Positive a)
Positive a -> Positive a -> Bool
Positive a -> Positive a -> Ordering
Positive a -> Positive a -> Positive 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 (Positive a)
forall a. Ord a => Positive a -> Positive a -> Bool
forall a. Ord a => Positive a -> Positive a -> Ordering
forall a. Ord a => Positive a -> Positive a -> Positive a
$ccompare :: forall a. Ord a => Positive a -> Positive a -> Ordering
compare :: Positive a -> Positive a -> Ordering
$c< :: forall a. Ord a => Positive a -> Positive a -> Bool
< :: Positive a -> Positive a -> Bool
$c<= :: forall a. Ord a => Positive a -> Positive a -> Bool
<= :: Positive a -> Positive a -> Bool
$c> :: forall a. Ord a => Positive a -> Positive a -> Bool
> :: Positive a -> Positive a -> Bool
$c>= :: forall a. Ord a => Positive a -> Positive a -> Bool
>= :: Positive a -> Positive a -> Bool
$cmax :: forall a. Ord a => Positive a -> Positive a -> Positive a
max :: Positive a -> Positive a -> Positive a
$cmin :: forall a. Ord a => Positive a -> Positive a -> Positive a
min :: Positive a -> Positive a -> Positive a
Ord, Int -> Positive a -> ShowS
[Positive a] -> ShowS
Positive a -> String
(Int -> Positive a -> ShowS)
-> (Positive a -> String)
-> ([Positive a] -> ShowS)
-> Show (Positive a)
forall a. Show a => Int -> Positive a -> ShowS
forall a. Show a => [Positive a] -> ShowS
forall a. Show a => Positive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Positive a -> ShowS
showsPrec :: Int -> Positive a -> ShowS
$cshow :: forall a. Show a => Positive a -> String
show :: Positive a -> String
$cshowList :: forall a. Show a => [Positive a] -> ShowS
showList :: [Positive a] -> ShowS
Show)
deriving
( Positive a
Positive a -> Positive a -> Positive a
(Positive a -> Positive a -> Positive a)
-> Positive a -> Additive (Positive a)
forall a. Additive a => Positive a
forall a. Additive a => Positive a -> Positive a -> Positive a
forall a. (a -> a -> a) -> a -> Additive a
$c+ :: forall a. Additive a => Positive a -> Positive a -> Positive a
+ :: Positive a -> Positive a -> Positive a
$czero :: forall a. Additive a => Positive a
zero :: Positive a
Additive,
Positive a
Positive a -> Positive a -> Positive a
(Positive a -> Positive a -> Positive a)
-> Positive a -> Multiplicative (Positive a)
forall a. Multiplicative a => Positive a
forall a.
Multiplicative a =>
Positive a -> Positive a -> Positive a
forall a. (a -> a -> a) -> a -> Multiplicative a
$c* :: forall a.
Multiplicative a =>
Positive a -> Positive a -> Positive a
* :: Positive a -> Positive a -> Positive a
$cone :: forall a. Multiplicative a => Positive a
one :: Positive a
Multiplicative,
Multiplicative (Positive a)
Multiplicative (Positive a) =>
(Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> Divisive (Positive a)
Positive a -> Positive a
Positive a -> Positive a -> Positive a
forall a. Divisive a => Multiplicative (Positive a)
forall a. Divisive a => Positive a -> Positive a
forall a. Divisive a => Positive a -> Positive a -> Positive a
forall a.
Multiplicative a =>
(a -> a) -> (a -> a -> a) -> Divisive a
$crecip :: forall a. Divisive a => Positive a -> Positive a
recip :: Positive a -> Positive a
$c/ :: forall a. Divisive a => Positive a -> Positive a -> Positive a
/ :: Positive a -> Positive a -> Positive a
Divisive,
Distributive (Positive a)
Distributive (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> (Positive a, Positive a))
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> (Positive a, Positive a))
-> Integral (Positive a)
Positive a -> Positive a -> (Positive a, Positive a)
Positive a -> Positive a -> Positive a
forall a.
Distributive a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> Integral a
forall a. Integral a => Distributive (Positive a)
forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
forall a. Integral a => Positive a -> Positive a -> Positive a
$cdiv :: forall a. Integral a => Positive a -> Positive a -> Positive a
div :: Positive a -> Positive a -> Positive a
$cmod :: forall a. Integral a => Positive a -> Positive a -> Positive a
mod :: Positive a -> Positive a -> Positive a
$cdivMod :: forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
divMod :: Positive a -> Positive a -> (Positive a, Positive a)
$cquot :: forall a. Integral a => Positive a -> Positive a -> Positive a
quot :: Positive a -> Positive a -> Positive a
$crem :: forall a. Integral a => Positive a -> Positive a -> Positive a
rem :: Positive a -> Positive a -> Positive a
$cquotRem :: forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
quotRem :: Positive a -> Positive a -> (Positive a, Positive a)
Integral,
Integer -> Positive a
(Integer -> Positive a) -> FromInteger (Positive a)
forall a. FromInteger a => Integer -> Positive a
forall a. (Integer -> a) -> FromInteger a
$cfromInteger :: forall a. FromInteger a => Integer -> Positive a
fromInteger :: Integer -> Positive a
FromInteger,
Rational -> Positive a
(Rational -> Positive a) -> FromRational (Positive a)
forall a. FromRational a => Rational -> Positive a
forall a. (Rational -> a) -> FromRational a
$cfromRational :: forall a. FromRational a => Rational -> Positive a
fromRational :: Rational -> Positive a
FromRational,
Distributive (Mag (Positive a))
Distributive (Mag (Positive a)) =>
(Positive a -> Mag (Positive a))
-> (Positive a -> Base (Positive a)) -> Basis (Positive a)
Positive a -> Mag (Positive a)
Positive a -> Base (Positive a)
forall a.
Distributive (Mag a) =>
(a -> Mag a) -> (a -> Base a) -> Basis a
forall a. Basis a => Distributive (Mag (Positive a))
forall a. Basis a => Positive a -> Mag (Positive a)
forall a. Basis a => Positive a -> Base (Positive a)
$cmagnitude :: forall a. Basis a => Positive a -> Mag (Positive a)
magnitude :: Positive a -> Mag (Positive a)
$cbasis :: forall a. Basis a => Positive a -> Base (Positive a)
basis :: Positive a -> Base (Positive a)
Basis,
Distributive (Dir (Positive a))
Distributive (Positive a)
(Distributive (Positive a), Distributive (Dir (Positive a))) =>
(Positive a -> Dir (Positive a))
-> (Dir (Positive a) -> Positive a) -> Direction (Positive a)
Dir (Positive a) -> Positive a
Positive a -> Dir (Positive a)
forall coord.
(Distributive coord, Distributive (Dir coord)) =>
(coord -> Dir coord) -> (Dir coord -> coord) -> Direction coord
forall a. Direction a => Distributive (Dir (Positive a))
forall a. Direction a => Distributive (Positive a)
forall a. Direction a => Dir (Positive a) -> Positive a
forall a. Direction a => Positive a -> Dir (Positive a)
$cangle :: forall a. Direction a => Positive a -> Dir (Positive a)
angle :: Positive a -> Dir (Positive a)
$cray :: forall a. Direction a => Dir (Positive a) -> Positive a
ray :: Dir (Positive a) -> Positive a
Direction,
Eq (Positive a)
Additive (Positive a)
Positive a
(Eq (Positive a), Additive (Positive a)) =>
Positive a -> Epsilon (Positive a)
forall a. (Eq a, Additive a) => a -> Epsilon a
forall a. Epsilon a => Eq (Positive a)
forall a. Epsilon a => Additive (Positive a)
forall a. Epsilon a => Positive a
$cepsilon :: forall a. Epsilon a => Positive a
epsilon :: Positive a
Epsilon,
Additive (AdditiveScalar (Positive a))
Additive (AdditiveScalar (Positive a)) =>
(Positive a -> AdditiveScalar (Positive a) -> Positive a)
-> AdditiveAction (Positive a)
Positive a -> AdditiveScalar (Positive a) -> Positive a
forall m.
Additive (AdditiveScalar m) =>
(m -> AdditiveScalar m -> m) -> AdditiveAction m
forall a.
AdditiveAction a =>
Additive (AdditiveScalar (Positive a))
forall a.
AdditiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
$c|+ :: forall a.
AdditiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
|+ :: Positive a -> AdditiveScalar (Positive a) -> Positive a
AdditiveAction,
Subtractive (AdditiveScalar (Positive a))
AdditiveAction (Positive a)
(AdditiveAction (Positive a),
Subtractive (AdditiveScalar (Positive a))) =>
(Positive a -> AdditiveScalar (Positive a) -> Positive a)
-> SubtractiveAction (Positive a)
Positive a -> AdditiveScalar (Positive a) -> Positive a
forall a.
SubtractiveAction a =>
Subtractive (AdditiveScalar (Positive a))
forall a. SubtractiveAction a => AdditiveAction (Positive a)
forall a.
SubtractiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
forall m.
(AdditiveAction m, Subtractive (AdditiveScalar m)) =>
(m -> AdditiveScalar m -> m) -> SubtractiveAction m
$c|- :: forall a.
SubtractiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
|- :: Positive a -> AdditiveScalar (Positive a) -> Positive a
SubtractiveAction,
Multiplicative (Scalar (Positive a))
Multiplicative (Scalar (Positive a)) =>
(Positive a -> Scalar (Positive a) -> Positive a)
-> MultiplicativeAction (Positive a)
Positive a -> Scalar (Positive a) -> Positive a
forall m.
Multiplicative (Scalar m) =>
(m -> Scalar m -> m) -> MultiplicativeAction m
forall a.
MultiplicativeAction a =>
Multiplicative (Scalar (Positive a))
forall a.
MultiplicativeAction a =>
Positive a -> Scalar (Positive a) -> Positive a
$c|* :: forall a.
MultiplicativeAction a =>
Positive a -> Scalar (Positive a) -> Positive a
|* :: Positive a -> Scalar (Positive a) -> Positive a
MultiplicativeAction,
Divisive (Scalar (Positive a))
MultiplicativeAction (Positive a)
(Divisive (Scalar (Positive a)),
MultiplicativeAction (Positive a)) =>
(Positive a -> Scalar (Positive a) -> Positive a)
-> DivisiveAction (Positive a)
Positive a -> Scalar (Positive a) -> Positive a
forall m.
(Divisive (Scalar m), MultiplicativeAction m) =>
(m -> Scalar m -> m) -> DivisiveAction m
forall a. DivisiveAction a => Divisive (Scalar (Positive a))
forall a. DivisiveAction a => MultiplicativeAction (Positive a)
forall a.
DivisiveAction a =>
Positive a -> Scalar (Positive a) -> Positive a
$c|/ :: forall a.
DivisiveAction a =>
Positive a -> Scalar (Positive a) -> Positive a
|/ :: Positive a -> Scalar (Positive a) -> Positive a
DivisiveAction,
Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> JoinSemiLattice (Positive a)
Positive a -> Positive a -> Positive a
forall a. Eq a => (a -> a -> a) -> JoinSemiLattice a
forall a. JoinSemiLattice a => Eq (Positive a)
forall a.
JoinSemiLattice a =>
Positive a -> Positive a -> Positive a
$c\/ :: forall a.
JoinSemiLattice a =>
Positive a -> Positive a -> Positive a
\/ :: Positive a -> Positive a -> Positive a
JoinSemiLattice,
Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> MeetSemiLattice (Positive a)
Positive a -> Positive a -> Positive a
forall a. Eq a => (a -> a -> a) -> MeetSemiLattice a
forall a. MeetSemiLattice a => Eq (Positive a)
forall a.
MeetSemiLattice a =>
Positive a -> Positive a -> Positive a
$c/\ :: forall a.
MeetSemiLattice a =>
Positive a -> Positive a -> Positive a
/\ :: Positive a -> Positive a -> Positive a
MeetSemiLattice,
MeetSemiLattice (Positive a)
Positive a
MeetSemiLattice (Positive a) =>
Positive a -> BoundedMeetSemiLattice (Positive a)
forall a. BoundedMeetSemiLattice a => MeetSemiLattice (Positive a)
forall a. BoundedMeetSemiLattice a => Positive a
forall a. MeetSemiLattice a => a -> BoundedMeetSemiLattice a
$ctop :: forall a. BoundedMeetSemiLattice a => Positive a
top :: Positive a
BoundedMeetSemiLattice
)
via (Wrapped a)
instance (MeetSemiLattice a, Integral a) => FromIntegral (Positive a) a where
fromIntegral :: a -> Positive a
fromIntegral a
a = a -> Positive a
forall a. (Additive a, MeetSemiLattice a) => a -> Positive a
positive a
a
instance (FromIntegral a b) => FromIntegral (Positive a) b where
fromIntegral :: b -> Positive a
fromIntegral b
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (b -> a
forall a b. FromIntegral a b => b -> a
fromIntegral b
a)
instance (ToIntegral a b) => ToIntegral (Positive a) b where
toIntegral :: Positive a -> b
toIntegral (UnsafePositive a
a) = a -> b
forall a b. ToIntegral a b => a -> b
toIntegral a
a
instance (FromRatio a b) => FromRatio (Positive a) b where
fromRatio :: Ratio b -> Positive a
fromRatio Ratio b
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (Ratio b -> a
forall a b. FromRatio a b => Ratio b -> a
fromRatio Ratio b
a)
instance (ToRatio a b) => ToRatio (Positive a) b where
toRatio :: Positive a -> Ratio b
toRatio (UnsafePositive a
a) = a -> Ratio b
forall a b. ToRatio a b => a -> Ratio b
toRatio a
a
instance (Additive a, JoinSemiLattice a) => BoundedJoinSemiLattice (Positive a) where
bottom :: Positive a
bottom = a -> Positive a
forall a. a -> Positive a
UnsafePositive a
forall a. Additive a => a
zero
instance QuotientField (Positive P.Double) where
type Whole (Positive P.Double) = Positive P.Int
properFraction :: Positive Double -> (Whole (Positive Double), Positive Double)
properFraction (UnsafePositive Double
a) = (\(Int
n, Double
r) -> (Int -> Positive Int
forall a. a -> Positive a
UnsafePositive Int
n, Double -> Positive Double
forall a. a -> Positive a
UnsafePositive Double
r)) (Double -> (Int, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
a)
ceiling :: Positive Double -> Whole (Positive Double)
ceiling = Positive Double -> (Whole (Positive Double), Positive Double)
forall a. QuotientField a => a -> (Whole a, a)
properFraction (Positive Double -> (Whole (Positive Double), Positive Double))
-> ((Whole (Positive Double), Positive Double) -> Positive Int)
-> Positive Double
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Whole (Positive Double), Positive Double) -> Positive Int
(Positive Int, Positive Double) -> Positive Int
forall a b. (a, b) -> a
P.fst ((Whole (Positive Double), Positive Double) -> Positive Int)
-> (Positive Int -> Positive Int)
-> (Whole (Positive Double), Positive Double)
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one)
floor :: Positive Double -> Whole (Positive Double)
floor = Positive Double -> (Whole (Positive Double), Positive Double)
forall a. QuotientField a => a -> (Whole a, a)
properFraction (Positive Double -> (Whole (Positive Double), Positive Double))
-> ((Whole (Positive Double), Positive Double) -> Positive Int)
-> Positive Double
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Whole (Positive Double), Positive Double) -> Positive Int
(Positive Int, Positive Double) -> Positive Int
forall a b. (a, b) -> a
P.fst
truncate :: Positive Double -> Whole (Positive Double)
truncate = Positive Double -> Whole (Positive Double)
forall a. QuotientField a => a -> Whole a
floor
round :: Positive Double -> Whole (Positive Double)
round Positive Double
x = case Positive Double -> (Whole (Positive Double), Positive Double)
forall a. QuotientField a => a -> (Whole a, a)
properFraction Positive Double
x of
(Whole (Positive Double)
n, Positive Double
r) ->
let half_up :: Positive Double
half_up = Positive Double
r Positive Double -> Positive Double -> Positive Double
forall a. Additive a => a -> a -> a
+ Positive Double
forall a. (Additive a, Divisive a) => a
half
in case Positive Double -> Positive Double -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare Positive Double
half_up Positive Double
forall a. Multiplicative a => a
one of
Ordering
P.LT -> Whole (Positive Double)
n
Ordering
P.EQ -> Positive Int -> Positive Int -> Bool -> Positive Int
forall a. a -> a -> Bool -> a
bool (Whole (Positive Double)
Positive Int
n Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one) Whole (Positive Double)
Positive Int
n (Positive Int -> Bool
forall a. (Eq a, Integral a) => a -> Bool
even Whole (Positive Double)
Positive Int
n)
Ordering
P.GT -> Whole (Positive Double)
Positive Int
n Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one
positive :: (Additive a, MeetSemiLattice a) => a -> Positive a
positive :: forall a. (Additive a, MeetSemiLattice a) => a -> Positive a
positive a
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (a
a a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
forall a. Additive a => a
zero)
positive_ :: a -> Positive a
positive_ :: forall a. a -> Positive a
positive_ = a -> Positive a
forall a. a -> Positive a
UnsafePositive
maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a)
maybePositive :: forall a.
(Additive a, MeetSemiLattice a) =>
a -> Maybe (Positive a)
maybePositive a
a = Maybe (Positive a)
-> Maybe (Positive a) -> Bool -> Maybe (Positive a)
forall a. a -> a -> Bool -> a
bool Maybe (Positive a)
forall a. Maybe a
Nothing (Positive a -> Maybe (Positive a)
forall a. a -> Maybe a
Just (a -> Positive a
forall a. a -> Positive a
UnsafePositive a
a)) (a
a a -> a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` a
forall a. Additive a => a
zero)
instance (Subtractive a, MeetSemiLattice a) => Monus (Positive a) where
(UnsafePositive a
a) ∸ :: Positive a -> Positive a -> Positive a
∸ (UnsafePositive a
b) = a -> Positive a
forall a. (Additive a, MeetSemiLattice a) => a -> Positive a
positive (a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b)
type MonusSemiField a = (Monus a, Distributive a, Divisive a)
class Monus a where
{-# MINIMAL (∸) #-}
infixl 6 ∸
(∸) :: a -> a -> a
default (∸) :: (BoundedJoinSemiLattice a, MeetSemiLattice a, Subtractive a) => a -> a -> a
a
a ∸ a
b = a
forall a. BoundedJoinSemiLattice a => a
bottom a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ (a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b)
class Addus a where
{-# MINIMAL (∔) #-}
infixl 6 ∔
(∔) :: a -> a -> a
default (∔) :: (BoundedMeetSemiLattice a, JoinSemiLattice a, Additive a) => a -> a -> a
a
a ∔ a
b = a
forall a. BoundedMeetSemiLattice a => a
top a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ (a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b)