{-# LINE 1 "Data/SVM/Raw.hsc" #-}
{-|This is a module with raw bindings to libsvm
-}

{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving, 
             EmptyDataDecls #-}





{-# LINE 13 "Data/SVM/Raw.hsc" #-}

module Data.SVM.Raw where

import Foreign.Storable (Storable(..), peekByteOff, pokeByteOff)
import Foreign.C.Types (CDouble (..), CInt (..))
import Foreign.C.String (CString)
import Foreign.Ptr(nullPtr, Ptr, FunPtr)
import Foreign.ForeignPtr (FinalizerPtr)

data CSvmNode = CSvmNode { 
    CSvmNode -> CInt
index:: CInt,
    CSvmNode -> CDouble
value:: CDouble 
}

instance Storable CSvmNode where
    sizeOf :: CSvmNode -> Int
sizeOf CSvmNode
_ = (Int
16)
{-# LINE 29 "Data/SVM/Raw.hsc" #-}
    alignment _ = 8
{-# LINE 30 "Data/SVM/Raw.hsc" #-}
    peek ptr = do idx <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 31 "Data/SVM/Raw.hsc" #-}
                  val <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 32 "Data/SVM/Raw.hsc" #-}
                  return $ CSvmNode idx val
    poke :: Ptr CSvmNode -> CSvmNode -> IO ()
poke Ptr CSvmNode
ptr (CSvmNode CInt
i CDouble
v) = do ((\Ptr CSvmNode
hsc_ptr -> Ptr CSvmNode -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmNode
hsc_ptr Int
0)) Ptr CSvmNode
ptr CInt
i
{-# LINE 34 "Data/SVM/Raw.hsc" #-}
                                 ((\Ptr CSvmNode
hsc_ptr -> Ptr CSvmNode -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmNode
hsc_ptr Int
8)) Ptr CSvmNode
ptr CDouble
v
{-# LINE 35 "Data/SVM/Raw.hsc" #-}

data CSvmProblem = CSvmProblem {
    CSvmProblem -> CInt
l:: CInt,
    CSvmProblem -> Ptr CDouble
y:: Ptr CDouble,
    CSvmProblem -> Ptr (Ptr CSvmNode)
x:: Ptr (Ptr CSvmNode)
}       

instance Storable CSvmProblem where
    sizeOf :: CSvmProblem -> Int
sizeOf CSvmProblem
_ = (Int
24)
{-# LINE 44 "Data/SVM/Raw.hsc" #-}
    alignment _ = 8
{-# LINE 45 "Data/SVM/Raw.hsc" #-}
    peek ptr = do lp <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 46 "Data/SVM/Raw.hsc" #-}
                  yp <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 47 "Data/SVM/Raw.hsc" #-}
                  xp <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 48 "Data/SVM/Raw.hsc" #-}
                  return $ CSvmProblem lp yp xp
    poke :: Ptr CSvmProblem -> CSvmProblem -> IO ()
poke Ptr CSvmProblem
ptr (CSvmProblem CInt
lp Ptr CDouble
yp Ptr (Ptr CSvmNode)
xp) = do ((\Ptr CSvmProblem
hsc_ptr -> Ptr CSvmProblem -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmProblem
hsc_ptr Int
0)) Ptr CSvmProblem
ptr CInt
lp
{-# LINE 50 "Data/SVM/Raw.hsc" #-}
                                         ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr yp
{-# LINE 51 "Data/SVM/Raw.hsc" #-}
                                         ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr xp
{-# LINE 52 "Data/SVM/Raw.hsc" #-}


newtype CSvmType = CSvmType {CSvmType -> CInt
unCSvmType :: CInt}
                   deriving (Ptr CSvmType -> IO CSvmType
Ptr CSvmType -> Int -> IO CSvmType
Ptr CSvmType -> Int -> CSvmType -> IO ()
Ptr CSvmType -> CSvmType -> IO ()
CSvmType -> Int
(CSvmType -> Int)
-> (CSvmType -> Int)
-> (Ptr CSvmType -> Int -> IO CSvmType)
-> (Ptr CSvmType -> Int -> CSvmType -> IO ())
-> (forall b. Ptr b -> Int -> IO CSvmType)
-> (forall b. Ptr b -> Int -> CSvmType -> IO ())
-> (Ptr CSvmType -> IO CSvmType)
-> (Ptr CSvmType -> CSvmType -> IO ())
-> Storable CSvmType
forall b. Ptr b -> Int -> IO CSvmType
forall b. Ptr b -> Int -> CSvmType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: CSvmType -> Int
sizeOf :: CSvmType -> Int
$calignment :: CSvmType -> Int
alignment :: CSvmType -> Int
$cpeekElemOff :: Ptr CSvmType -> Int -> IO CSvmType
peekElemOff :: Ptr CSvmType -> Int -> IO CSvmType
$cpokeElemOff :: Ptr CSvmType -> Int -> CSvmType -> IO ()
pokeElemOff :: Ptr CSvmType -> Int -> CSvmType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CSvmType
peekByteOff :: forall b. Ptr b -> Int -> IO CSvmType
$cpokeByteOff :: forall b. Ptr b -> Int -> CSvmType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> CSvmType -> IO ()
$cpeek :: Ptr CSvmType -> IO CSvmType
peek :: Ptr CSvmType -> IO CSvmType
$cpoke :: Ptr CSvmType -> CSvmType -> IO ()
poke :: Ptr CSvmType -> CSvmType -> IO ()
Storable, Int -> CSvmType -> ShowS
[CSvmType] -> ShowS
CSvmType -> String
(Int -> CSvmType -> ShowS)
-> (CSvmType -> String) -> ([CSvmType] -> ShowS) -> Show CSvmType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSvmType -> ShowS
showsPrec :: Int -> CSvmType -> ShowS
$cshow :: CSvmType -> String
show :: CSvmType -> String
$cshowList :: [CSvmType] -> ShowS
showList :: [CSvmType] -> ShowS
Show)
cSvc :: CSvmType
cSvc :: CSvmType
cSvc = CInt -> CSvmType
CSvmType CInt
0
nuSvc :: CSvmType
nuSvc :: CSvmType
nuSvc = CInt -> CSvmType
CSvmType CInt
1
oneClass :: CSvmType
oneClass :: CSvmType
oneClass = CInt -> CSvmType
CSvmType CInt
2
epsilonSvr :: CSvmType
epsilonSvr = CSvmType 3
nuSvr :: CSvmType
nuSvr = CSvmType 4

{-# LINE 57 "Data/SVM/Raw.hsc" #-}

newtype CKernelType = CKernelType {unCKernelType :: CInt} 
                      deriving (Storable, Show)
linear :: CKernelType
linear = CKernelType 0
poly :: CKernelType
poly = CKernelType 1
rbf :: CKernelType
rbf = CKernelType 2
sigmoid :: CKernelType
sigmoid = CKernelType 3
precomputed :: CKernelType
precomputed = CKernelType 4

{-# LINE 61 "Data/SVM/Raw.hsc" #-}

data CSvmParameter = CSvmParameter {
    svm_type     :: CSvmType,
    kernel_type  :: CKernelType,
    degree       :: CInt,
    gamma        :: CDouble,
    coef0        :: CDouble,
    cache_size   :: CDouble,
    eps          :: CDouble,
    c            :: CDouble,
    nr_weight    :: CInt,
    weight_label :: Ptr CInt,
    weight       :: Ptr CDouble,
    nu           :: CDouble,
    p            :: CDouble,
    shrinking    :: CInt,
    probability  :: CInt
} deriving Show

defaultCParam :: CSvmParameter
defaultCParam :: CSvmParameter
defaultCParam = CSvmType
-> CKernelType
-> CInt
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CInt
-> Ptr CInt
-> Ptr CDouble
-> CDouble
-> CDouble
-> CInt
-> CInt
-> CSvmParameter
CSvmParameter CSvmType
cSvc CKernelType
rbf CInt
3 CDouble
0 CDouble
0 CDouble
100 CDouble
1e-3 CDouble
1 
                              CInt
0 Ptr CInt
forall a. Ptr a
nullPtr Ptr CDouble
forall a. Ptr a
nullPtr CDouble
0.5 CDouble
0.1 CInt
1 CInt
0

instance Storable CSvmParameter where
    sizeOf :: CSvmParameter -> Int
sizeOf CSvmParameter
_ = (Int
104)
{-# LINE 86 "Data/SVM/Raw.hsc" #-}
    alignment _ = 8
{-# LINE 87 "Data/SVM/Raw.hsc" #-}
    peek ptr = do svm_type_p     <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 88 "Data/SVM/Raw.hsc" #-}
                  kernel_type_p  <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 89 "Data/SVM/Raw.hsc" #-}
                  degree_p       <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 90 "Data/SVM/Raw.hsc" #-}
                  gamma_p        <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 91 "Data/SVM/Raw.hsc" #-}
                  coef0_p        <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 92 "Data/SVM/Raw.hsc" #-}
                  cache_size_p   <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 93 "Data/SVM/Raw.hsc" #-}
                  eps_p          <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 94 "Data/SVM/Raw.hsc" #-}
                  c_p            <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 95 "Data/SVM/Raw.hsc" #-}
                  nr_weight_p    <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 96 "Data/SVM/Raw.hsc" #-}
                  weight_label_p <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 97 "Data/SVM/Raw.hsc" #-}
                  weight_p       <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) ptr
{-# LINE 98 "Data/SVM/Raw.hsc" #-}
                  nu_p           <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) ptr
{-# LINE 99 "Data/SVM/Raw.hsc" #-}
                  p_p            <- ((\hsc_ptr -> peekByteOff hsc_ptr 88)) ptr
{-# LINE 100 "Data/SVM/Raw.hsc" #-}
                  shrinking_p    <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 101 "Data/SVM/Raw.hsc" #-}
                  probability_p  <- ((\hsc_ptr -> peekByteOff hsc_ptr 100)) ptr
{-# LINE 102 "Data/SVM/Raw.hsc" #-}
                  return $ CSvmParameter svm_type_p kernel_type_p degree_p      
                                gamma_p coef0_p cache_size_p eps_p c_p nr_weight_p
                                weight_label_p weight_p nu_p p_p shrinking_p probability_p
    poke :: Ptr CSvmParameter -> CSvmParameter -> IO ()
poke Ptr CSvmParameter
ptr (CSvmParameter CSvmType
svm_type_p CKernelType
kernel_type_p CInt
degree_p
                           CDouble
gamma_p CDouble
coef0_p CDouble
cache_size_p CDouble
eps_p CDouble
c_p CInt
nr_weight_p
                           Ptr CInt
weight_label_p Ptr CDouble
weight_p CDouble
nu_p CDouble
p_p CInt
shrinking_p CInt
probability_p) =
           do ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CSvmType -> IO ()
forall b. Ptr b -> Int -> CSvmType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
0)) Ptr CSvmParameter
ptr CSvmType
svm_type_p
{-# LINE 109 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CKernelType -> IO ()
forall b. Ptr b -> Int -> CKernelType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
4)) Ptr CSvmParameter
ptr CKernelType
kernel_type_p
{-# LINE 110 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
8)) Ptr CSvmParameter
ptr CInt
degree_p
{-# LINE 111 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
16)) Ptr CSvmParameter
ptr CDouble
gamma_p
{-# LINE 112 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
24)) Ptr CSvmParameter
ptr CDouble
coef0_p
{-# LINE 113 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
32)) Ptr CSvmParameter
ptr CDouble
cache_size_p
{-# LINE 114 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
40)) Ptr CSvmParameter
ptr CDouble
eps_p
{-# LINE 115 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
48)) Ptr CSvmParameter
ptr CDouble
c_p
{-# LINE 116 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
56)) Ptr CSvmParameter
ptr CInt
nr_weight_p
{-# LINE 117 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> Ptr CInt -> IO ()
forall b. Ptr b -> Int -> Ptr CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
64)) Ptr CSvmParameter
ptr Ptr CInt
weight_label_p
{-# LINE 118 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> Ptr CDouble -> IO ()
forall b. Ptr b -> Int -> Ptr CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
72)) Ptr CSvmParameter
ptr Ptr CDouble
weight_p
{-# LINE 119 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
80)) Ptr CSvmParameter
ptr CDouble
nu_p
{-# LINE 120 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
88)) Ptr CSvmParameter
ptr CDouble
p_p
{-# LINE 121 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
96)) Ptr CSvmParameter
ptr CInt
shrinking_p
{-# LINE 122 "Data/SVM/Raw.hsc" #-}
              ((\Ptr CSvmParameter
hsc_ptr -> Ptr CSvmParameter -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CSvmParameter
hsc_ptr Int
100)) Ptr CSvmParameter
ptr CInt
probability_p
{-# LINE 123 "Data/SVM/Raw.hsc" #-}

-- |Managed type for struct svm_model.
data CSvmModel

foreign import ccall unsafe "svm.h svm_train" c_svm_train :: Ptr CSvmProblem -> Ptr CSvmParameter -> IO (Ptr CSvmModel)
                        
foreign import ccall unsafe "svm.h svm_cross_validation" c_svm_cross_validation:: Ptr CSvmProblem -> Ptr CSvmParameter -> CInt -> Ptr CDouble -> IO () 

foreign import ccall unsafe "svm.h svm_predict" c_svm_predict :: Ptr CSvmModel -> Ptr CSvmNode -> IO CDouble

foreign import ccall unsafe "svm.h svm_save_model" c_svm_save_model :: CString -> Ptr CSvmModel -> IO CInt

foreign import ccall unsafe "svm.h svm_load_model" c_svm_load_model :: CString -> IO (Ptr CSvmModel)
                        
foreign import ccall unsafe "svm.h svm_check_parameter" c_svm_check_parameter :: Ptr CSvmProblem -> Ptr CSvmParameter -> CString

foreign import ccall unsafe "svm.h &svm_destroy_model" c_svm_destroy_model :: FinalizerPtr CSvmModel

foreign import ccall unsafe "svm.h clone_model_support_vectors" c_clone_model_support_vectors :: Ptr CSvmModel -> IO CInt

type CSvmPrintFn = CString -> IO ()

foreign import ccall unsafe "svm.h svm_set_print_string_function" c_svm_set_print_string_function :: FunPtr CSvmPrintFn -> IO ()
foreign import ccall unsafe "wrapper" createSvmPrintFnPtr :: CSvmPrintFn -> IO (FunPtr CSvmPrintFn)