thereadme/sibe
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

fix(naivebayes): fix the algorithm to make it actually work

Browse Source 
feat(cleanDocuments): preprocess documents, use stemming and stopword elimination for better accuracy
This commit is contained in:
Mahdi Dibaiee
2016-08-05 23:54:36 +04:30
parent 3cf0625794
commit ea1f05f001
10 changed files with 254 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
examples/naivebayes-doc-classifier.hs
View File

@ -1,12 +1,13 @@
module Main
where
import Sibe
-- import Sibe
import Sibe.NaiveBayes
import Text.Printf
import Data.List
import Data.Maybe
import Debug.Trace
import Data.List.Split
import Control.Arrow ((&&&))
main = do
dataset <- readFile "examples/doc-classifier-data/data-reuters"
@ -15,18 +16,33 @@ module Main
classes <- map (filter (/= ' ')) . lines <$> readFile "examples/doc-classifier-data/data-classes"
let intClasses = [0..length classes - 1]
documents = createDocuments classes dataset
testDocuments = createDocuments classes test
devTestDocuments = take 20 testDocuments
nb = initialize documents
-- let intClasses = [0, 1]
documents = cleanDocuments $ createDocuments classes dataset
-- documents = [Document "Chinese Beijing Chinese" 0,
-- Document "Chinese Chinese Shanghai" 0,
-- Document "Chinese Macao" 0,
-- Document "Japan Tokyo Chinese" 1]
-- testDocuments = [Document "Chinese Chinese Chinese Japan Tokyo" 0]
testDocuments = cleanDocuments $ createDocuments classes test
devTestDocuments = take 30 testDocuments
-- devTestDocuments = [Document "Chinese Chinese Chinese Tokyo Japan" 0]
nb = train documents intClasses
results = map (\(Document text c) -> (c, determine text nb intClasses documents)) testDocuments
-- results = map (\(Document text c) -> (c, determine text nb intClasses documents)) devTestDocuments
results = map (\(Document text c) -> (c, run text nb)) testDocuments
-- results = map (\(Document text c) -> (c, run text nb)) devTestDocuments
-- print (text $ head documents)
let showResults (c, r) = putStrLn (classes !! c ++ " ~ " ++ classes !! r)
mapM_ showResults results
putStrLn $ "Recall: " ++ show (recall results)
putStrLn $ "Precision: " ++ show (precision results)
putStrLn $ "F Measure: " ++ show (fmeasure (precision results) (recall results))
putStrLn $ "F Measure: " ++ show (fmeasure results)
putStrLn $ "Accuracy: " ++ show (accuracy results)
createDocuments classes content =
let splitted = splitOn (replicate 10 '-' ++ "\n") content
pairs = map ((head . lines) &&& (unwords . tail . lines)) splitted
documents = map (\(topic, text) -> Document text (fromJust $ elemIndex topic classes)) pairs
in documents