diff --git a/examples/424encoder.hs b/examples/424encoder.hs index 4b93941..1a756f5 100644 --- a/examples/424encoder.hs +++ b/examples/424encoder.hs @@ -1,5 +1,5 @@ module Main where - import Sibe + import Numeric.Sibe import Numeric.LinearAlgebra import Data.List import Debug.Trace diff --git a/examples/naivebayes-doc-classifier.hs b/examples/naivebayes-doc-classifier.hs index 0e7581e..7b27e5b 100644 --- a/examples/naivebayes-doc-classifier.hs +++ b/examples/naivebayes-doc-classifier.hs @@ -1,8 +1,7 @@ module Main where - -- import Sibe - import Sibe.NLP - import Sibe.NaiveBayes + import Numeric.Sibe.NLP + import Numeric.Sibe.NaiveBayes import Text.Printf import Data.List import Data.Maybe diff --git a/examples/notmnist.hs b/examples/notmnist.hs index 865ed55..c823b46 100644 --- a/examples/notmnist.hs +++ b/examples/notmnist.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where - import Sibe + import Numeric.Sibe import Numeric.LinearAlgebra import Data.List import Debug.Trace diff --git a/examples/recurrent-doc-classifier.hs b/examples/recurrent-doc-classifier.hs deleted file mode 100644 index e69de29..0000000 diff --git a/examples/word2vec.hs b/examples/word2vec.hs index 457d7b8..81d7caa 100644 --- a/examples/word2vec.hs +++ b/examples/word2vec.hs @@ -3,9 +3,9 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where - import Sibe - import Sibe.Word2Vec - import Sibe.Utils + import Numeric.Sibe + import Numeric.Sibe.Word2Vec + import Numeric.Sibe.Utils import Data.Default.Class import qualified Data.Vector.Storable as V import Data.List (sortBy) diff --git a/examples/xor.hs b/examples/xor.hs index 454e9b7..56c726f 100644 --- a/examples/xor.hs +++ b/examples/xor.hs @@ -1,5 +1,5 @@ module Main where - import Sibe + import Numeric.Sibe import Numeric.LinearAlgebra import Data.List import Debug.Trace diff --git a/sibe.cabal b/sibe.cabal index 3205f68..38b949f 100644 --- a/sibe.cabal +++ b/sibe.cabal @@ -1,5 +1,5 @@ name: sibe -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Machine Learning algorithms description: Haskell Machine Learning homepage: https://github.com/mdibaiee/sibe @@ -15,7 +15,7 @@ cabal-version: >=1.10 library hs-source-dirs: src - exposed-modules: Sibe, Sibe.NaiveBayes, Sibe.NLP, Sibe.Word2Vec, Sibe.Utils + exposed-modules: Numeric.Sibe, Numeric.Sibe.NaiveBayes, Numeric.Sibe.NLP, Numeric.Sibe.Word2Vec, Numeric.Sibe.Utils build-depends: base >= 4.7 && < 5 , hmatrix , random diff --git a/src/Lib.hi b/src/Lib.hi deleted file mode 100644 index 80253d3..0000000 Binary files a/src/Lib.hi and /dev/null differ diff --git a/src/Lib.o b/src/Lib.o deleted file mode 100644 index ef9a956..0000000 Binary files a/src/Lib.o and /dev/null differ diff --git a/src/Sibe.hs b/src/Numeric/Sibe.hs similarity index 99% rename from src/Sibe.hs rename to src/Numeric/Sibe.hs index f4ccede..5a43b20 100644 --- a/src/Sibe.hs +++ b/src/Numeric/Sibe.hs @@ -3,7 +3,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} -module Sibe +module Numeric.Sibe (Network(..), Layer(..), Input, diff --git a/src/Sibe/NLP.hs b/src/Numeric/Sibe/NLP.hs similarity index 98% rename from src/Sibe/NLP.hs rename to src/Numeric/Sibe/NLP.hs index 3369a7c..69e9495 100644 --- a/src/Sibe/NLP.hs +++ b/src/Numeric/Sibe/NLP.hs @@ -1,4 +1,4 @@ -module Sibe.NLP +module Numeric.Sibe.NLP (Class, Document(..), accuracy, @@ -13,7 +13,7 @@ module Sibe.NLP ngramText, ) where - import Sibe.Utils + import Numeric.Sibe.Utils import Data.List import Debug.Trace import Data.List.Split diff --git a/src/Sibe/NaiveBayes.hs b/src/Numeric/Sibe/NaiveBayes.hs similarity index 98% rename from src/Sibe/NaiveBayes.hs rename to src/Numeric/Sibe/NaiveBayes.hs index c9b24d1..1dadbb3 100644 --- a/src/Sibe/NaiveBayes.hs +++ b/src/Numeric/Sibe/NaiveBayes.hs @@ -1,4 +1,4 @@ -module Sibe.NaiveBayes +module Numeric.Sibe.NaiveBayes (Document(..), NB(..), initialize, @@ -18,8 +18,8 @@ module Sibe.NaiveBayes removeStopwords, ) where - import Sibe.Utils - import Sibe.NLP + import Numeric.Sibe.Utils + import Numeric.Sibe.NLP import Data.List import Debug.Trace import qualified Data.Set as Set diff --git a/src/Sibe/Utils.hs b/src/Numeric/Sibe/Utils.hs similarity index 97% rename from src/Sibe/Utils.hs rename to src/Numeric/Sibe/Utils.hs index d90cc0b..df0e419 100644 --- a/src/Sibe/Utils.hs +++ b/src/Numeric/Sibe/Utils.hs @@ -1,4 +1,4 @@ -module Sibe.Utils +module Numeric.Sibe.Utils ( similarity , ordNub , onehot diff --git a/src/Sibe/Word2Vec.hs b/src/Numeric/Sibe/Word2Vec.hs similarity index 98% rename from src/Sibe/Word2Vec.hs rename to src/Numeric/Sibe/Word2Vec.hs index 5b7586a..c852a99 100644 --- a/src/Sibe/Word2Vec.hs +++ b/src/Numeric/Sibe/Word2Vec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Sibe.Word2Vec +module Numeric.Sibe.Word2Vec ( word2vec , Word2Vec (..) , W2VMethod (..) ) where - import Sibe - import Sibe.Utils + import Numeric.Sibe + import Numeric.Sibe.Utils import Debug.Trace import Data.Char import Data.Maybe diff --git a/src/Sibe/LogisticRegression.hs b/src/Sibe/LogisticRegression.hs deleted file mode 100644 index e69de29..0000000 diff --git a/src/Sibe/Word2Vec.hs.backup b/src/Sibe/Word2Vec.hs.backup deleted file mode 100644 index fa7a3d2..0000000 --- a/src/Sibe/Word2Vec.hs.backup +++ /dev/null @@ -1,44 +0,0 @@ -module Sibe.Word2Vec - (word2vec, - mapTuple - ) where - import Sibe - import Sibe.NLP - import Debug.Trace - import Data.Char - import Data.Maybe - import Data.List - import Numeric.LinearAlgebra hiding (find) - import qualified Data.Vector.Storable as V - - word2vec docs session = do - let cooccurence = concat $ map co docs - a = (sigmoid, sigmoid') - o = (softmax, crossEntropy') - window = 2 - s = session { training = cooccurence - , test = cooccurence - , network = buildNetwork 0 (-1, 1) n [(n, 300, (id, id))] (300, n, (softmax, crossEntropy')) - } - print $ network s - newses <- run gd s - return (newses, cooccurence, vocabulary, vocvec) - where - n = length vocabulary - vocabulary = ordNub . words . map toLower . concatMap (++ " ") $ docs - vocvec = zip vocabulary $ map tovec [0..n] - tovec i = replicate i 0 ++ [1] ++ replicate (n - i - 1) 0 - co d = - let p = pairs d - in map (\(a, [b, c]) -> (f a, V.concat [f b, f c])) p - where - f w = vector . snd . fromJust $ find ((== w) . fst) vocvec - pairs d = concatMap iter [0..length ws] - where - ws = words $ map toLower d - iter i - | i > 0 && i < length ws - 1 = [(ws !! i, [ws !! (i - 1), ws !! (i + 1)])] - | otherwise = [] - - mapTuple :: (a -> b) -> (a, a) -> (b, b) - mapTuple f (a, b) = (f a, f b)