{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
#if ( __GLASGOW_HASKELL__ < 820 )
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
#endif
module NumHask.RangeD
( RangeD(..)
, normalise
) where
import NumHask.Prelude as P
import NumHask.Space
import NumHask.Range
import Test.QuickCheck.Arbitrary (Arbitrary(..))
newtype RangeD a = RangeD [Range a]
deriving (Eq, Generic, Show, Functor, Foldable, Traversable, Arbitrary)
instance NFData a => NFData (RangeD a)
normalise :: (Ord (Range a), Ord a, BoundedField a, FromInteger a) =>
RangeD a -> RangeD a
normalise (RangeD rs) = RangeD $ reverse $ foldl' step [] (sort rs)
where
step [] a = [a]
step (x:xs) a = (a `unify` x) <> xs
unify a b = bool (bool [a,b] [b,a] (a<b)) [a + b] (a `intersects` b)
instance (FromInteger a, Ord a, BoundedField a) => AdditiveMagma (RangeD a) where
plus (RangeD l0) (RangeD l1) = normalise $ RangeD $ l0 <> l1
instance (FromInteger a, Ord a, BoundedField a) => AdditiveUnital (RangeD a) where
zero = RangeD []
instance (FromInteger a, Ord a, BoundedField a) => AdditiveAssociative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => AdditiveInvertible (RangeD a) where
negate (RangeD rs) = normalise $ RangeD $ negate <$> rs
instance (FromInteger a, Ord a, BoundedField a) => AdditiveCommutative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => Additive (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => AdditiveGroup (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeMagma (RangeD a) where
times (RangeD a) (RangeD b) = normalise $ RangeD $ times <$> a <*> b
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeUnital (RangeD a) where
one = RangeD [one]
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeAssociative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeInvertible (RangeD a) where
recip (RangeD rs) = normalise $ RangeD $ recip <$> rs
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeCommutative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => Multiplicative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeGroup (RangeD a)