diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2012, Computational Linguistics Ltd. + +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. + + * Neither the name of Computational Linguistics Ltd. nor the + names of other contributors may be used to endorse or promote + products derived from this software without specific prior written + permission. + +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/NLP/Minimorph/English.hs b/NLP/Minimorph/English.hs new file mode 100644 --- /dev/null +++ b/NLP/Minimorph/English.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE ViewPatterns, OverloadedStrings #-} +-- TODO : learn how to use Functional Morphology instead +-- http://www.paulnoll.com/Books/Clear-English/English-plurals-1.html + +-- | Module : NLP.Minimorph.English +-- Copyright : 2012 Eric Kow (Computational Linguistics Ltd.) +-- License : BSD3 +-- Maintainer : eric.kow@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Simple default rules for English morphology +module NLP.Minimorph.English where + +import Data.Text ( Text ) +import qualified Data.Text as T + +import NLP.Minimorph.Util + +-- | No Oxford commas, alas. +-- +-- > commas "and" "foo bar" == "foo and bar" +-- > commas "and" "foo, bar, baz" == "foo, bar and baz" +commas :: Text -> [Text] -> Text +commas _ [] = "" +commas _ [x] = x +commas et xs = T.intercalate ", " (init xs) <+> et <+> last xs + +-- | > cardinal 1 == "one" +-- > cardinal 2 == "two" +-- > cardinal 3 == "three" +-- > cardinal 4 == "4" +cardinal :: Int -> Text +cardinal n = case n of + 1 -> "one" + 2 -> "two" + 3 -> "three" + _ -> T.pack (show n) + +-- | > cardinal 1 == "first" +-- > cardinal 2 == "second" +-- > cardinal 3 == "third" +-- > cardinal 4 == "4th" +ordinal :: Int -> Text +ordinal n = case n of + 1 -> "first" + 2 -> "second" + 3 -> "third" + n | n < 21 -> n `suf` "th" + | n `rem` 10 == 2 -> n `suf` "nd" + | n `rem` 10 == 3 -> n `suf` "rd" + | otherwise -> n `suf` "th" + where + n `suf` s = T.pack (show n) <> s + +-- | Heuristics for English plural for an unknown noun +-- +-- > defaultNounPlural "egg" == "eggs" +-- > defaultNounPlural "patch" == "patches" +-- > defaultNounPlural "boy" == "boys" +-- > defaultNounPlural "spy" == "spies" +-- > defaultNounPlural "thesis" == "theses" +defaultNounPlural :: Text -> Text +defaultNounPlural x + | "is" `T.isSuffixOf` x = thesis + | hasSibilantSuffix x = es + | hasCySuffix x = y_ies + | "f" `T.isSuffixOf` x = f_ves + | otherwise = plain + where + plain = x <> "s" + es = x <> "es" + y_ies = T.init x <> "ies" + f_ves = T.init x <> "ves" + thesis = tDropEnd 2 x <> "es" + +-- | Heuristics for 3rd person singular and past participle +-- for an unknown regular verb +-- +-- > defaultVerbStuff "walk" == ("walks", "walked") +-- > defaultVerbStuff "push" == ("pushes", "pushed") +-- > defaultVerbStuff "play" == ("plays", "played") +-- > defaultVerbStuff "cry" == ("cries", "cried") +defaultVerbStuff :: Text -> (Text, Text) +defaultVerbStuff v + | hasSibilantSuffix v = sibilant_o v + | "o" `T.isSuffixOf` v = sibilant_o v + | "e" `T.isSuffixOf` v = e_final v + | hasCySuffix v = y_final v + | otherwise = plain v + where + plain x = (x <> "s" , x <> "ed") + sibilant_o x = (x <> "es" , x <> "ed") + e_final x = (x <> "s" , x <> "d") + y_final x = (T.init x <> "ies", T.init x <> "ied") + +-- | > indefiniteDet "dog" == "a" +-- > indefiniteDet "egg" == "an" +-- > indefiniteDet "ewe" == "a" +-- > indefiniteDet "ewok" == "an" +indefiniteDet :: Text -> Text +indefiniteDet (T.toLower -> t) = + if useAn then "an" else "a" + where + useAn = case T.uncons t of + Just (h,_) -> isVowel h `butNot` hasSemivowelPrefix t + Nothing -> False + x `butNot` y = x && not y + +-- | Ends with a sh sound +hasSibilantSuffix :: Text -> Bool +hasSibilantSuffix x = any (`T.isSuffixOf` x) ["x","s","ch","sh"] + +-- | Starts with a semivowel +hasSemivowelPrefix :: Text -> Bool +hasSemivowelPrefix ls = any (`T.isPrefixOf` ls) ["y","w","eu","ewe"] + +-- | Last two letters are a consonant and 'y' +hasCySuffix :: Text -> Bool +hasCySuffix (T.unpack . tTakeEnd 2 -> [x, 'y']) = isConsonant x +hasCySuffix _ = False + +-- | Is a vowel +-- (this includes @'1'@ and @'8'@ because of @"one"@ and @"eight"@) +isVowel :: Char -> Bool +isVowel = (`elem` "aeiouAEIOU18") + +-- | Is a consonant +isConsonant :: Char -> Bool +isConsonant = not . isVowel diff --git a/NLP/Minimorph/Util.hs b/NLP/Minimorph/Util.hs new file mode 100644 --- /dev/null +++ b/NLP/Minimorph/Util.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Module : NLP.Minimorph.Util +-- Copyright : 2012 Eric Kow (Computational Linguistics Ltd.) +-- License : BSD3 +-- Maintainer : eric.kow@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Utility functions probably internal to minimorph +module NLP.Minimorph.Util where + +import Data.Text ( Text ) +import qualified Data.Text as T + +-- | @tTakeEnd n t@ returns the last @n@ letters of @t@ +tTakeEnd :: Int -> Text -> Text +tTakeEnd n t = T.drop (T.length t - n) t + +-- | @tDropEnd n t@ drops the last @n@ letters of @t@ +tDropEnd :: Int -> Text -> Text +tDropEnd n x = T.take (T.length x - n) x + +-- | Identical to 'T.append' +(<>) :: Text -> Text -> Text +t1 <> t2 = t1 `T.append` t2 + +-- | Separated by space unless one of them is empty (in which case just +-- the non-empty one) +(<+>) :: Text -> Text -> Text +t1 <+> t2 | T.null t1 = t2 + | T.null t2 = t1 + | otherwise = t1 `T.append` " " `T.append` t2 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/minimorph.cabal b/minimorph.cabal new file mode 100644 --- /dev/null +++ b/minimorph.cabal @@ -0,0 +1,46 @@ +-- Initial minimorph.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: minimorph +version: 0.1.0.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). + You will need to complement this with some account for + irregular nouns/verbs. This package is not meant to provide + anything resembling a full account of English morphology + (something like Functional Morphology or sequor could be + better suited). The main goal is to provide something cheap + and cheerful with no learning curve, that you can use until + your application calls for more robustness. +homepage: http://darcsden.com/kowey/minimorph +license: BSD3 +license-file: LICENSE +author: Eric Kow +maintainer: eric.kow@gmail.com +-- copyright: +category: Natural Language Processing +build-type: Simple +cabal-version: >=1.8 + +source-repository head + type: darcs + location: http://darcsden.com/kowey/minimorph + +library + exposed-modules: NLP.Minimorph.English + NLP.Minimorph.Util + -- other-modules: + build-depends: base < 5 + , text + +test-suite test-minimorph + type: exitcode-stdio-1.0 + main-is: test-minimorph.hs + hs-Source-Dirs: test + build-depends: base < 5 + , HUnit + , minimorph + , test-framework + , test-framework-hunit + , text diff --git a/test/test-minimorph.hs b/test/test-minimorph.hs new file mode 100644 --- /dev/null +++ b/test/test-minimorph.hs @@ -0,0 +1,10 @@ +import Test.HUnit +import Test.Framework.Providers.HUnit +import Test.Framework + +import qualified NLP.Minimorph.EnglishTest + +main :: IO () +main = defaultMain + [ NLP.Minimorph.EnglishTest.suite + ]