svm-simple 0.2.5 → 0.2.6
raw patch · 4 files changed
+72/−39 lines, 4 filesdep ~vector
Dependency ranges changed: vector
Files
- AI/SVM/Base.hs +33/−22
- AI/SVM/Simple.hs +24/−7
- Examples/Plot.hs +6/−6
- svm-simple.cabal +9/−4
AI/SVM/Base.hs view
@@ -24,6 +24,8 @@ SVM , SVMType(..), Kernel(..) , SVMVector(..)+ , SVMNodes+ ,getNRClasses -- * File operations ,loadSVM, saveSVM@@ -33,6 +35,7 @@ ,predict ) where +import AI.SVM.Common import Bindings.SVM import Control.Applicative import Control.Arrow (first, second, (***), (&&&))@@ -55,49 +58,56 @@ import System.Directory import System.IO.Error import System.IO.Unsafe+import Unsafe.Coerce import qualified Data.ByteString.Lazy as B import qualified Data.Map as Map import qualified Data.Vector as GV import qualified Data.Vector.Storable as V import qualified Foreign.Concurrent as C-import AI.SVM.Common +-- | Intermediary type for interfacing with libsvm. If you need to repeatedly train with the same training data,+-- consider using this type for the training. It is slightly faster and allocates a bit less+type SVMNodes = V.Vector C'svm_node++-- | Class of things that can be interpreted as training vectors for svm. class SVMVector a where- convert :: a -> V.Vector Double+ convert :: a -> SVMNodes -instance SVMVector (V.Vector Double) where+instance SVMVector (V.Vector C'svm_node) where convert = id +instance SVMVector (V.Vector Double) where+ convert = convertDense + instance SVMVector (GV.Vector Double) where- convert = GV.convert+ convert = convertDense . GV.convert instance SVMVector [Double] where- convert = V.fromList+ convert = convertDense . V.fromList instance SVMVector (Double,Double) where- convert (a,b) = V.fromList [a,b]+ convert (a,b) = convertDense . V.fromList $ [a,b] instance SVMVector (Double,Double,Double) where- convert (a,b,c) = V.fromList [a,b,c]+ convert (a,b,c) = convertDense . V.fromList $ [a,b,c] instance SVMVector (Double,Double,Double,Double) where- convert (a,b,c,d) = V.fromList [a,b,c,d]+ convert (a,b,c,d) = convertDense . V.fromList $ [a,b,c,d] instance SVMVector (Double,Double,Double,Double,Double) where- convert (a,b,c,d,e) = V.fromList [a,b,c,d,e]---+ convert (a,b,c,d,e) = convertDense . V.fromList $ [a,b,c,d,e] -{-# SPECIALIZE convertDense :: V.Vector Double -> V.Vector C'svm_node #-}-{-# SPECIALIZE convertDense :: V.Vector Float -> V.Vector C'svm_node #-}-convertDense :: (V.Storable a, Real a) => V.Vector a -> V.Vector C'svm_node+convertDense :: V.Vector Double -> V.Vector C'svm_node convertDense v = V.generate (dim+1) readVal where dim = V.length v readVal !n | n >= dim = C'svm_node (-1) 0- readVal !n = C'svm_node (fromIntegral n+1) (realToFrac $ v ! n)+ readVal !n = C'svm_node (fromIntegral n+1) (double2CDouble $ v ! n) +{-#INLINE double2CDouble #-}+double2CDouble :: Double -> CDouble+double2CDouble = unsafeCoerce+ createProblem v = do -- #TODO Check the problem dimension. Libsvm doesn't node_array <- newArray xs class_array <- newArray y@@ -108,13 +118,12 @@ ,node_array) where dim = length v- lengths = map ((+1) . V.length . snd) v+ lengths = map (V.length . snd) v offsetPtrs addr = take dim [addr `plusPtr` (idx * sizeOf (C'svm_node undefined undefined)) | idx <- scanl (+) 0 lengths] y = map (realToFrac . fst) v- xs = concatMap (V.toList . extractSvmNode . snd) v- extractSvmNode x = convertDense $ V.generate (V.length x) (x !)+ xs = concatMap (V.toList . snd) v deleteProblem (C'svm_problem l class_array offset_array , node_array) = free class_array >> free offset_array >> free node_array @@ -169,12 +178,12 @@ = fromIntegral <$> withForeignPtr fptr c'svm_get_nr_class -- | Predict the class of a vector with an SVM.+{-#SPECIALIZE predict :: SVM -> SVMNodes -> Double #-} predict :: (SVMVector a) => SVM -> a -> Double predict (getModelPtr -> fptr) - (convert -> vec) = unsafePerformIO $+ (convert -> nodes) = unsafePerformIO $ withForeignPtr fptr $ \modelPtr -> - let nodes = convertDense vec- in realToFrac <$> V.unsafeWith nodes + realToFrac <$> V.unsafeWith nodes (c'svm_predict modelPtr) defaultParamers = C'svm_parameter {@@ -312,6 +321,7 @@ wrapPrintF :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ())) -- |Create an SVM from the training data+{-#SPECIALIZE trainSVM :: SVMType -> Kernel -> [(Double,SVMNodes)] -> IO (String,SVM) #-} trainSVM :: (SVMVector a) => SVMType -> Kernel -> [(Double, a)] -> IO (String, SVM) trainSVM svm kernel (map (second convert) -> dataSet) = do messages <- newIORef []@@ -331,6 +341,7 @@ -- |Cross validate SVM. This is faster than training and predicting for each fold -- separately, since there are no extra conversions done between libsvm and haskell.+{-#SPECIALIZE crossvalidate :: SVMType -> Kernel -> Int -> [(Double,SVMNodes)] -> IO (String,[Double]) #-} crossvalidate :: (SVMVector b) => SVMType -> Kernel -> Int -> [(Double, b)] -> IO (String, [Double]) crossvalidate svm kernel folds (map (second convert) -> dataSet) = do
AI/SVM/Simple.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, TupleSections, ViewPatterns,- RecordWildCards, FlexibleInstances #-}+ RecordWildCards, FlexibleInstances, ForeignFunctionInterface #-} ------------------------------------------------------------------------------- -- | -- Module : Bindings.SVM@@ -60,6 +60,7 @@ import System.IO.Unsafe import qualified Data.ByteString.Lazy as B import qualified Data.Map as Map+import Foreign.C.Types (CInt) import AI.SVM.Common @@ -67,11 +68,13 @@ data ClassifierType = C {cost :: Double} | NU {cost :: Double, nu :: Double}+ deriving (Show) -- | Supported SVM regression machines data RegressorType = Epsilon Double Double | NU_r Double Double+ deriving (Show) data SVMClassifier a = SVMClassifier SVM (Map a Double) (Map Double a) newtype SVMRegressor = SVMRegressor SVM @@ -123,9 +126,9 @@ -- | Train an SVM classifier of given type. trainClassifier :: (SVMVector b, Ord a) =>- ClassifierType- -> Kernel- -> [(a, b)]+ ClassifierType -- ^ The type of the classifier+ -> Kernel -- ^ Kernel+ -> [(a, b)] -- ^ Training data -> (String, SVMClassifier a) trainClassifier ctype kernel dataset = unsafePerformIO $ do let (to,from, doubleDataSet) = convertToDouble dataset @@ -140,10 +143,15 @@ -- | Perform n-foldl cross validation for given set of SVM parameters crossvalidateClassifier :: (SVMVector b, Ord a) =>- ClassifierType -> Kernel -> Int -> [(a, b)] + ClassifierType -- ^ The type of classifier+ -> Kernel -- ^ Classifier kernel + -> Int -- ^ Number of folds to use+ -> [(a, b)] -- ^ Dataset+ -> Int -- ^ Seed value. The crossvalidation randomly partitions the data into subsets using this seed value -> (String, [a])-crossvalidateClassifier ctype kernel folds dataset = unsafePerformIO $ do+crossvalidateClassifier ctype kernel folds dataset seed = unsafePerformIO $ do let (to,from, doubleDataSet) = convertToDouble dataset + c_srand (fromIntegral seed) (m,res :: [Double]) <- crossvalidate (generalizeClassifier ctype) kernel folds doubleDataSet return . (m,) $ map (from Map.!) res where @@ -181,8 +189,16 @@ (m,svm) <- trainSVM (generalizeRegressor rtype) kernel doubleDataSet return . (m,) $ SVMRegressor svm -crossvalidateRegressor rtype kernel folds dataset = unsafePerformIO $ do+crossvalidateRegressor :: (SVMVector b) =>+ RegressorType -- ^ The type of the regressor+ -> Kernel -- ^ Kernel + -> Int -- ^ Number of folds to use+ -> [(Double, b)] -- ^ Dataset+ -> Int -- ^ Seed value. The crossvalidation randomly partitions the data into subsets using this seed value+ -> (String, [Double])+crossvalidateRegressor rtype kernel folds dataset seed = unsafePerformIO $ do let doubleDataSet = map (second convert) dataset + c_srand (fromIntegral seed) (m,res) <- crossvalidate (generalizeRegressor rtype) kernel folds doubleDataSet return (m,res) @@ -190,4 +206,5 @@ predictRegression :: SVMVector a => SVMRegressor -> a -> Double predictRegression (SVMRegressor svm) (convert -> v) = predict svm v +foreign import ccall "srand" c_srand :: CInt -> IO ()
Examples/Plot.hs view
@@ -19,15 +19,15 @@ ] let (m,svm2) = trainClassifier (C 1) (RBF 4) trainingData let plot = - (circle # fc green # scale 5 )+ (circle # fc green # scale 5 5 ) `atop` - (circle # fc green # scale 5- `atop` circle # scale 100 # lineWidth 5) # translate (200,200) + (circle # fc green # scale 5 5+ `atop` circle # scale 100 100 # lineWidth 5) # translate (200,200) `atop` - (circle # fc green # scale 5 # translate (400,400) )+ (circle # fc green # scale 5 5 # translate (400,400) ) `atop` - foldl (atop) (circle # scale 1)- [circle # scale 5 # translate (400*x,400*y) # fc (color svm2 (x,y))+ foldl (atop) (circle # scale 1 1)+ [circle # scale 5 5 # translate (400*x,400*y) # fc (color svm2 (x,y)) | x <- [0,0.025..1], y <- [0,0.025..1]] fst $ renderDia Cairo (CairoOptions ("test.png") (PNG (400,400))) plot where
svm-simple.cabal view
@@ -1,5 +1,5 @@ name: svm-simple-version: 0.2.5+version: 0.2.6 synopsis: Medium level, simplified, bindings to libsvm description: This is a set of simplified bindings to libsvm <http://www.csie.ntu.edu.tw/~cjlin/libsvm/> suite@@ -7,6 +7,12 @@ and support vector regression. . .+ Changes in version 0.2.6+ .+ * Fixed a critical bug with training and crossvalidation + .+ * Slight performance improvements+ . Changes in version 0.2.5 . * Crossvalidation for the high level interface @@ -14,11 +20,10 @@ Changes in version 0.2.2 . * Rather ugly binary instances- * Exporting SVM types . Changes in version 0.2.1 .- * Added operations for saving and loading SVMs to the 'Simple'-interface.+ * Added operations for saving and loading SVMs . Changes in version 0.2.0 .@@ -57,6 +62,6 @@ bindings-svm >= 0.2.0 && < 0.3, binary >= 0.5 && < 0.6, mwc-random >= 0.8 && < 0.9,- vector >= 0.7.0.1 && < 0.8,+ vector >= 0.7.0.1 && < 1.1, directory >= 1.1.0.0 && < 1.2, containers >= 0.4.0.0 && < 0.5