HSvm 0.1.0.3.22 → 0.1.1.3.22

raw patch · 4 files changed

+66/−28 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/SVM.hs +51/−18
• Data/SVM/Raw.hsc +11/−7
• HSvm.cabal +3/−2
• cbits/svm.cpp +1/−1

@@ -1,3 +1,6 @@+{-|+This module provides a safe bindings to libsvm functions and structures with implicit memory handling.+-} module Data.SVM   ( Vector   , Problem@@ -12,51 +15,60 @@   , loadModel   , saveModel   , predict+  , withPrintFn+  , CSvmPrintFn   ) where --- TODO limitare l'export--- TODO verificare l'import---- import           Control.Arrow         ((***)) import           Control.Exception import           Control.Monad         (liftM, when) import           Data.IntMap           (IntMap, toList) import qualified Data.IntMap           as M import           Data.SVM.Raw          (CSvmModel, CSvmNode (..), CSvmParameter,-                                        CSvmProblem (..),+                                        CSvmPrintFn, CSvmProblem (..),                                         c_clone_model_support_vectors,                                         c_svm_check_parameter,                                         c_svm_cross_validation,                                         c_svm_destroy_model, c_svm_load_model,                                         c_svm_predict, c_svm_save_model,-                                        c_svm_train, defaultCParam)+                                        c_svm_set_print_string_function,+                                        c_svm_train, createSvmPrintFnPtr,+                                        defaultCParam) import qualified Data.SVM.Raw          as R import           Foreign.C.String import           Foreign.ForeignPtr import           Foreign.Marshal.Alloc (alloca, free, malloc) import           Foreign.Marshal.Array-import           Foreign.Ptr           (Ptr, nullPtr)+import           Foreign.Ptr           (Ptr, freeHaskellFunPtr, nullPtr) import           Foreign.Storable      (peek, poke) +-- |Vector type provides a sparse implementation of vector. It uses IntMap as underlying implementation. type Vector = IntMap Double++-- |SVM problem is a list of maps from training vectors to 1.0 or -1.0 type Problem = [(Double, Vector)]++-- |'Model' is a wrapper over foreign pointer to 'CSvmModel' newtype Model = Model (ForeignPtr CSvmModel) -data KernelType = Linear-                | RBF     { gamma :: Double }-                | Sigmoid { gamma :: Double, coef0 :: Double }-                | Poly    { gamma :: Double, coef0 :: Double, degree :: Int}+-- |Kernel function for SVM algorithm.+data KernelType = Linear -- ^Linear kernel function, i.e. dot product+                | RBF     { gamma :: Double } -- ^Gaussian radial basis function with parameter 'gamma'+                | Sigmoid { gamma :: Double, coef0 :: Double } -- ^Sigmoid kernel function+                | Poly    { gamma :: Double, coef0 :: Double, degree :: Int} -- ^Inhomogeneous polynomial function -data Algorithm = CSvc  { c :: Double }-               | NuSvc { nu :: Double }-               | NuSvr { nu :: Double, c :: Double }-               | EpsilonSvr { epsilon :: Double, c :: Double }-               | OneClassSvm { nu :: Double }+-- |SVM Algorithm with parameters+data Algorithm = CSvc  { c :: Double } -- ^c-SVC algorithm+               | NuSvc { nu :: Double } -- ^nu-SVC algorithm+               | NuSvr { nu :: Double, c :: Double } -- ^nu-SVR algorithm+               | EpsilonSvr { epsilon :: Double, c :: Double } -- ^eps-SVR algorithm+               | OneClassSvm { nu :: Double } -- ^One class SVM +-- |Extra parameters of SVM implementation data ExtraParam = ExtraParam {cacheSize   :: Double,                               shrinking   :: Int,                               probability :: Int} +-- |Default extra parameters of SVM implamentation defaultExtra :: ExtraParam defaultExtra = ExtraParam {cacheSize = 1000, shrinking = 1, probability = 0} @@ -146,6 +158,7 @@  -- +-- |Like 'train' but with extra parameters train' :: ExtraParam -> Algorithm -> KernelType -> Problem -> IO Model train' extra algo kern prob =     withProblem prob $ \probPtr ->@@ -162,6 +175,7 @@ train :: Algorithm -> KernelType -> Problem -> IO Model train = train' defaultExtra +-- |Like 'crossvalidate' but with extra parameters crossValidate' :: ExtraParam                   -> Algorithm                   -> KernelType@@ -178,11 +192,13 @@             c_svm_cross_validation probPtr paramPtr c_nFold targetPtr             map realToFrac `liftM` peekArray probLen targetPtr +-- |Stratified cross validation crossValidate :: Algorithm -> KernelType -> Problem -> Int -> IO [Double] crossValidate = crossValidate' defaultExtra  ----------------------------------------------------------------------- +-- |Save model to the file saveModel :: Model -> FilePath -> IO () saveModel (Model modelForeignPtr) path =     withForeignPtr modelForeignPtr $ \modelPtr -> do@@ -190,15 +206,32 @@         ret <- c_svm_save_model pathString modelPtr         when (ret /= 0) $ error $ "svm: error saving the model:" ++ show ret +-- |Load model from the file loadModel :: FilePath -> IO Model loadModel path = do     modelPtr <- c_svm_load_model =<< newCString path     Model `liftM` newForeignPtr c_svm_destroy_model modelPtr ----+-- |Predict a value for 'Vector' by using 'Model' predict :: Model -> Vector -> IO Double predict (Model modelForeignPtr) vector = action     where action :: IO Double           action = withForeignPtr modelForeignPtr $ \modelPtr ->                    withCSvmNodeArray vector $ \vectorPtr ->-                        return . realToFrac . c_svm_predict modelPtr $ vectorPtr+                        realToFrac <$> c_svm_predict modelPtr vectorPtr++-- |Wrapper to change the libsvm output reporting function.+--+-- libsvm by default writes some statistics to stdout. If you don't+-- want any output from libsvm, you can do e.g.:+--+-- >>> withPrintFn (\_ -> return ()) $ train (NuSvc 0.25) (RBF 1) feats+withPrintFn :: CSvmPrintFn -> IO a -> IO a+withPrintFn printfn body = bracket+  (do+    c_printfn <- createSvmPrintFnPtr printfn+    c_svm_set_print_string_function c_printfn+    return c_printfn+  )+  freeHaskellFunPtr+  (const body)

