Определение новых типов

-- Тип данных "интервал" с инфиксным конструктором :-:
data Interval a = a :-: a
-- Нормализация интервала
iNormalize :: Ord a => Interval a -> Interval a
iNormalize (x :-: y) = (min x y) :-: (max x y)
-- Селекторы для первого и второго поля интервала
iFirst :: Interval a -> a
iFirst (x :-: y) = x
iSecond :: Interval a -> a
iSecond (x :-: y) = y
-- Селекторы для начала и конца интервала
iStart :: Ord a => Interval a -> a
iStart i = iFirst (iNormalize i)
iEnd :: Ord a => Interval a -> a
iEnd i = iSecond (iNormalize i)
-- Предикат (инфиксный) для определения принадлежности x интервалу i
(<~) :: Ord a => a -> Interval a -> Bool
(<~) x i = (x >= iStart i) && (x <= iEnd i)
-- Длина интервала
iLength :: (Num a, Ord a) => Interval a -> a
iLength i = iEnd i - iStart i
-- Функция применения функции operation к интервалу i
iMap :: (Ord a, Ord b) => Interval b -> (b -> a) -> Interval a
iMap i operation =
iNormalize (operation (iStart i) :-: operation (iEnd i))
-- Расстояние между двумя интервалами
iDistance :: (Ord a, Num a) => Interval a -> Interval a -> a
iDistance i1 i2 =
max (abs (iStart i1 - iStart i2)) (abs (iEnd i1 - iEnd i2))
-- Назначение типа данных Interval экземпляром класса Eq
instance (Eq a, Ord a) => Eq (Interval a) where
(==) i1 i2 = (iStart i1 == iStart i2) && (iEnd i1 == iEnd i2)
(/=) i1 i2 = not (i1 == i2)
-- Назначение типа данных Interval экземпляром класса Show
instance (Show a, Ord a) => Show (Interval a) where
show i = show (iStart i) ++ " :-: " ++ show (iEnd i)
-- Назначение типа данных Interval экземпляром класса Num
instance (Num a, Ord a) => Num (Interval a) where
(+) i1 i2 = (iStart i1 + iStart i2) :-: (iEnd i1 + iEnd i2)
(-) i1 i2 = (iStart i1 - iEnd i2) :-: (iEnd i1 - iStart i2)
(*) (x1 :-: y1) (x2 :-: y2) =
let ac = x1 * x2
ad = x1 * y2
bc = y1 * x2
bd = y1 * y2
in iNormalize ((min ac ad) :-: (min bc bd))
negate i = (negate (iEnd i)) :-: (negate (iStart i))
abs (x :-: y) =
let ax = abs x
ay = abs y
in
if signum x == signum y then iNormalize (ax :-: ay)
else 0 :-: (max ax ay)
signum (x :-: y) =
let
sx = signum x
sy = signum y
in
iNormalize (sx :-: sy)
fromInteger x = (fromInteger x) :-: (fromInteger x)
-- Назначение типа данных Interval экземпляром класса Fractional
instance (Fractional a, Ord a) => Fractional (Interval a) where
(/) (x1 :-: y1) (i2 @ (x2 :-: y2)) =
if 0 <~ i2 then error "Division by zero"
else
let ac = x1 / x2
ad = x1 / y2
bc = y1 / x2
bd = y1 / y2
in iNormalize ((min ac ad) :-: (min bc bd))
fromRational x = (fromRational x) :-: (fromRational x)
-- Назначение типа данных Interval экземпляром класса Ord
instance (Ord a) => Ord (Interval a) where
(<) i1 i2 = iEnd i1 < iStart i2
(<=) i1 i2 = iEnd i1 <= iStart i2
(>) i1 i2 = i2 < i1
(>=) i1 i2 = i2 <= i1
compare i1 i2
| i1 <= i2 = LT
| i1 >= i2 = GT
| i1 == i2 = EQ
| otherwise = error "The intervals are non-comparable"
-------------------------------------------------------------------------------
-- ПРИМЕРЫ
-------------------------------------------------------------------------------
main = do
-- предопределяем три интервала
let i1 = (-12) :-: (-4)
let i2 = 16 :-: 8
let i3 = (-10) :-: 5
-- вывод значений первых двух интервалов
print $ i1
print $ i2
-- операции над интервалами
print $ 0 <~ i1
print $ 0 <~ i3
print $ 7 <~ i3
print $ iLength i1
print $ iLength i3
print $ iDistance i1 i3
print $ iMap i3 sin
-- арифметические операции над интервалами
print $ i1 + i2
print $ i1 - i3
print $ i3 * i1
print $ i3 / i1
-- смешанные арифметические операции
print $ 2 * i1
print $ i1 / 4
print $ i1 / (4 / 3)
-- операции сравнения интервалов
print $ i1 < i2
print $ i1 < i3
print $ i1 > i3
print $ compare i2 i3
print $ compare i1 i2
-- сравнение i1 и i3 с помощью compare приведет к ошибке
-- так как интервалы не сравнимы
-- можно раскомментировать следующую строку, чтобы в этом убедиться
-- print $ compare i1 i3
-- так как интервалу i3 принадлежит 0 то при делении на него
-- выйдет сообщение об ошибке
-- можно раскомментировать следующую строку, чтобы в этом убедиться
-- print $ i1 / i3