fix(precision): little bug in implementation
This commit is contained in:
parent
76e7e7faef
commit
3cf0625794
@ -17,18 +17,16 @@ module Main
|
|||||||
let intClasses = [0..length classes - 1]
|
let intClasses = [0..length classes - 1]
|
||||||
documents = createDocuments classes dataset
|
documents = createDocuments classes dataset
|
||||||
testDocuments = createDocuments classes test
|
testDocuments = createDocuments classes test
|
||||||
|
devTestDocuments = take 20 testDocuments
|
||||||
nb = initialize documents
|
nb = initialize documents
|
||||||
|
|
||||||
results = map (\(Document text c) -> (c, determine text nb intClasses documents)) testDocuments
|
results = map (\(Document text c) -> (c, determine text nb intClasses documents)) testDocuments
|
||||||
|
-- results = map (\(Document text c) -> (c, determine text nb intClasses documents)) devTestDocuments
|
||||||
|
|
||||||
let showResults (c, r) = putStrLn (classes !! c ++ " ~ " ++ classes !! r)
|
let showResults (c, r) = putStrLn (classes !! c ++ " ~ " ++ classes !! r)
|
||||||
mapM_ showResults results
|
mapM_ showResults results
|
||||||
|
|
||||||
let showAccuracy (c, r) =
|
putStrLn $ "Recall: " ++ show (recall results)
|
||||||
print $ genericLength (filter (\(h, j) -> h == j && h == c) results) / genericLength results
|
putStrLn $ "Precision: " ++ show (precision results)
|
||||||
mapM_ showAccuracy 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 (precision results) (recall results))
|
||||||
putStrLn $ "Accuracy: " ++ show (accuracy results) ++ "%"
|
putStrLn $ "Accuracy: " ++ show (accuracy results)
|
||||||
|
@ -70,16 +70,16 @@ module Sibe.NaiveBayes
|
|||||||
go s (x:xs) = if x `Set.member` s then go s xs
|
go s (x:xs) = if x `Set.member` s then go s xs
|
||||||
else x : go (Set.insert x s) xs
|
else x : go (Set.insert x s) xs
|
||||||
|
|
||||||
accuracy :: [(Int, Int)] -> Int
|
accuracy :: [(Int, Int)] -> Double
|
||||||
accuracy results =
|
accuracy results =
|
||||||
let correct = filter (uncurry (==)) results
|
let correct = filter (uncurry (==)) results
|
||||||
in round $ genericLength correct / genericLength results * 100
|
in genericLength correct / genericLength results
|
||||||
|
|
||||||
recall :: [(Int, Int)] -> Double
|
recall :: [(Int, Int)] -> Double
|
||||||
recall results =
|
recall results =
|
||||||
let classes = ordNub (map fst results)
|
let classes = ordNub (map fst results)
|
||||||
s = sum (map rec classes) / genericLength classes
|
s = sum (map rec classes) / genericLength classes
|
||||||
in s * 100
|
in s
|
||||||
where
|
where
|
||||||
rec a =
|
rec a =
|
||||||
let t = genericLength $ filter (\(c, r) -> c == r && c == a) results
|
let t = genericLength $ filter (\(c, r) -> c == r && c == a) results
|
||||||
@ -90,12 +90,15 @@ module Sibe.NaiveBayes
|
|||||||
precision results =
|
precision results =
|
||||||
let classes = ordNub (map fst results)
|
let classes = ordNub (map fst results)
|
||||||
s = sum (map prec classes) / genericLength classes
|
s = sum (map prec classes) / genericLength classes
|
||||||
in s * 100
|
in s
|
||||||
where
|
where
|
||||||
prec a =
|
prec a =
|
||||||
let t = genericLength $ filter (\(c, r) -> c == r && c == a) results
|
let t = genericLength $ filter (\(c, r) -> c == r && c == a) results
|
||||||
y = genericLength $ filter (\(c, r) -> r == a) results
|
y = genericLength $ filter (\(c, r) -> r == a) results
|
||||||
in t / y
|
in
|
||||||
|
if y == 0
|
||||||
|
then 0
|
||||||
|
else t / y
|
||||||
|
|
||||||
fmeasure :: Double -> Double -> Double
|
fmeasure :: Double -> Double -> Double
|
||||||
fmeasure r p = (2 * p * r) / (p + r)
|
fmeasure r p = (2 * p * r) / (p + r)
|
||||||
|
Loading…
Reference in New Issue
Block a user