diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2014 Krzysztof Langner +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/glider-nlp.cabal b/glider-nlp.cabal new file mode 100644 --- /dev/null +++ b/glider-nlp.cabal @@ -0,0 +1,67 @@ +name: glider-nlp +version: 0.1 +cabal-version: >=1.10 +build-type: Simple +author: Krzysztof Langner +maintainer: klangner@gmail.com +stability: Alpha - not stable +synopsis: Natural Language Processing library +homepage: https://github.com/klangner/glider-nlp +Bug-reports: https://github.com/klangner/glider-nlp/issues +category: NLP, Text, Library +License: BSD3 +License-file: LICENSE +Extra-Source-Files: + CHANGES +description: + Natural Language Processing (NLP) library. + . + Check module in folder "Glider.NLP.Statistics" for universal functions and + Glider.NLP.Language.language for functions designed for specific language. + +source-repository head + type: git + location: https://github.com/klangner/condor-nlp + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >= 4 && <4.7, + text >=1 && <1.1, + containers >=0.5.0 && <0.6 + exposed-modules: + Glider.NLP.Language.English.Porter, + Glider.NLP.Language.English.StopWords, + Glider.NLP.Language.Polish.StopWords, + Glider.NLP.Statistics, + Glider.NLP.Tokenizer + other-modules: Glider.NLP.Language.Default + +test-suite unit-tests + type: detailed-0.9 + test-module: AllTests + default-language: Haskell2010 + ghc-options: -Wall -rtsopts + build-depends: + base >= 4 && <4.7, + HUnit >=1.2.5 && <1.3, + Cabal >=1.16.0 && <1.17, + text >=1 && <1.1, + containers >=0.5.0 && <0.6 + hs-source-dirs: + src, + test-src + other-modules: + Distribution.TestSuite.HUnit, + Glider.NLP.Language.Default, + Glider.NLP.Language.DefaultTest, + Glider.NLP.Language.English.Porter, + Glider.NLP.Language.English.PorterTest, + Glider.NLP.Language.English.StopWords, + Glider.NLP.Language.Polish.StopWords, + Glider.NLP.Statistics, + Glider.NLP.StatisticsTest, + Glider.NLP.Tokenizer, + Glider.NLP.TokenizerTest diff --git a/src/Glider/NLP/Language/Default.hs b/src/Glider/NLP/Language/Default.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Language/Default.hs @@ -0,0 +1,22 @@ +{- | +Module : Glider.NLP.Language.Default +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +This module contains default implementation for language specific algorithms. +If there is no specific algorithm for yor language you can use one from this module. + +-} +module Glider.NLP.Language.Default (isStopWord) where + +import Prelude hiding (length) +import Data.Text + + +-- | Any less then 4 characters words is marked as stop word +isStopWord :: Text -> Bool +isStopWord w = length w < 4 diff --git a/src/Glider/NLP/Language/English/Porter.hs b/src/Glider/NLP/Language/English/Porter.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Language/English/Porter.hs @@ -0,0 +1,177 @@ +{- | +Module : Glider.NLP.Language.English.Porter +Copyright : Dmitry Antonyuk +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +This code was taken from: http://tartarus.org/~martin/PorterStemmer/haskell.txt +-} +module Glider.NLP.Language.English.Porter (stem) where + +import Control.Monad +import Data.Maybe +import Data.List +import qualified Data.Text as T + + +-- | API stemming function +stem :: T.Text -> T.Text +stem s | T.length s < 3 = s + | otherwise = T.pack $ allSteps (T.unpack s) + + +isConsonant :: [Char] -> Int -> Bool +isConsonant str i + | c `elem` "aeiou" = False + | c == 'y' = i == 0 || isVowel str (i - 1) + | otherwise = True + where + c = str !! i + +isVowel :: [Char] -> Int -> Bool +isVowel = (not .) . isConsonant + +byIndex :: ([a] -> [Int] -> t) -> [a] -> t +byIndex fun str = fun str [0..length str - 1] + +measure :: [Char] -> Int +measure = length . filter not . init . (True:) . map head . group . byIndex (map . isConsonant) + +containsVowel :: [Char] -> Bool +containsVowel = byIndex (any . isVowel) + +endsWithDouble :: [Char] -> Bool +endsWithDouble = startsWithDouble . reverse + where + startsWithDouble l | length l < 2 = False + | otherwise = let (x:y:_) = l in x == y && x `notElem` "aeiou" + +cvc :: [Char] -> Bool +cvc word | length word < 3 = False + | otherwise = isConsonant word lastIndex && + isVowel word (lastIndex - 1) && + isConsonant word (lastIndex - 2) && + last word `notElem` "wxy" + where lastIndex = length word - 1 + +statefulReplace :: Eq a => ([a] -> Bool) -> [a] -> [a] -> [a] -> Maybe (Either [a] [a]) +statefulReplace predicate str end replacement + | end `isSuffixOf` str = Just replaced + | otherwise = Nothing + where + part = take (length str - length end) str + replaced | predicate part = Right (part ++ replacement) + | otherwise = Left str + +replaceEnd :: Eq a => ([a] -> Bool) -> [a] -> [a] -> [a] -> Maybe [a] +replaceEnd predicate str end replacement = do + result <- statefulReplace predicate str end replacement + return (either id id result) + +findStem :: Eq a => ([a] -> Bool) -> [a] -> [([a], [a])] -> Maybe [a] +findStem f word pairs = msum $ map (uncurry (replaceEnd f word)) pairs + +measureGT :: Int -> [Char] -> Bool +measureGT = flip ((>) . measure) + +step1a :: [Char] -> [Char] +step1a word = fromMaybe word result + where result = findStem (const True) word [("sses", "ss"), ("ies", "i"), ("ss", "ss"), ("s", "")] + +beforeStep1b :: [Char] -> Either [Char] [Char] +beforeStep1b word = fromMaybe (Left word) result + where + cond23 x = do { v <- x; either (const Nothing) (return . Right) v } + cond1 x = do { v <- x; return (Left v) } + result = + cond1 (replaceEnd (measureGT 0) word "eed" "ee") `mplus` + cond23 (statefulReplace containsVowel word "ed" "" ) `mplus` + cond23 (statefulReplace containsVowel word "ing" "" ) + +afterStep1b :: [Char] -> [Char] +afterStep1b word = fromMaybe word result + where + double = endsWithDouble word && not (any ((`isSuffixOf` word) . return) "lsz") + mEq1AndCvc = measure word == 1 && cvc word + iif cond val = if cond then Just val else Nothing + result = findStem (const True) word [("at", "ate"), ("bl", "ble"), ("iz", "ize")] + `mplus` iif double (init word) + `mplus` iif mEq1AndCvc (word ++ "e") + +step1b :: [Char] -> [Char] +step1b = either id afterStep1b . beforeStep1b + +step1c :: [Char] -> [Char] +step1c word = fromMaybe word result + where result = replaceEnd containsVowel word "y" "i" + +step1 :: [Char] -> [Char] +step1 = step1c . step1b . step1a + +step2 :: [Char] -> [Char] +step2 word = fromMaybe word result + where + result = findStem (measureGT 0) word + [ ("ational", "ate" ) + , ("tional", "tion") + , ("enci", "ence") + , ("anci", "ance") + , ("izer", "ize" ) + , ("bli", "ble" ) + , ("alli", "al" ) + , ("entli", "ent" ) + , ("eli", "e" ) + , ("ousli", "ous" ) + , ("ization", "ize" ) + , ("ation", "ate" ) + , ("ator", "ate" ) + , ("alism", "al" ) + , ("iveness", "ive" ) + , ("fulness", "ful" ) + , ("ousness", "ous" ) + , ("aliti", "al" ) + , ("iviti", "ive" ) + , ("biliti", "ble" ) + , ("logi", "log" ) ] + +step3 :: [Char] -> [Char] +step3 word = fromMaybe word result + where + result = findStem (measureGT 0) word + [ ("icate", "ic") + , ("ative", "" ) + , ("alize", "al") + , ("iciti", "ic") + , ("ical" , "ic") + , ("ful" , "" ) + , ("ness" , "" ) ] + +step4 :: [Char] -> [Char] +step4 word = fromMaybe word result + where + gt1andST str = (measureGT 1) str && any ((`isSuffixOf` str) . return) "st" + findGT1 = findStem (measureGT 1) word . map (flip (,) "") + result = (findGT1 ["al", "ance", "ence", "er", "ic", "able", "ible", "ant", "ement", "ment", "ent"]) `mplus` + (findStem gt1andST word [("ion","")]) `mplus` + (findGT1 ["ou", "ism", "ate", "iti", "ous", "ive", "ize"]) + +step5a :: [Char] -> [Char] +step5a word = fromMaybe word result + where + test str = (measureGT 1 str) || ((measure str == 1) && (not $ cvc str)) + result = replaceEnd test word "e" "" + +step5b :: [Char] -> [Char] +step5b word = fromMaybe word result + where + cond s = last s == 'l' && measureGT 1 s + result = replaceEnd cond word "l" "" + +step5 :: [Char] -> [Char] +step5 = step5b . step5a + +allSteps :: [Char] -> [Char] +allSteps = step5 . step4 . step3 . step2 . step1 diff --git a/src/Glider/NLP/Language/English/StopWords.hs b/src/Glider/NLP/Language/English/StopWords.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Language/English/StopWords.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Glider.NLP.Language.English.StopWords +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +Module contains stop words for English language + +-} +module Glider.NLP.Language.English.StopWords (isStopWord) where + +import qualified Data.Set as S +import Data.Text + + +-- | Predicate to check if given words is a stop word +isStopWord :: Text -> Bool +isStopWord w = S.member w stopWords + +stopWords :: S.Set Text +stopWords = S.fromList + [ "i" + , "me" + , "my" + , "myself" + , "we" + , "our" + , "ours" + , "ourselves" + , "you" + , "your" + , "yours" + , "yourself" + , "yourselves" + , "he" + , "him" + , "his" + , "himself" + , "she" + , "her" + , "hers" + , "herself" + , "it" + , "its" + , "itself" + , "they" + , "them" + , "their" + , "theirs" + , "themselves" + , "what" + , "which" + , "who" + , "whom" + , "this" + , "that" + , "these" + , "those" + , "am" + , "is" + , "are" + , "was" + , "were" + , "be" + , "been" + , "being" + , "have" + , "has" + , "had" + , "having" + , "do" + , "does" + , "did" + , "doing" + , "a" + , "an" + , "the" + , "and" + , "but" + , "if" + , "or" + , "because" + , "as" + , "until" + , "while" + , "of" + , "at" + , "by" + , "for" + , "with" + , "about" + , "against" + , "between" + , "into" + , "through" + , "during" + , "before" + , "after" + , "above" + , "below" + , "to" + , "from" + , "up" + , "down" + , "in" + , "out" + , "on" + , "off" + , "over" + , "under" + , "again" + , "further" + , "then" + , "once" + , "here" + , "there" + , "when" + , "where" + , "why" + , "how" + , "all" + , "any" + , "both" + , "each" + , "few" + , "more" + , "most" + , "other" + , "some" + , "such" + , "no" + , "nor" + , "not" + , "only" + , "own" + , "same" + , "so" + , "than" + , "too" + , "very" + , "s" + , "t" + , "can" + , "will" + , "just" + , "don" + , "should" + , "now" + ] diff --git a/src/Glider/NLP/Language/Polish/StopWords.hs b/src/Glider/NLP/Language/Polish/StopWords.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Language/Polish/StopWords.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Glider.NLP.Language.Polish.StopWords +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +Module contains stop words for Polish language + +-} +module Glider.NLP.Language.Polish.StopWords (isStopWord) where + +import qualified Data.Set as S +import Data.Text + + +-- | Predicate to check if given words is a stop word +isStopWord :: Text -> Bool +isStopWord w = S.member w stopWords + +stopWords :: S.Set Text +stopWords = S.fromList + [ "a" + ,"aby" + ,"ach" + ,"acz" + ,"aczkolwiek" + ,"aj" + ,"albo" + ,"ale" + ,"alez" + ,"ależ" + ,"ani" + ,"az" + ,"aż" + ,"bardziej" + ,"bardzo" + ,"bo" + ,"bowiem" + ,"by" + ,"byli" + ,"bynajmniej" + ,"byc" + ,"być" + ,"byl" + ,"był" + ,"byla" + ,"bylo" + ,"byly" + ,"była" + ,"było" + ,"były" + ,"bedzie" + ,"będzie" + ,"beda" + ,"będą" + ,"cali" + ,"cala" + ,"cała" + ,"caly" + ,"cały" + ,"ci" + ,"cie" + ,"cię" + ,"ciebie" + ,"co" + ,"cokolwiek" + ,"cos" + ,"coś" + ,"czasami" + ,"czasem" + ,"czemu" + ,"czy" + ,"czyli" + ,"daleko" + ,"dla" + ,"dlaczego" + ,"dlatego" + ,"do" + ,"dobrze" + ,"dokad" + ,"dokąd" + ,"dosc" + ,"dość" + ,"duzo" + ,"dużo" + ,"dwa" + ,"dwaj" + ,"dwie" + ,"dwoje" + ,"dzis" + ,"dziś" + ,"dzisiaj" + ,"gdy" + ,"gdyby" + ,"gdyz" + ,"gdyż" + ,"gdzie" + ,"gdziekolwiek" + ,"gdzies" + ,"gdzieś" + ,"go" + ,"i" + ,"ich" + ,"ile" + ,"im" + ,"inna" + ,"inne" + ,"inny" + ,"innych" + ,"iz" + ,"iż" + ,"ja" + ,"ją" + ,"jak" + ,"jakas" + ,"jakaś" + ,"jakby" + ,"jaki" + ,"jakichs" + ,"jakichś" + ,"jakie" + ,"jakis" + ,"jakiś" + ,"jakiz" + ,"jakiż" + ,"jakkolwiek" + ,"jako" + ,"jakos" + ,"jakoś" + ,"je" + ,"jeden" + ,"jedna" + ,"jedno" + ,"jednak" + ,"jednakze" + ,"jednakże" + ,"jego" + ,"jej" + ,"jemu" + ,"jest" + ,"jestem" + ,"jeszcze" + ,"jesli" + ,"jeśli" + ,"jezeli" + ,"jeżeli" + ,"juz" + ,"już" + ,"kazdy" + ,"każdy" + ,"kiedy" + ,"kilka" + ,"kims" + ,"kimś" + ,"kto" + ,"ktokolwiek" + ,"ktos" + ,"ktoś" + ,"ktora" + ,"ktore" + ,"które" + ,"ktorego" + ,"ktorej" + ,"ktory" + ,"ktorych" + ,"ktorym" + ,"ktorzy" + ,"która" + ,"którego" + ,"której" + ,"który" + ,"których" + ,"którym" + ,"którzy" + ,"ku" + ,"lat" + ,"lecz" + ,"lub" + ,"ma" + ,"mają" + ,"mało" + ,"mam" + ,"mi" + ,"mimo" + ,"miedzy" + ,"między" + ,"mna" + ,"mną" + ,"mnie" + ,"moga" + ,"mogą" + ,"moi" + ,"moim" + ,"moja" + ,"moje" + ,"moze" + ,"może" + ,"mozliwe" + ,"mozna" + ,"możliwe" + ,"można" + ,"moj" + ,"mój" + ,"mu" + ,"musi" + ,"my" + ,"na" + ,"nad" + ,"nam" + ,"nami" + ,"nas" + ,"nasi" + ,"nasz" + ,"nasza" + ,"nasze" + ,"naszego" + ,"naszych" + ,"natomiast" + ,"natychmiast" + ,"nawet" + ,"nia" + ,"nią" + ,"nic" + ,"nich" + ,"nie" + ,"niech" + ,"niego" + ,"niej" + ,"niemu" + ,"nigdy" + ,"nim" + ,"nimi" + ,"niz" + ,"niż" + ,"no" + ,"o" + ,"obok" + ,"od" + ,"około" + ,"on" + ,"ona" + ,"one" + ,"oni" + ,"ono" + ,"oraz" + ,"oto" + ,"owszem" + ,"pan" + ,"pana" + ,"pani" + ,"po" + ,"pod" + ,"podczas" + ,"pomimo" + ,"ponad" + ,"poniewaz" + ,"ponieważ" + ,"powinien" + ,"powinna" + ,"powinni" + ,"powinno" + ,"poza" + ,"prawie" + ,"przeciez" + ,"przecież" + ,"przed" + ,"przede" + ,"przedtem" + ,"przez" + ,"przy" + ,"roku" + ,"rowniez" + ,"również" + ,"sam" + ,"sama" + ,"są" + ,"sie" + ,"się" + ,"skad" + ,"skąd" + ,"sobie" + ,"soba" + ,"sobą" + ,"sposob" + ,"sposób" + ,"swoje" + ,"ta" + ,"tak" + ,"taka" + ,"taki" + ,"takie" + ,"takze" + ,"także" + ,"tam" + ,"te" + ,"tego" + ,"tej" + ,"ten" + ,"teraz" + ,"też" + ,"to" + ,"toba" + ,"tobą" + ,"tobie" + ,"totez" + ,"toteż" + ,"trzeba" + ,"tu" + ,"tutaj" + ,"twoi" + ,"twoim" + ,"twoja" + ,"twoje" + ,"twym" + ,"twoj" + ,"twój" + ,"ty" + ,"tych" + ,"tylko" + ,"tym" + ,"u" + ,"w" + ,"wam" + ,"wami" + ,"was" + ,"wasz" + ,"wasza" + ,"wasze" + ,"we" + ,"według" + ,"wiele" + ,"wielu" + ,"więc" + ,"więcej" + ,"wszyscy" + ,"wszystkich" + ,"wszystkie" + ,"wszystkim" + ,"wszystko" + ,"wtedy" + ,"wy" + ,"wlasnie" + ,"właśnie" + ,"z" + ,"za" + ,"zapewne" + ,"zawsze" + ,"ze" + ,"znowu" + ,"znow" + ,"znów" + ,"zostal" + ,"został" + ,"zaden" + ,"zadna" + ,"zadne" + ,"zadnych" + ,"ze" + ,"zeby" + ,"żaden" + ,"żadna" + ,"żadne" + ,"żadnych" + ,"że" + ,"żeby" + ] diff --git a/src/Glider/NLP/Statistics.hs b/src/Glider/NLP/Statistics.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Statistics.hs @@ -0,0 +1,35 @@ +{- | +Module : Glider.NLP.Statistics +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +This module counts different statistics on the text + +-} +module Glider.NLP.Statistics + ( countWords + , wordFreq + ) where + +import Prelude hiding(length) +import Data.Text +import Glider.NLP.Tokenizer +import qualified Data.List as List + + +-- | Count number of words in the text. +-- +-- > countWords (T.pack "one two three") == 3 +countWords :: Text -> Int +countWords = List.length . getWords . tokenize + +-- | Count word frequency +-- +-- > wordFreq (T.pack "one two, three one") == [("one", 2), ("two", 1), ("three", 1)] +wordFreq :: Text -> [(Text, Int)] +wordFreq a = [(List.head xs, List.length xs) | xs <- List.group tokens] + where tokens = List.sort $ (foldCase . getWords . tokenize) a diff --git a/src/Glider/NLP/Tokenizer.hs b/src/Glider/NLP/Tokenizer.hs new file mode 100644 --- /dev/null +++ b/src/Glider/NLP/Tokenizer.hs @@ -0,0 +1,118 @@ +{- | +Module : Glider.NLP.Tokenizer +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable + +This module contains functions which parses text into tokens. +tokens are not normalized. If you need all tokens from the document then +check function "tokenize". If you need only words (na dots, numbers etc.) +then check function "getWords". + +-} +module Glider.NLP.Tokenizer + ( Token(..) + , foldCase + , getWords + , tokenize + , wordParser + , numberParser + , punctuationParser + , symbolParser + , spaceParser + , allParser + ) where + +import Prelude hiding (null, takeWhile, dropWhile, head, tail) +import Data.Text +import Data.Char +import qualified Data.List as List + +-- | Token type +data Token = Word Text + | Number Text + | Punctuation Char + | Symbol Char + | Whitespace + | Unknown Char + deriving (Eq, Show) + + +-- | Split text into tokens +-- +-- > tokenize "one two." == [Word "one", Whitespace, Word "two", "Separator "."] +tokenize :: Text -> [Token] +tokenize xs = case allParser xs of + [(v, out)] -> (v:tokenize out) + _ -> [] + +-- | Exctract all words from tokens +-- +-- > getWords "one two." == ["one", "two"] +getWords :: [Token] -> [Text] +getWords [] = [] +getWords (x:xs) = case x of + Word a -> (a: getWords xs) + _ -> getWords xs + +-- | Convert all words to the same case +foldCase :: [Text] -> [Text] +foldCase = List.map toCaseFold + + +-- | Parser type +type Parser = Text -> [(Token, Text)] + +-- | Parse word +wordParser :: Parser +wordParser xs | null xs = [] + | isLetter (head xs) = [(Word (takeWhile isAlphaNum xs), dropWhile isAlphaNum xs)] + | otherwise = [] + +-- | Parse number +numberParser :: Parser +numberParser xs | null xs = [] + | isDigit (head xs) = [(Number (takeWhile isDigit xs), dropWhile isDigit xs)] + | otherwise = [] + +-- | Parse punctuation +punctuationParser :: Parser +punctuationParser xs | null xs = [] + | isPunctuation (head xs) = [(Punctuation (head xs), (tail xs))] + | otherwise = [] + +-- | Parse symbol +symbolParser :: Parser +symbolParser xs | null xs = [] + | isSymbol (head xs) = [(Symbol (head xs), (tail xs))] + | otherwise = [] + +-- | Parse whitespaces +spaceParser :: Parser +spaceParser xs | null xs = [] + | isSpace (head xs) = [(Whitespace, dropWhile isSpace xs)] + | otherwise = [] + +-- | Parse single char +charParser :: Parser +charParser xs | null xs = [] + | otherwise = [(Unknown (head xs), tail xs)] + +-- | Apply all parsers to the input. +-- Return result from the first which will parse correctly given text. +allParser :: Parser +allParser xs = case wordParser xs of + [(v, out)] -> [(v, out)] + _ -> case numberParser xs of + [(v, out)] -> [(v, out)] + _ -> case punctuationParser xs of + [(v, out)] -> [(v, out)] + _ -> case symbolParser xs of + [(v, out)] -> [(v, out)] + _ -> case spaceParser xs of + [(v, out)] -> [(v, out)] + _ -> charParser xs + diff --git a/test-src/AllTests.hs b/test-src/AllTests.hs new file mode 100644 --- /dev/null +++ b/test-src/AllTests.hs @@ -0,0 +1,17 @@ +module AllTests (tests) where + +import qualified Distribution.TestSuite as C +import qualified Distribution.TestSuite.HUnit as H +import Glider.NLP.TokenizerTest (testCases) +import Glider.NLP.StatisticsTest (testCases) +import Glider.NLP.Language.English.PorterTest (testCases) +import Glider.NLP.Language.DefaultTest (testCases) + + +tests :: IO [C.Test] +tests = return $ map (uncurry H.test) $ Glider.NLP.TokenizerTest.testCases + ++ Glider.NLP.Language.English.PorterTest.testCases + ++ Glider.NLP.Language.DefaultTest.testCases + ++ Glider.NLP.StatisticsTest.testCases + + diff --git a/test-src/Distribution/TestSuite/HUnit.hs b/test-src/Distribution/TestSuite/HUnit.hs new file mode 100644 --- /dev/null +++ b/test-src/Distribution/TestSuite/HUnit.hs @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------- +-- | +-- Module : Distribution.TestSuite.HUnit +-- Copyright : Patrick Brisbin 2013 +-- +-- Maintainer : pbrisbin@gmail.com +-- Portability : portable +-- +-- Test interface for running HUnit tests via cabal. +-- +-- Usage: +-- +-- > import Test.HUnit +-- > +-- > import qualified Distribution.TestSuite as C +-- > import qualified Distribution.TestSuite.HUnit as H +-- > +-- > tests :: IO [C.Test] +-- > tests = return $ map (uncurry H.test) testCases +-- > +-- > testCases :: [(String, Test)] +-- > testCases = [("Truth test", truthTest)] +-- > +-- > truthTest :: Test +-- > truthTest = assertEqual True True +-- +-- An early version of this module, written by Thomas Tuegel +-- , can be found at: +-- +-- +-- +-- This file shares no code with that one, as the changes in Cabal 1.16 +-- required it be entirely rewritten. I've retained Thomas' LICENSE but +-- removed his copyright; I hope that's appropriate. +-- +------------------------------------------------------------------------------- +module Distribution.TestSuite.HUnit (test) where + +import Distribution.TestSuite +import qualified Test.HUnit as H + +test :: String -> H.Test -> Test +test n = Test . testInstance n + +testInstance :: String -> H.Test -> TestInstance +testInstance n t = TestInstance + { run = runTest t + , name = n + , tags = [] + , options = [] + , setOption = \_ _ -> Right $ testInstance n t + } + +runTest :: H.Test -> IO Progress +runTest = fmap snd . H.performTest onStart onError onFailure (Finished Pass) + + where + + onStart :: H.State -> Progress -> IO Progress + onStart _ = return + + onError :: String -> H.State -> Progress -> IO Progress + onError msg _ _ = return $ Finished (Error msg) + + onFailure :: String -> H.State -> Progress -> IO Progress + onFailure msg _ _ = return $ Finished (Fail msg) diff --git a/test-src/Glider/NLP/Language/DefaultTest.hs b/test-src/Glider/NLP/Language/DefaultTest.hs new file mode 100644 --- /dev/null +++ b/test-src/Glider/NLP/Language/DefaultTest.hs @@ -0,0 +1,28 @@ +{- | +Module : Glider.NLP.Language.DefaultTest +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable +-} + +module Glider.NLP.Language.DefaultTest (testCases) where + +import Data.Text +import Glider.NLP.Language.Default +import Test.HUnit + + +testCases :: [(String, Test)] +testCases = [ ( "Less then 4 chars" + , TestCase $ prop_isStopWord "abc" True) + , ( "4 chars not stop word" + , TestCase $ prop_isStopWord "abcd" False) + ] + +-- | Check empty index +prop_isStopWord :: String -> Bool -> Assertion +prop_isStopWord a e = assertEqual a e (isStopWord (pack a)) + diff --git a/test-src/Glider/NLP/Language/English/PorterTest.hs b/test-src/Glider/NLP/Language/English/PorterTest.hs new file mode 100644 --- /dev/null +++ b/test-src/Glider/NLP/Language/English/PorterTest.hs @@ -0,0 +1,34 @@ +{- | +Module : Glider.NLP.Language.English.Porter2Test +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable +-} + +module Glider.NLP.Language.English.PorterTest (testCases) where + +import qualified Data.Text as T +import Glider.NLP.Language.English.Porter +import Test.HUnit + + +testCases :: [(String, Test)] +testCases = [("Porter", t) | t <- tests] + +tests :: [Test] +tests = [ TestCase $ prop_stem "consign" "consign" + , TestCase $ prop_stem "class's" "class'" + , TestCase $ prop_stem "classes" "class" + , TestCase $ prop_stem "cried" "cri" + , TestCase $ prop_stem "ties" "ti" + , TestCase $ prop_stem "gas" "ga" + , TestCase $ prop_stem "gaps" "gap" + , TestCase $ prop_stem "bleed" "bleed" + , TestCase $ prop_stem "guaranteed" "guarante" + ] + +prop_stem :: String -> String -> Assertion +prop_stem a b = assertEqual a (T.pack b) (stem (T.pack a)) diff --git a/test-src/Glider/NLP/StatisticsTest.hs b/test-src/Glider/NLP/StatisticsTest.hs new file mode 100644 --- /dev/null +++ b/test-src/Glider/NLP/StatisticsTest.hs @@ -0,0 +1,39 @@ +{- | +Module : Glider.NLP.IndexTest +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable +-} + +module Glider.NLP.StatisticsTest (testCases) where + +import qualified Data.Text as T +import Glider.NLP.Statistics +import Test.HUnit + + +testCases :: [(String, Test)] +testCases = [ ( "Count words" + , TestCase $ prop_countWords "one two three" 3) + + , ( "Single word frequency" + , TestCase $ prop_wordFreq "one" [("one", 1)]) + + , ( "2 words frequency" + , TestCase $ prop_wordFreq "one two" [("one", 1), ("two", 1)]) + + , ( "Multi words frequency" + , TestCase $ prop_wordFreq "one two one" [("one", 2), ("two", 1)]) + ] + +-- | Count number of words +prop_countWords :: String -> Int -> Assertion +prop_countWords xs n = assertEqual xs n $ countWords (T.pack xs) + +-- | Check word frequency +prop_wordFreq :: String -> [(String, Int)] -> Assertion +prop_wordFreq xs es = assertEqual xs expected $ wordFreq (T.pack xs) + where expected = [(T.pack a, b) | (a, b) <- es] diff --git a/test-src/Glider/NLP/TokenizerTest.hs b/test-src/Glider/NLP/TokenizerTest.hs new file mode 100644 --- /dev/null +++ b/test-src/Glider/NLP/TokenizerTest.hs @@ -0,0 +1,35 @@ +{- | +Module : Glider.NLP.TokenizerTest +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +Stability : alpha +Portability : portable +-} + +module Glider.NLP.TokenizerTest (testCases) where + +import qualified Data.Text as T +import Glider.NLP.Tokenizer +import Test.HUnit + + +testCases :: [(String, Test)] +testCases = [ ( "Empty string" + , TestCase $ prop_tokenize [] "" + ) + + , ( "Empty string" + , TestCase $ prop_tokenize [ Word $ T.pack "one" + , Whitespace + , Word $ T.pack "two" + , Whitespace + , Word $ T.pack "three" + ] + "one two three" + ) + ] + +prop_tokenize :: [Token] -> String -> Assertion +prop_tokenize e a = assertEqual a e (tokenize (T.pack a))