minimorph 0.1.1.0 → 0.1.3.0
raw patch · 2 files changed
+121/−22 lines, 2 files
Files
- NLP/Minimorph/English.hs +119/−20
- minimorph.cabal +2/−2
NLP/Minimorph/English.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ViewPatterns, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} -- TODO : learn how to use Functional Morphology instead -- | Module : NLP.Minimorph.English@@ -11,11 +12,16 @@ -- Simple default rules for English morphology module NLP.Minimorph.English where -import Data.Text ( Text )-import qualified Data.Text as T+import Data.Char (toLower, isSpace, isUpper)+import Data.Text (Text)+import qualified Data.Text as T -import NLP.Minimorph.Util+import NLP.Minimorph.Util +-- ---------------------------------------------------------------------+-- ** Punctuation+-- ---------------------------------------------------------------------+ -- | No Oxford commas, alas. -- -- > commas "and" "foo bar" == "foo and bar"@@ -25,26 +31,45 @@ commas _ [x] = x commas et xs = T.intercalate ", " (init xs) <+> et <+> last xs +-- ---------------------------------------------------------------------+-- ** Numbers+-- ---------------------------------------------------------------------+ -- | > cardinal 1 == "one" -- > cardinal 2 == "two" -- > cardinal 3 == "three"--- > cardinal 4 == "4"+-- > cardinal 11 == "11" cardinal :: Int -> Text cardinal n = case n of- 1 -> "one"- 2 -> "two"- 3 -> "three"+ 1 -> "one"+ 2 -> "two"+ 3 -> "three"+ 4 -> "four"+ 5 -> "five"+ 6 -> "six"+ 7 -> "seven"+ 8 -> "eight"+ 9 -> "nine"+ 10 -> "ten" _ -> T.pack (show n) --- | > cardinal 1 == "first"--- > cardinal 2 == "second"--- > cardinal 3 == "third"--- > cardinal 4 == "4th"+-- | > ordinal 1 == "first"+-- > ordinal 2 == "second"+-- > ordinal 3 == "third"+-- > ordinal 11 == "11th"+-- > ordinal 42 == "42nd" ordinal :: Int -> Text ordinal n = case n of- 1 -> "first"- 2 -> "second"- 3 -> "third"+ 1 -> "first"+ 2 -> "second"+ 3 -> "third"+ 4 -> "fourth"+ 5 -> "fifth"+ 6 -> "sixth"+ 7 -> "seventh"+ 8 -> "eighth"+ 9 -> "ninth"+ 10 -> "tenth" n | n < 21 -> n `suf` "th" | n `rem` 10 == 2 -> n `suf` "nd" | n `rem` 10 == 3 -> n `suf` "rd"@@ -52,6 +77,10 @@ where n `suf` s = T.pack (show n) <> s +-- ---------------------------------------------------------------------+-- ** Nouns and verbs+-- ---------------------------------------------------------------------+ -- | Heuristics for English plural for an unknown noun -- -- > defaultNounPlural "egg" == "eggs"@@ -95,22 +124,81 @@ e_final x = (x <> "s" , x <> "d") y_final x = (T.init x <> "ies", T.init x <> "ied") +-- ---------------------------------------------------------------------+-- ** Determiners+-- ---------------------------------------------------------------------+ -- | > indefiniteDet "dog" == "a" -- > indefiniteDet "egg" == "an" -- > indefiniteDet "ewe" == "a" -- > indefiniteDet "ewok" == "an" -- > indefiniteDet "8th" == "an" indefiniteDet :: Text -> Text-indefiniteDet (T.toLower -> t) =- if useAn then "an" else "a"+indefiniteDet t = if wantsAn t then "an" else "a"++-- | True if the indefinite determiner for a word would normally be+-- 'an' as opposed to 'a'+wantsAn :: Text -> Bool+wantsAn t_ =+ if startsWithAcronym t_+ then acronymWantsAn t_+ else useAn0 || useAn1 || useAn2 where- useAn = t `elem` [ "11", "11th" ] || useAn'- useAn' = case T.uncons t of+ t = T.toLower t_+ useAn0 = t `elem` [ "11", "11th" ]+ useAn1 = case T.uncons t of Just ('8',_) -> True Just (h,_) -> isVowel h `butNot` hasSemivowelPrefix t Nothing -> False+ useAn2 = case T.break isSep t of+ (T.unpack -> [c], _) -> isLetterWithInitialVowelSound c+ _ -> False x `butNot` y = x && not y+ isSep c = isSpace c || c `elem` "-" +-- | Variant of 'wantsAn' that assumes the input string is pronounced+-- one letter at a time.+--+-- > wantsAn "x-ray" == False+-- > acronymWantsAn "x-ray" == True+--+-- Note that this won't do the right thing for words like @"SCUBA"@+-- You really have to reserve it for those separate-letter acronyms+acronymWantsAn :: Text -> Bool+acronymWantsAn (T.toLower -> t) =+ useAn0 || useAn1+ where+ useAn0 = t `elem` [ "11", "11th" ]+ useAn1 = case T.uncons t of+ Just ('8',_) -> True+ Just (h,_) -> isLetterWithInitialVowelSound h+ Nothing -> False++-- ---------------------------------------------------------------------+-- ** Acronyms+-- ---------------------------------------------------------------------++-- | True if all upper case from second letter and up+--+-- > looksLikeAcronym "DNA" == True+-- > looksLikeAcronym "tRNA" == True+-- > looksLikeAcronym "DnA" == False+looksLikeAcronym :: Text -> Bool+looksLikeAcronym x = T.all isUpper (T.drop 1 x)++-- | True if the first word (separating on either - or space)+-- looks like an acronym+startsWithAcronym :: Text -> Bool+startsWithAcronym =+ looksLikeAcronym . firstWord+ where+ firstWord = fst . T.break isSep+ isSep c = isSpace c || c `elem` "-"++-- ---------------------------------------------------------------------+-- ** Sounds+-- ---------------------------------------------------------------------+ -- | Ends with a sh sound hasSibilantSuffix :: Text -> Bool hasSibilantSuffix x = any (`T.isSuffixOf` x) ["x","s","ch","sh"]@@ -126,7 +214,18 @@ -- | Is a vowel isVowel :: Char -> Bool-isVowel = (`elem` "aeiouAEIOU")+isVowel = (`elem` "aeiou") . toLower++-- | Letters that when pronounced independently in English sound like they+-- begin with vowels+--+-- > isLetterWithInitialVowelSound 'r' == True+-- > isLetterWithInitialVowelSound 'k' == False+--+-- (In the above, @'r'@ is pronounced @"are"@, but @'k'@ is pronounced+-- @"kay"@)+isLetterWithInitialVowelSound :: Char -> Bool+isLetterWithInitialVowelSound = (`elem` "aeioufhlmnrsx") . toLower -- | Is a consonant isConsonant :: Char -> Bool
minimorph.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: minimorph-version: 0.1.1.0+version: 0.1.3.0 synopsis: English spelling functions with an emphasis on simplicity. description: A set of simplistic functions capturing the more regular parts of English spelling (for generation, not parsing).@@ -25,7 +25,7 @@ source-repository head type: darcs- location: http://darcsden.com/kowey/minimorph+ location: http://hub.darcs.net/kowey/minimorph library exposed-modules: NLP.Minimorph.English