diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,34 @@ +Copyright © 2008 Bart Massey +ALL RIGHTS RESERVED + +[This program is licensed under the "3-clause ('new') BSD License"] + +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 the copyright holder, nor the names + of other affiliated organizations, 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/PCDB.hs b/PCDB.hs new file mode 100644 --- /dev/null +++ b/PCDB.hs @@ -0,0 +1,93 @@ +--- Spelling word suggestion tool +--- Copyright © 2008 Bart Massey +--- ALL RIGHTS RESERVED + +--- This software is licensed under the "3-clause ('new') +--- BSD License". Please see the file COPYING provided with +--- this distribution for license terms. + +-- |Create and maintain a nonvolatile database of +-- phonetic codes for cheap lookup + +module PCDB (DBConnection, filePathOfDB, defaultDictionaryForDB, + createDB, openDB, matchDB, closeDB) +where + +import qualified Control.Exception as C +import Database.SQLite +import System.IO +import Text.PhoneticCode.Soundex +import Text.PhoneticCode.Phonix + +import Paths_thimk + +filePathOfDB :: IO String +filePathOfDB = getDataFileName "pcdb.sq3" + +defaultDictionaryForDB :: String +defaultDictionaryForDB = "/usr/share/dict/words" + +showError :: Maybe String -> IO () +showError Nothing = return () +showError (Just s) = fail s + +--- table schema +cw = Column { colName = "word", + colType = SQLVarChar 64, + colClauses = [ PrimaryKey False ] } +cs = Column { colName = "soundex", + colType = SQLVarChar 16, + colClauses = [ IsNullable False ] } +cp = Column { colName = "phonix", + colType = SQLVarChar 16, + colClauses = [ IsNullable False ] } +tab = Table { tabName = "phonetic_codes", + tabColumns = [ cw, cs, cp ], + tabConstraints = [] } + +-- |Create and populate the phonetic codes database. +createDB :: String -> IO () +createDB wfn = do + dbfn <- filePathOfDB + db <- openConnection dbfn + execStatement_ db ("DROP TABLE IF EXISTS " ++ tabName tab ++ ";") + >>= showError + defineTableOpt db True tab >>= showError + wf <- openFile wfn ReadMode + hSetEncoding wf utf8 + wc <- hGetContents wf + let ws = lines wc + execStatement_ db "BEGIN TRANSACTION;" >>= showError + mapM_ (codeRow db) (ws `zip` (map (soundex True) ws `zip` + map phonix ws)) + execStatement_ db "COMMIT;" >>= showError + hClose wf + closeConnection db + where + codeRow db (w, (sc, pc)) = + insertRow db (tabName tab) [(colName cw, w), + (colName cs, sc), + (colName cp, pc)] >>= showError +-- |Database connection. +newtype DBConnection = DBConnection SQLiteHandle + +-- |Get a connection to the database. +openDB :: IO (Maybe DBConnection) +openDB = do + dbfn <- filePathOfDB + C.catch (do db <- openReadonlyConnection dbfn + return (Just (DBConnection db))) + (const (return Nothing) :: C.IOException -> IO (Maybe DBConnection)) + +-- |Return all the words in the given coding system matching the given code. +matchDB :: DBConnection -> String -> String -> IO [String] +matchDB (DBConnection db) coding code = do + result <- execParamStatement db + ("SELECT word FROM phonetic_codes WHERE " ++ coding ++ " = :code ;") + [(":code", Text code)] + case result of + Left msg -> error msg + Right rows -> return (map (snd . head) . head $ rows) + +closeDB :: DBConnection -> IO () +closeDB (DBConnection db) = closeConnection db diff --git a/README.pcdb b/README.pcdb new file mode 100644 --- /dev/null +++ b/README.pcdb @@ -0,0 +1,5 @@ +Running the program thimk-makedb with the necessary +privileges will generate a file thimk.sq3 in this directory. +This file is a database mapping each word in the dictionary +to a phonetic code in each supported coding system. This +will accelerate thimk substantially. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +--- Copyright (C) 2007 Bart Massey +--- ALL RIGHTS RESERVED +--- Please see the file COPYING in this software +--- distribution for license information. + +import Distribution.Simple +main = defaultMain diff --git a/thimk-makedb.hs b/thimk-makedb.hs new file mode 100644 --- /dev/null +++ b/thimk-makedb.hs @@ -0,0 +1,31 @@ +--- Spelling word suggestion tool +--- Copyright © 2008 Bart Massey +--- ALL RIGHTS RESERVED + +--- This software is licensed under the "3-clause ('new') +--- BSD License". Please see the file COPYING provided with +--- this distribution for license terms. + +--- Create the phonetic code database optionally used by "thimk" + +import Text.PhoneticCode.Soundex +import Text.PhoneticCode.Phonix + +import System.Console.ParseArgs + +import PCDB + +data ArgIndex = ArgDict + deriving (Eq, Ord, Show) + +argd = [ Arg { argIndex = ArgDict, + argName = Nothing, + argAbbr = Nothing, + argData = argDataDefaulted "path" + ArgtypeString + defaultDictionaryForDB, + argDesc = "Dictionary file to index" } ] + +main = do + args <- parseArgsIO ArgsComplete argd + createDB (getRequiredArg args ArgDict) diff --git a/thimk.cabal b/thimk.cabal new file mode 100644 --- /dev/null +++ b/thimk.cabal @@ -0,0 +1,42 @@ +name: thimk +version: 0.3 +cabal-version: >= 1.2 +build-type: Simple +license: BSD3 +license-file: COPYING +copyright: Copyright © 2010 Bart Massey +author: Bart Massey +maintainer: bart@cs.pdx.edu +stability: alpha +homepage: http://wiki.cs.pdx.edu/bartforge/thimk +package-url: http://wiki.cs.pdx.edu/cabal-packages/thimk-0.3.tar.gz +data-files: README.pcdb +synopsis: Command-line spelling word suggestion tool +extra-source-files: PCDB.hs +description: + + "thimk" (an old joke) is a command-line spelling word + suggestion tool. You give it a possibly-misspelled word, + and it spits out one or more properly-spelled words in order + of likelihood of similarity. + . + The latest change to the implementation is an addition + of an optional precompiled SQlite database of phonetic + codes for the entire dictionary, created with + "thimk-makedb". This greatly speeds lookup, permitting + reasonable performance on enormous dictionaries. + +category: Console, Text, Application +tested-with: GHC == 6.8.3, GHC == 6.12.1 + +Executable thimk + main-is: thimk.hs + other-modules: PCDB + build-depends: base < 5, parseargs >= 0.1.1, + edit-distance >= 0.1, phonetic-code >= 0.1, + sqlite >= 0.5.1 + +Executable thimk-makedb + main-is: thimk-makedb.hs + other-modules: PCDB + build-depends: parseargs >= 0.1.1, sqlite >= 0.4.1, phonetic-code >= 0.1 diff --git a/thimk.hs b/thimk.hs new file mode 100644 --- /dev/null +++ b/thimk.hs @@ -0,0 +1,145 @@ +--- Spelling word suggestion tool +--- Copyright © 2008 Bart Massey +--- ALL RIGHTS RESERVED + +--- This software is licensed under the "3-clause ('new') +--- BSD License". Please see the file COPYING provided with +--- this distribution for license terms. + +-- | "thimk" (an old joke) is a command-line spelling word +-- suggestion tool. You give it a possibly-misspelled word, +-- and it spits out one or more properly-spelled words in order +-- of likelihood of similarity. +-- +-- The idea and name for thimk came from an old program that used to hang +-- around Reed College, probably written by Graham Ross and +-- now apparently lost in the mists of time. +-- See +-- for the one very vague reference I've found on the web (in the +-- SEE ALSO section of the referenced manpage). +-- +-- The current implementation is a bit more sophisticated +-- than I recall the original being. By +-- default it uses a prefilter that discards words with +-- large edit distances from the target, then filters words +-- with a different phonetic code than the target, then +-- presents the top result sorted by edit distance. +-- +-- The Soundex and Phonix phonetic codes are designed for +-- names, but seem to work about the same with other words. +-- I follow the common practice of not truncating the codes +-- for greater precision, although Phonix does truncate its +-- final "sound" for greater recall. +-- +-- The latest change to the implementation is an addition +-- of an optional precompiled SQlite database of phonetic +-- codes for the entire dictionary, created with +-- "thimk-makedb". This greatly speeds lookup, permitting +-- reasonable performance on enormous dictionaries. + +import System.IO +import Data.List +import Data.Ord + +import Text.EditDistance +import System.Console.ParseArgs + +import Text.PhoneticCode.Soundex +import Text.PhoneticCode.Phonix + +import PCDB + +data ArgIndex = ArgWord + | ArgCode + | ArgPrefilter + | ArgNoPrefilter + | ArgDict + | ArgChoices + deriving (Eq, Ord, Show) + +argd = [ Arg { argIndex = ArgDict, + argName = Just "dictionary", + argAbbr = Just 'd', + argData = argDataDefaulted "path" ArgtypeString + "/usr/share/dict/words", + argDesc = "Dictionary file to search" }, + Arg { argIndex = ArgCode, + argName = Just "code", + argAbbr = Just 'c', + argData = argDataDefaulted "phonetic-code" ArgtypeString + "phonix", + argDesc = "Phonetic code: one of soundex, phonix"}, + Arg { argIndex = ArgChoices, + argName = Nothing, + argAbbr = Just 'n', + argData = argDataDefaulted "choices" ArgtypeInt 1, + argDesc = "Max number of choices to offer"}, + Arg { argIndex = ArgPrefilter, + argName = Just "distance-prefilter", + argAbbr = Nothing, + argData = Nothing, + argDesc = "Discard wildly misspelled words early"}, + Arg { argIndex = ArgNoPrefilter, + argName = Just "no-distance-prefilter", + argAbbr = Nothing, + argData = Nothing, + argDesc = "Do not discard wildly misspelled words early"}, + Arg { argIndex = ArgWord, + argName = Nothing, + argAbbr = Nothing, + argData = argDataRequired "word" ArgtypeString, + argDesc = "Word to be looked up" } ] + +edit_distance s t = + restrictedDamerauLevenshteinDistance ec s t where + ec = EditCosts { + insertionCost = 2, + deletionCost = 2, + transpositionCost = 1, + substitutionCost = 3 } + +try_word :: Bool -> (String -> String) -> Int -> String -> [String] -> [String] +try_word prefilter pcode choices word = + take choices . sortBy (comparing ed) + . map snd + . filter ((== pcode word) . fst) + . map sfs + . prefilter_f + where + sfs w = (pcode w, w) + ed = edit_distance word + prefilter_f = + if prefilter then filter ((<= 10) . ed) else id + +main = do + args <- parseArgsIO ArgsComplete argd + let word = getRequiredArg args ArgWord + let codename = getRequiredArg args ArgCode + let codef = pcode args codename + let choices = getRequiredArg args ArgChoices + mdb <- openDB + (havedb, wordlist) <- case mdb of + Nothing -> do + h <- argFileOpener (getRequiredArg args ArgDict) ReadMode + hSetEncoding h utf8 + c <- hGetContents h + return (False, lines c) + Just db -> do + c <- matchDB db codename (codef word) + return (True, c) + let prefilter = prefilterable args havedb + putStr . unlines $ try_word prefilter codef choices word wordlist + where + prefilterable args havedb = + case npfarg && pfarg of + True -> usageError args "prefilter schizophrenia" + False -> not npfarg && not havedb || pfarg + where + npfarg = gotArg args ArgNoPrefilter + pfarg = gotArg args ArgPrefilter + pcode args codename = + case codename of + "soundex" -> soundex True + "phonix" -> phonix + c -> usageError args ("unknown phonetic code " ++ c) +