@@ -1,3 +1,6 @@+{-|This is a module with raw bindings to libsvm+-}+ {-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,               EmptyDataDecls #-} @@ -10,13 +13,10 @@  module Data.SVM.Raw where --- TODO limitare l'export--- TODO verificare l'import- import Foreign.Storable (Storable(..), peekByteOff, pokeByteOff) import Foreign.C.Types (CDouble (..), CInt (..)) import Foreign.C.String (CString)-import Foreign.Ptr(nullPtr, Ptr)+import Foreign.Ptr(nullPtr, Ptr, FunPtr) import Foreign.ForeignPtr (FinalizerPtr)  data CSvmNode = CSvmNode { @@ -51,7 +51,6 @@                                          (#poke struct svm_problem, x) ptr xp  --- TODO esportare solo il tipo e non il costruttore? newtype CSvmType = CSvmType {unCSvmType :: CInt}                    deriving (Storable, Show) #enum CSvmType, CSvmType, C_SVC, NU_SVC, ONE_CLASS, EPSILON_SVR, NU_SVR@@ -122,14 +121,14 @@               (#poke struct svm_parameter, shrinking) ptr shrinking_p               (#poke struct svm_parameter, probability) ptr probability_p +-- |Managed type for struct svm_model. data CSvmModel --- TODO cambiare il return type da  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 -> CDouble+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 @@ -140,3 +139,8 @@ 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)

@@ -1,5 +1,5 @@ Name:               HSvm-Version:            0.1.0.3.22+Version:            0.1.1.3.22 Copyright:          (c) 2009 Paolo Losi, 2017 Pavel Ryzhov Maintainer:         Pavel Ryzhov <paul@paulrz.cz> License:            BSD3@@ -19,7 +19,8 @@ Library   Build-Depends:    base >= 4 && < 5                   , containers-  Exposed-modules:  Data.SVM, Data.SVM.Raw+  Exposed-modules:  Data.SVM+                  , Data.SVM.Raw   Includes:         svm.h   Include-Dirs:     cbits   C-Sources:        cbits/svm.cpp

@@ -2598,7 +2598,7 @@  double svm_predict(const svm_model *model, const svm_node *x) {-	print_node(x);+	// print_node(x); 	int nr_class = model->nr_class; 	double *dec_values; 	if(model->param.svm_type == ONE_CLASS ||