diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Eric Kow 2008. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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/FullStop.hs b/NLP/FullStop.hs new file mode 100644 --- /dev/null +++ b/NLP/FullStop.hs @@ -0,0 +1,127 @@ +-- Copyright (C) 2009 Eric Kow +-- +-- Permission is hereby granted, free of charge, to any person +-- obtaining a copy of this software and associated documentation +-- files (the "Software"), to deal in the Software without +-- restriction, including without limitation the rights to use, copy, +-- modify, merge, publish, distribute, sublicense, and/or sell copies +-- of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be +-- included in all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. + +module NLP.FullStop ( segment, testSuite ) where + +import Data.Char +import Data.List +import Data.List.Split + +import Test.HUnit +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 + +-- ------------------------------------------------------------ +-- +-- ------------------------------------------------------------ + +testSuite :: Test.Framework.Test +testSuite = + testGroup "NLP.FullStop" + [ testGroup "basic sanity checking" + [ testProperty "concat (segment s) == id s, modulo whitespace" prop_segment_concat + ] + , testGroup "segmentation" + [ testCaseSegments "simple" ["Foo.", "Bar."] "Foo. Bar." + , testCaseSegments "condense" ["What?!", "Yeah"] "What?! Yeah" + , testCaseSegments "URLs" ["Check out http://www.example.com.", "OK?"] + "Check out http://www.example.com. OK?" + , testCaseNoSplit "titles" "Mr. Doe, Mrs. Durand and Dr. Singh" + , testCaseNoSplit "initials" "E. Y. Kow" + , testCaseNoSplit "numbers" "version 2.3.99.2" + -- TODO: what's a good way of dealing with ellipsis? + -- TODO: He said "Foo." Bar (tricky because Foo. "Bar" is legit) + -- TODO: Very likely to be cases where it's just plain ambiguous + ] + ] + +testCaseNoSplit d x = testCaseSegments d [x] x +testCaseSegments d xs x = testCase d $ assertEqual "" xs (segment x) + +-- TODO: perhaps create a newtype that skews the random generation of tests +-- towards things that look more like text (but not too much, because we still +-- want to make sure we're covering edge-cases) + +prop_segment_concat s = + noWhite s == concatMap noWhite (segment s) + where + noWhite = filter (not . isSpace) + +-- ------------------------------------------------------------ +-- +-- ------------------------------------------------------------ + +-- | 'segment' @s@ splits @s@ into a list of sentences. +-- +-- It looks for punctuation characters that indicate an +-- end-of-sentence and tries to ignore some uses of +-- puncuation which do not correspond to ends of sentences +-- +-- It's a good idea to view the source code to this module, +-- especially the test suite. +-- +-- I imagine this sort of task is actually ambiguous and that +-- you actually won't be able to write an exact segmenter. +-- +-- It may be a good idea to go see the literature on how to do +-- segmentation right, maybe implement something which returns +-- the N most probable segmentations instead. +segment :: String -> [String] +segment = map (dropWhile isSpace) . squish + . ( split + . condense -- "huh?!" + . dropFinalBlank -- strings that end with terminator + . keepDelimsR -- we want to preserve terminators + $ oneOf stopPunctuation + ) + +stopPunctuation :: [Char] +stopPunctuation = [ '.', '?', '!' ] + +titles :: [String] +titles = [ "Mr.", "Mrs.", "Dr." ] + +-- ------------------------------------------------------------ +-- putting some pieces back together +-- ------------------------------------------------------------ + +squish = squishBy (\_ y -> not (startsWithSpace y)) + . squishBy (\x _ -> looksLikeAnInitial x) + . squishBy (\x _ -> any (`isSuffixOf` x) titles) + . squishBy (\x y -> endsWithDigit x && startsWithDigit y) + where + looksLikeAnInitial [_,'.'] = True + looksLikeAnInitial _ = False + -- + startsW f [] = False + startsW f (x:_) = f x + -- + startsWithDigit = startsW isDigit + startsWithSpace = startsW isSpace + -- + endsWithDigit xs = + case reverse xs of + ('.':x:_) -> isDigit x + _ -> False + +squishBy f = map concat . groupBy f diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,14 @@ +import Distribution.PackageDescription +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup + +import System.Cmd +import System.FilePath + +main = defaultMainWithHooks hooks + where hooks = simpleUserHooks { runTests = runTests' } + +runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () +runTests' _ _ _ lbi = system testprog >> return () + where testprog = (buildDir lbi) "hstest-fullstop" "hstest-fullstop" diff --git a/Tests.hs b/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,10 @@ +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 + +import NLP.FullStop ( testSuite ) + +main :: IO () +main = defaultMain + [ NLP.FullStop.testSuite + ] diff --git a/fullstop.cabal b/fullstop.cabal new file mode 100644 --- /dev/null +++ b/fullstop.cabal @@ -0,0 +1,39 @@ +name: fullstop +version: 0.1 +synopsis: Simple sentence segmenter +description: FullStop splits texts into sentences, using some orthographical + conventions (used in English and hopefully other languages). + . + It recognises certain punctuation characters as sentence + delimiters (@.?!@) and handles some abbreviations such as + @Mr.@ and decimal numbers (eg. @4.2@). + . + Note that this package is mostly a placeholder. I hope + the Haskell/NLP communities will run with it and upload + a more sophisticated (family of) segmenter(s) in its + place. Patches (and new maintainers) would be greeted + with delight! +category: Natural Language Processing +license: BSD3 +license-file: LICENSE +author: Eric Kow +maintainer: Eric Kow +homepage: http://patch-tag.com/r/kowey/fullstop +cabal-version: >= 1.6 +build-type: Custom + +library + exposed-modules: NLP.FullStop + + -- NB: there actualy isn't any particular need for GHC 6.10 + build-Depends: base >= 3 && < 4.1 + , HUnit == 1.2.* + , QuickCheck == 2.1.* + , test-framework == 0.2.* + , test-framework-hunit == 0.2.* + , test-framework-quickcheck2 == 0.2.* + , split == 0.1.* + + +executable hstest-fullstop + main-is: Tests.hs