{-# LANGUAGE Safe,GADTs, TypeFamilies #-}
 module Math.Tools.Median where
 import Data.Ratio
 import Math.Tools.Adjunction (swap)
 import Math.Matrix.Interface

 -- | Rules expected of MedianAlgebra.
 --
 -- From "Knuth: The Art of Computer Programming" section 7.1.1 <http://www-cs-faculty.stanford.edu/~uno/taocp.html>
 -- 
 -- === "median/majority"
 --
 -- prop>     med x x y == x
 --
 -- === "median/commutative"
 --
 -- prop> med x y z == med x z y
 -- prop> med x y z == med y z x
 -- prop> med x y z == med z x y
 -- prop> med x y z == med z y x
 --  
 -- === "median/associative"
 --
 -- prop> med x w (med y w z) == med (med x w y) w z
 --
 -- === "median/distributive"
 --
 -- prop> med (med x y z) u v == med x (med y u v) (med z u v)
 --
 class (Ord m) => MedianAlgebra m where
    med :: m -> m -> m -> m

 median5 :: (MedianAlgebra a) => a -> a -> a -> a -> a -> a
 median5 :: forall a. MedianAlgebra a => a -> a -> a -> a -> a -> a
median5 a
v a
w a
x a
y a
z = a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
v (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x a
y a
z) (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
w a
x (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
w a
y a
z))

 median :: (Ord a) => a -> a -> a -> a
 median :: forall a. Ord a => a -> a -> a -> a
median a
x a
y a
z = (a
x a -> a -> a
forall a. Ord a => a -> a -> a
`min` a
y) a -> a -> a
forall a. Ord a => a -> a -> a
`max` (a
y a -> a -> a
forall a. Ord a => a -> a -> a
`min` a
z) a -> a -> a
forall a. Ord a => a -> a -> a
`max` (a
x a -> a -> a
forall a. Ord a => a -> a -> a
`min` a
z)

 instance (MedianAlgebra a) => MedianAlgebra [a] where
    med :: [a] -> [a] -> [a] -> [a]
med [a]
a  [] []= []
    med [] [a]
a  []= []
    med [] [] [a]
a = []
    med (a
c:[a]
cr) (a
d:[a]
dr) []  = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
c a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Ord a => a -> a -> a
min [a]
cr [a]
dr)
    med [] (a
c:[a]
cr) (a
d:[a]
dr)  = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
c a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Ord a => a -> a -> a
min [a]
cr [a]
dr)
    med (a
c:[a]
cr) [] (a
d:[a]
dr)  = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
c a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Ord a => a -> a -> a
min [a]
cr [a]
dr)
    med (a
c:[a]
cr) (a
d:[a]
dr) (a
e:[a]
er) = (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
c a
d a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall m. MedianAlgebra m => m -> m -> m -> m
med [a]
cr [a]
dr [a]
er)

 instance MedianAlgebra Bool where { med :: Bool -> Bool -> Bool -> Bool
med = Bool -> Bool -> Bool -> Bool
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Integer where { med :: Integer -> Integer -> Integer -> Integer
med = Integer -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Float where { med :: Float -> Float -> Float -> Float
med = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Double where { med :: Double -> Double -> Double -> Double
med = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Int where { med :: Int -> Int -> Int -> Int
med = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Char where { med :: Char -> Char -> Char -> Char
med = Char -> Char -> Char -> Char
forall a. Ord a => a -> a -> a -> a
median }
 instance MedianAlgebra Ordering where { med :: Ordering -> Ordering -> Ordering -> Ordering
med = Ordering -> Ordering -> Ordering -> Ordering
forall a. Ord a => a -> a -> a -> a
median }
 instance (Integral a) => MedianAlgebra (Ratio a) where { med :: Ratio a -> Ratio a -> Ratio a -> Ratio a
med = Ratio a -> Ratio a -> Ratio a -> Ratio a
forall a. Ord a => a -> a -> a -> a
median }
 instance (MedianAlgebra a, MedianAlgebra b) => MedianAlgebra (a,b) where
   med :: (a, b) -> (a, b) -> (a, b) -> (a, b)
med (a
x1,b
x2) (a
y1,b
y2) (a
z1,b
z2) = (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x1 a
y1 a
z1,b -> b -> b -> b
forall m. MedianAlgebra m => m -> m -> m -> m
med b
x2 b
y2 b
z2) 
 instance (MedianAlgebra a, MedianAlgebra b, MedianAlgebra c) => MedianAlgebra (a,b,c) where
   med :: (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c)
med (a
x1,b
x2,c
x3) (a
y1,b
y2,c
y3) (a
z1,b
z2,c
z3) = (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x1 a
y1 a
z1, b -> b -> b -> b
forall m. MedianAlgebra m => m -> m -> m -> m
med b
x2 b
y2 b
z2, c -> c -> c -> c
forall m. MedianAlgebra m => m -> m -> m -> m
med c
x3 c
y3 c
z3)
 instance (MedianAlgebra a, MedianAlgebra b, MedianAlgebra c, MedianAlgebra d) => MedianAlgebra (a,b,c,d) where
   med :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
med (a
x1,b
x2,c
x3,d
x4) (a
y1,b
y2,c
y3,d
y4) (a
z1,b
z2,c
z3,d
z4) = (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x1 a
y1 a
z1, b -> b -> b -> b
forall m. MedianAlgebra m => m -> m -> m -> m
med b
x2 b
y2 b
z2, c -> c -> c -> c
forall m. MedianAlgebra m => m -> m -> m -> m
med c
x3 c
y3 c
z3, d -> d -> d -> d
forall m. MedianAlgebra m => m -> m -> m -> m
med d
x4 d
y4 d
z4)
 instance (MedianAlgebra a, MedianAlgebra b, MedianAlgebra c, MedianAlgebra d, MedianAlgebra e) => MedianAlgebra (a,b,c,d,e) where
   med :: (a, b, c, d, e)
-> (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
med (a
x1,b
x2,c
x3,d
x4,e
x5) (a
y1,b
y2,c
y3,d
y4,e
y5) (a
z1,b
z2,c
z3,d
z4,e
z5) = (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x1 a
y1 a
z1, b -> b -> b -> b
forall m. MedianAlgebra m => m -> m -> m -> m
med b
x2 b
y2 b
z2, c -> c -> c -> c
forall m. MedianAlgebra m => m -> m -> m -> m
med c
x3 c
y3 c
z3, d -> d -> d -> d
forall m. MedianAlgebra m => m -> m -> m -> m
med d
x4 d
y4 d
z4, e -> e -> e -> e
forall m. MedianAlgebra m => m -> m -> m -> m
med e
x5 e
y5 e
z5)

 data Interval a = Interval { forall a. Interval a -> a
interval_startpoint :: a,
                              forall a. Interval a -> a
interval_endpoint   :: a }

 instance (Show a) => Show (Interval a) where
   show :: Interval a -> String
show (Interval a
a a
b) = (a, a) -> String
forall a. Show a => a -> String
show (a
a,a
b)

 instance Functor Interval where
   fmap :: forall a b. (a -> b) -> Interval a -> Interval b
fmap a -> b
f (Interval a
a a
b) = b -> b -> Interval b
forall a. a -> a -> Interval a
Interval (a -> b
f a
a) (a -> b
f a
b)

 instance Applicative Interval where
    pure :: forall a. a -> Interval a
pure a
x = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
x a
x
    (Interval a -> b
fa a -> b
fb) <*> :: forall a b. Interval (a -> b) -> Interval a -> Interval b
<*> (Interval a
xa a
xb) = b -> b -> Interval b
forall a. a -> a -> Interval a
Interval (a -> b
fa a
xa) (a -> b
fb a
xb)

 instance Monad Interval where
    return :: forall a. a -> Interval a
return a
x = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
x a
x
    (Interval a
a a
b) >>= :: forall a b. Interval a -> (a -> Interval b) -> Interval b
>>= a -> Interval b
f = b -> b -> Interval b
forall a. a -> a -> Interval a
Interval b
a' b
b''
      where Interval b
a' b
_   = a -> Interval b
f a
a
            Interval b
_  b
b'' = a -> Interval b
f a
b

 instance MonadFail Interval where
    fail :: forall a. String -> Interval a
fail String
msg = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (String -> a
forall a. HasCallStack => String -> a
error String
msg) (String -> a
forall a. HasCallStack => String -> a
error String
msg)

 instance (Num a) => VectorSpace (Interval a) where
   type Scalar (Interval a) = a
   vzero :: Interval a
vzero = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
0 a
0
   vnegate :: Interval a -> Interval a
vnegate (Interval a
x a
y) = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
y a
x
   (Interval a
x a
y) %+ :: Interval a -> Interval a -> Interval a
%+ (Interval a
x' a
y') = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
y')
   Scalar (Interval a)
x %* :: Scalar (Interval a) -> Interval a -> Interval a
%* (Interval a
a a
b) = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a
Scalar (Interval a)
x a -> a -> a
forall a. Num a => a -> a -> a
* a
a) (a
Scalar (Interval a)
x a -> a -> a
forall a. Num a => a -> a -> a
* a
b)

 instance (Num a) => NormedSpace (Interval a) where
   norm :: Interval a -> Scalar (Interval a)
norm (Interval a
a a
b) = a -> a
forall a. Num a => a -> a
abs (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a)
   normSquared :: Interval a -> Scalar (Interval a)
normSquared (Interval a
a a
b) = let d :: a
d = a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a in a
da -> a -> a
forall a. Num a => a -> a -> a
*a
d

 instance (Num a) => InnerProductSpace (Interval a) where
   (Interval a
a a
b) %. :: Interval a -> Interval a -> Scalar (Interval a)
%. (Interval a
a' a
b') = (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
a)a -> a -> a
forall a. Num a => a -> a -> a
*(a
b'a -> a -> a
forall a. Num a => a -> a -> a
-a
a')

 inInterval :: (Eq a, MedianAlgebra a) => a -> Interval a -> Bool
 inInterval :: forall a. (Eq a, MedianAlgebra a) => a -> Interval a -> Bool
inInterval a
x (Interval a
u a
v) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x a
u a
v
  
 interval :: (Monad m, MedianAlgebra a) => Interval a -> m a -> m a
 interval :: forall (m :: * -> *) a.
(Monad m, MedianAlgebra a) =>
Interval a -> m a -> m a
interval (Interval a
u a
v) m a
m = m a
m m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x a
u a
v)

 medianHomomorphism :: (MedianAlgebra a) => Interval a -> a -> a
 medianHomomorphism :: forall a. MedianAlgebra a => Interval a -> a -> a
medianHomomorphism (Interval a
u a
v) a
x = a -> a -> a -> a
forall m. MedianAlgebra m => m -> m -> m -> m
med a
x a
u a
v

 instance (Num a, Ord a) => Num (Interval a) where
   (Interval a
a a
b) + :: Interval a -> Interval a -> Interval a
+ (Interval a
a' a
b') = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
a') (a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
b')
   (Interval a
a a
b) * :: Interval a -> Interval a -> Interval a
* (Interval a
a' a
b') = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
a') (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
b')
   (Interval a
a a
b) - :: Interval a -> Interval a -> Interval a
- (Interval a
a' a
b') = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
a') (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
b')
   negate :: Interval a -> Interval a
negate (Interval a
a a
b) = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
b a
a
   abs :: Interval a -> Interval a
abs (Interval a
a a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b    = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
b a
a
                      | Bool
otherwise = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
a a
b
   signum :: Interval a -> Interval a
signum (Interval a
a a
b) = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (a -> a
forall a. Num a => a -> a
signum a
a) (a -> a
forall a. Num a => a -> a
signum a
b)
   fromInteger :: Integer -> Interval a
fromInteger Integer
i = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i)


 -- | andor is same as \ (x,y) -> (x && y, x || y), thus the name, except
 -- that the type 'b' is more general. Thus if both 'and' and 'or' are combined,
 -- sorting of the pair occurs.

 andor :: (Ord a) => (a,a) -> (a,a)
 andor :: forall a. Ord a => (a, a) -> (a, a)
andor (a
x,a
y) = (if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y then (a, a) -> (a, a)
forall a. a -> a
id else (a, a) -> (a, a)
forall b a. (b, a) -> (a, b)
swap) (a
x,a
y)

 andor' :: (Ord a) => (a,a) -> (a,a)
 andor' :: forall a. Ord a => (a, a) -> (a, a)
andor' (a
x,a
y) = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y, a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)

 andor3 :: (Ord a) => (a,a,a) -> (a,a,a)
 andor3 :: forall a. Ord a => (a, a, a) -> (a, a, a)
andor3 (a
x,a
y,a
z) = (a
x'',a
y''',a
z')
   where (a
x',a
y') = (a, a) -> (a, a)
forall a. Ord a => (a, a) -> (a, a)
andor (a
x,a
y)
         (a
y'',a
z') = (a, a) -> (a, a)
forall a. Ord a => (a, a) -> (a, a)
andor (a
y',a
z)
         (a
x'',a
y''') = (a, a) -> (a, a)
forall a. Ord a => (a, a) -> (a, a)
andor (a
x',a
y'')