module Main where           -- Some test on Kernels

-- -----------------kernels--LA--csse--Monash--.au--7/2005--
class Kernel t where
  k :: t -> t -> Double                    --kernel function
  d :: t -> t -> Double                           --distance
  d x y = sqrt( k x x  -  2 * k x y  +  k y y )    --default

-- --------------------------------------some-standard-fns--
matching x y = if x==y then 1.0 else 0.0

innerProduct2 (x1,x2)    (y1,y2)    = x1*x2 + y1*y2   -- x.y
innerProduct3 (x1,x2,x3) (y1,y2,y3) = x1*x2 + y1*y2 + x2*y3

poly l p  k x y = ( k x y + l ) ** p  --the "polynomial" kernel

normalise k x y = k x y / sqrt( k x x * k y y )

-- ----------------------------------------------instances--
instance Kernel Bool where k = matching    -- Bool

instance Kernel Int where  k = matching    -- Int

instance Kernel Char where k = matching    -- Char

instance Kernel Double where  k x y = x*y  -- Double

-- ghc doesn't like the next alternative without
-- ghc -fglasgow-exts
-- instance Kernel (Double,Double) where k = innerProduct2  -- (D,D)
-- but...
-- ghc (plain) accepts this alternative...
instance (Kernel t, Kernel u) => Kernel (t,u) where  -- pair (t,u)
  k (x1,x2) (y1,y2) = k x1 y1  +  k x2 y2

instance (Kernel t) => Kernel [t] where    -- [t], i.e. list of t
  k [] [] = 1.0
  k [] _  = 0.0
  k _  [] = 0.0
  k (x:xs) (y:ys) = 1.0 + k x y + k xs ys
  
data Coord = Coord Double Double    -- e.g. 2-D coordinates

instance Kernel Coord where            -- make up something
  k (Coord x1 x2) (Coord y1 y2) =
    normalise (poly 1.0 2 innerProduct2) (x1,x2) (y1,y2)   -- say

-- --------------------------------------------------tests--
l1 = [1::Int, 2, 3]
l2 = [1, 4]
r1 = (1.0, 2.0) :: (Double,Double)
r2 = (3.0, 4.0) :: (Double,Double)
c1 = Coord 1.0 2.0
c2 = Coord 3.0 4.0
main = putStrLn "Kernel tests, L.Allison, CSSE, Monash, .au, 7/2005"
 >> putStrLn( "[Bool] : " ++ show( k [True] [True,False] ) )
 >> putStrLn( "[Int]  : " ++
    show( [(k l1 l1, d l1 l1), (k l1 l2, d l1 l2), (k l2 l2, d l2 l2)] ) )
 >> putStrLn( "Strings: " ++
    show( [k ("John", "Smith") ("Jon", "Smythe"),
           k ("John", "Smith") ("Fred", "Bloggs") ] ) )
 >> putStrLn( "(Double,Double) : " ++
    show( [(k r1 r1, d r1 r1), (k r1 r2, d r1 r2), (k r2 r2, d r2 r2)] ) )
 >> putStrLn( "Coord  : " ++ show[ k c1 c1, k c1 c2, k c2 c2] ) 
-- ----------------------------------------------------------
-- for use with:  L.Allison, J.Func.Prog. 15(1) pp.15-32 2005
--                http://dx.doi.org/10.1017/S0956796804005301
-- ----------------------------------------------------------