6

{-# LANGUAGE FlexibleInstances, TypeFamilies #-}

import Data.Ratio   -- рациональные числа
import Data.Complex -- комплексные числа
-- Класс абелевой группы
class AbelGroup a where
  (^+^) :: a -> a -> a
  zero :: a
  negate' :: a -> a
  negate' a = zero ^-^ a
  (^-^) :: a -> a -> a
  (^-^) el1 el2 = el1 ^+^ negate' el2

---------------------------------------------
-- Класс линейного пространства над числовым полем типа Numeric a
class AbelGroup a => LinearSpace a where
  type Numeric a :: *     -- Numeric - тип числового поля
  (^*^) :: Numeric a -> a -> a


--- Тип векторов
data TVector = Vector { x::Double, y::Double }
  deriving(Eq,Ord)

instance Show TVector where
  show (Vector x y) = "(" ++ show x ++ ";" ++ show y ++ ")"

instance AbelGroup TVector where
  (Vector x1 y1) ^+^ (Vector x2 y2) =
      Vector (x1+x2) (y1+y2)
  zero = Vector 0 0
  negate' (Vector x y) = Vector (-x) (-y)

instance LinearSpace TVector where
  type Numeric TVector = Double
  a ^*^ v = Vector (a*x v) (a*y v)


class LinearSpace a => HilbertSpace a where
  (%) ::  a -> a -> Numeric a

instance HilbertSpace TVector where
  (Vector x1 y1) % (Vector x2 y2) =  (x1)*(x2) + (y1)*(y2)


data TRealFunc = RealFunc (Double->Double)
(^$^) :: TRealFunc -> Double -> Double
(RealFunc f) ^$^ x = f x

instance AbelGroup TRealFunc where
  (RealFunc f1) ^+^ (RealFunc f2) =
      RealFunc (\x -> f1 x + f2 x)
  zero = RealFunc (\_ -> 0)
  negate' (RealFunc f) = RealFunc (\x -> -f x)

instance LinearSpace TRealFunc where
  type Numeric TRealFunc = Double
  a ^*^ (RealFunc f) = RealFunc (\x -> a*f x)

instance HilbertSpace TRealFunc where
 (RealFunc f1) % (RealFunc f2) =
  sum $ map (\x -> (f1 x)*(f2 x)*(1/100)) [1/100,2/100..100/100]

class MyMonoid a  where
  (^**^) :: a -> a -> a
  neutral :: a

instance MyMonoid [a] where
 l1 ^**^ l2 = l1 ++ l2
 neutral = []