diff --git a/morfette.cabal b/morfette.cabal --- a/morfette.cabal +++ b/morfette.cabal @@ -1,36 +1,40 @@ -Name: morfette -Version: 0.3.2 -Homepage: http://sites.google.com/site/morfetteweb/ -Synopsis: A tool for supervised learning of morphology -Description: Morfette is a tool for supervised learning of inflectional - morphology. Given a corpus of sentences annotated with lemmas - and morphological labels, and optionally a lexicon, morfette - learns how to morphologically analyse new sentences. -License: BSD3 -License-file: LICENSE -Author: Grzegorz Chrupała -Maintainer: Grzegorz Chrupała -build-type: Simple -category: Natural Language Processing +Name: morfette +Version: 0.3.4 +Homepage: http://sites.google.com/site/morfetteweb/ +Synopsis: A tool for supervised learning of morphology +Description: Morfette is a tool for supervised learning of inflectional + morphology. Given a corpus of sentences annotated with lemmas + and morphological labels, and optionally a lexicon, morfette + learns how to morphologically analyse new sentences. +License: BSD3 +License-file: LICENSE +Author: Grzegorz Chrupała +Maintainer: Grzegorz Chrupała +build-type: Simple +category: Natural Language Processing Extra-source-files: README, INSTALL, Makefile +cabal-version: >= 1.2 -Executable: morfette -hs-source-dirs: src -Main-Is: Main.hs -Other-Modules: GramLab.Commands, GramLab.Morfette.LZipper, - GramLab.Data.StringLike, - GramLab.Data.CommonSubstrings, GramLab.Data.Diff.EditTree, - GramLab.Morfette.Token, GramLab.Binomial, - GramLab.Perceptron.Vector, GramLab.Data.Assoc, - GramLab.Intern, GramLab.Utils, GramLab.Perceptron.Multiclass, - GramLab.Perceptron.IntModel, GramLab.Morfette.Evaluation, - GramLab.Morfette.Lang.Conf, GramLab.Morfette.MWE, - GramLab.FeatureSet, GramLab.Perceptron.Model, - GramLab.Morfette.Config, GramLab.Morfette.Models, - GramLab.Morfette.Settings.Defaults, - GramLab.Morfette.Features.Common, - Lemma, POS, GramLab.Morfette.Utils -Build-depends: base >=3 && <=5 , containers, array, mtl, - directory, filepath, haskell98, pretty, - utf8-string, bytestring, binary, QuickCheck >= 2.3 -cc-options: -Wall +Executable morfette + hs-source-dirs: src + Main-Is: Main.hs + Other-Modules: GramLab.Commands, GramLab.Morfette.LZipper, + GramLab.Data.StringLike, + GramLab.Data.CommonSubstrings, GramLab.Data.Diff.EditTree, + GramLab.Morfette.Token, GramLab.Binomial, + GramLab.Perceptron.Vector, GramLab.Data.Assoc, + GramLab.Intern, GramLab.Utils, GramLab.Perceptron.Multiclass, + GramLab.Perceptron.IntModel, GramLab.Morfette.Evaluation, + GramLab.Morfette.Lang.Conf, GramLab.Morfette.MWE, + GramLab.FeatureSet, GramLab.Perceptron.Model, + GramLab.Morfette.Config, GramLab.Morfette.Models, + GramLab.Morfette.Settings.Defaults, + GramLab.Morfette.Features.Common, + Lemma, POS, GramLab.Morfette.Utils, + Paths_morfette + Build-depends: base >=3 && <=5 , containers, array, mtl, + directory, filepath, pretty, + utf8-string, bytestring, binary, QuickCheck >= 2.3 + cc-options: -Wall + c-sources: src/ghc_rts_opts.c + ghc-options: -O2 -rtsopts diff --git a/src/GramLab/Commands.hs b/src/GramLab/Commands.hs --- a/src/GramLab/Commands.hs +++ b/src/GramLab/Commands.hs @@ -8,7 +8,7 @@ where import Text.PrettyPrint(renderStyle,render,nest,vcat,hsep,style,Mode(..),mode,text,(<>),($$),($+$),(<+>)) import System.Console.GetOpt -import System +import System.Environment import System.IO (stderr) import System.IO.UTF8 (hPutStr) import qualified Data.List as List diff --git a/src/GramLab/Data/Assoc.hs b/src/GramLab/Data/Assoc.hs --- a/src/GramLab/Data/Assoc.hs +++ b/src/GramLab/Data/Assoc.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE MultiParamTypeClasses , FunctionalDependencies +, FlexibleInstances #-} module GramLab.Data.Assoc ( Assoc , fromAssoc ) diff --git a/src/GramLab/Data/Diff/EditTree.hs b/src/GramLab/Data/Diff/EditTree.hs --- a/src/GramLab/Data/Diff/EditTree.hs +++ b/src/GramLab/Data/Diff/EditTree.hs @@ -7,12 +7,14 @@ ) where -import GramLab.Data.CommonSubstrings +--import GramLab.Data.CommonSubstrings +import Data.List import qualified GramLab.Data.StringLike as S import Data.Maybe (fromMaybe) import Debug.Trace import Data.Binary import Control.Monad (liftM2,liftM4) +import Data.Function make = editTree @@ -28,8 +30,8 @@ (editTree w_prefix w'_prefix) (editTree w_suffix w'_suffix) -lcsi w w' = fmap f (lcs w w') - where f (str,(i_w:_,i_w':_)) = (i_w,i_w_end,i_w',i_w'_end) +lcsi w w' = fmap f (lcString w w') + where f (str,(i_w,i_w')) = (i_w,i_w_end,i_w',i_w'_end) where i_w_end = S.length w - i_w - len i_w'_end = S.length w' - i_w' - len len = S.length str @@ -62,3 +64,16 @@ case tag::Word8 of 0 -> liftM2 Replace get get 1 -> liftM4 Split get get get get + + +lcString xs ys = + case unzip . lcstr xs $ ys of + ([],_) -> fail "No common substring" + (i:is,j:_) -> return $ (map (xs!!) (i:is),(i,j)) +lcstr xs ys = maximumBy (compare `on` length) . concat . reverse + $ [f xs' ysi | xs' <- tails xsi ] + ++ [f xsi ys' | ys' <- drop 1 . tails $ ysi ] + where f xs ys = scanl g [] $ zip xs ys + g z ((x,i), (y,j)) = if x == y then z ++ [(i,j)] else [] + xsi = zip xs [0..] + ysi = zip ys [0..] diff --git a/src/GramLab/Data/StringLike.hs b/src/GramLab/Data/StringLike.hs --- a/src/GramLab/Data/StringLike.hs +++ b/src/GramLab/Data/StringLike.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE MultiParamTypeClasses , FunctionalDependencies +, FlexibleInstances #-} module GramLab.Data.StringLike (StringLike(..)) where import qualified Data.ByteString.Lazy as L diff --git a/src/GramLab/Morfette/Features/Common.hs b/src/GramLab/Morfette/Features/Common.hs --- a/src/GramLab/Morfette/Features/Common.hs +++ b/src/GramLab/Morfette/Features/Common.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} module GramLab.Morfette.Features.Common ( spellingSpec , prefixes , suffixes @@ -16,17 +15,15 @@ where import GramLab.Morfette.Token import GramLab.Morfette.LZipper(LZipper) -import GramLab.FeatureSet(FeatureSet) +import GramLab.FeatureSet import Data.Char import Data.List -import GramLab.FeatureSet import GramLab.Utils (padRight) import Data.Binary import Control.Monad (liftM,liftM2) import GramLab.Morfette.Settings.Defaults import GramLab.Morfette.Models import GramLab.Morfette.LZipper -import GramLab.FeatureSet import GramLab.Morfette.Lang.Conf mapSym f (Sym s) = Sym (f s) diff --git a/src/GramLab/Morfette/Lang/Conf.hs b/src/GramLab/Morfette/Lang/Conf.hs --- a/src/GramLab/Morfette/Lang/Conf.hs +++ b/src/GramLab/Morfette/Lang/Conf.hs @@ -1,4 +1,5 @@ module GramLab.Morfette.Lang.Conf ( Lexicon + , ClusterDict , Conf(..) , Lang , makeConf @@ -6,6 +7,7 @@ , saveConf , readConf , parseLexicon + , parseClusterDict , splitPOS ) where @@ -22,15 +24,19 @@ type Lang = String type Lexicon = Map.Map String [(String, String)] +type ClusterDict = Map.Map String String + data Conf = Conf { dictLex :: Lexicon + , clusterDict :: ClusterDict , lang :: Lang } deriving (Eq) instance Binary Conf where - put (Conf x y) = put x >> put y + put (Conf x y z) = put x >> put y >> put z get = do x <- get y <- get - return (Conf x y) + z <- get + return (Conf x y z) emptyLexicon = Map.empty @@ -45,6 +51,11 @@ readConf path = do txt <- BS.readFile path return (Binary.decode txt) + +parseClusterDict :: String -> ClusterDict +parseClusterDict = Map.fromList + . map (\ln -> let [w,c] = words ln in (w,c)) + . lines parseLexicon :: Maybe (Set.Set String) -> String -> Lexicon parseLexicon toks = diff --git a/src/GramLab/Morfette/MWE.hs b/src/GramLab/Morfette/MWE.hs --- a/src/GramLab/Morfette/MWE.hs +++ b/src/GramLab/Morfette/MWE.hs @@ -1,5 +1,6 @@ module GramLab.Morfette.MWE ( detectMwes , mweSet + , mwes , saveMwes , loadMwes ) @@ -16,24 +17,31 @@ mweSep = '_' mweSet :: [Token] -> [[String]] -mweSet toks = List.sortBy (flip (comparing length)) - . map fst - . filter ((> 1) . snd) - . Map.toList +mweSet = mwes . map tokenForm + +mwes :: [String] -> [[String]] +mwes = List.sortBy (flip (comparing length)) + . filter ((>1) . length) + . Map.keys + . Map.filter (>1) . Map.fromListWith (+) . map (\x -> (x,1)) . map (splitWith (==mweSep)) . filter common - . map tokenForm $ toks where common = all (\c -> isLower c || c `elem` [mweSep,'-']) detectMwes :: [[String]] -> [String] -> [String] -detectMwes mwes [] = [] -detectMwes mwes (x:xs) = case List.find (`List.isPrefixOf` xs') mwes of - Nothing -> x:detectMwes mwes xs - Just mwe -> let len = length mwe - in join [mweSep] (take len (x:xs)) : drop len (x:xs) - where xs' = map lowercase (x:xs) +detectMwes mwes = map (join [mweSep]) . compounds lowercase mwes + +compounds :: (Ord a) => (a -> a) -> [[a]] -> [a] -> [[a]] +compounds f xxs [] = [] +compounds f xxs (y:ys) = + let zs = map f (y:ys) + in case List.find (`List.isPrefixOf` zs) xxs of + Nothing -> [y]:compounds f xxs ys + Just x -> let len = length x + (prefix,ys') = List.splitAt len (y:ys) + in prefix : compounds f xxs ys' saveMwes path mwes = do BS.writeFile path (encode mwes) diff --git a/src/GramLab/Morfette/Models.hs b/src/GramLab/Morfette/Models.hs --- a/src/GramLab/Morfette/Models.hs +++ b/src/GramLab/Morfette/Models.hs @@ -13,7 +13,7 @@ import GramLab.Morfette.LZipper import qualified Data.Map as Map import Data.Map ((!)) -import Data.List (sortBy) +import Data.List (sortBy,foldl',transpose) import Data.Ord (comparing) import Data.Dynamic import GramLab.FeatureSet @@ -114,16 +114,17 @@ . features fs $ z -predict :: Int -> [Model a] -> [[Tok a]] -> [[Tok a]] -predict beamSize models sents = map predictOne sents - where predictOne s = fst - . head +predict :: Int -> Int -> [Model a] -> [[Tok a]] -> [[[Tok a]]] +predict k beamSize models sents = map predictK sents + where predictK s = transpose + . map fst + . take k . beamSearch beamSize models $ [(fromList s,1)] predictPipeline :: Int -> [Model a] -> [[Tok a]] -> [[Tok a]] -predictPipeline beamSize models sents = map predictOne sents - where predictOne s = foldl (\s1 m -> fst . head . beamSearch beamSize [m] +predictPipeline beamSize models sents = map predictK sents + where predictK s = foldl' (\s1 m -> fst . head . beamSearch beamSize [m] $ [(fromList s1,1)]) s models diff --git a/src/GramLab/Morfette/Utils.hs b/src/GramLab/Morfette/Utils.hs --- a/src/GramLab/Morfette/Utils.hs +++ b/src/GramLab/Morfette/Utils.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} module GramLab.Morfette.Utils ( train , predict , Flag(..) @@ -37,13 +36,17 @@ import GramLab.Morfette.Settings.Defaults import GramLab.Intern (Table(..),intern,initial,runState,evalState) import GramLab.FeatureSet (toFeatureSet,FeatureSet) +import qualified Paths_morfette +import Data.Version (Version(..)) import Debug.Trace data Flag = ModelPrefix String | Eval | BeamSize Int + | Multi Int | IgnoreCase | DictFile FilePath + | ClusterFile FilePath | BaselineFile FilePath | Lang Lang | Gaussian Double @@ -74,6 +77,9 @@ , Option [] ["iter-lemma"] (ReqArg (IterLemma . read) "NUM") "iterations for Lemma model" + , Option [] ["cluster-file"] + (ReqArg ClusterFile "PATH") + "path to optional cluster file" ] [ "TRAIN-FILE", "MODEL-DIR" ]) , ("extract-features", CommandSpec (extractFeatures fs fspecs) @@ -95,6 +101,9 @@ , Option [] ["tokenize"] (NoArg Tokenize) "tokenize input" + , Option [] ["multi"] + (ReqArg (Multi . read) "+INT") + "n-best output" ] [ "MODEL-DIR" ] ) , ("eval" , CommandSpec eval @@ -116,8 +125,15 @@ "ignore POS starting with POS-prefix for evaluation" ] ["TRAIN-FILE","GOLD-FILE","TEST-FILE"]) + , ("version", CommandSpec version "show version" [] [] ) + ] +version _ _ = do + let showVersion (Version { versionBranch = is }) = + "morfette-" ++ (List.concat . List.intersperse "." . map show $ is) + putStrLn . showVersion $ Paths_morfette.version + predict (_,format) fspecs flags [modelprefix] = do hPutStrLn stderr $ "Loading models from " ++ (modelFile modelprefix) @@ -131,15 +147,24 @@ defaultBeamSize = 3 n = case [f | BeamSize f <- flags ] of { [f] -> f ; _ -> defaultBeamSize } + k = case [f | Multi f <- flags ] + of { [f] -> f ; _ -> 1 } f = if Pipeline `elem` flags - then Models.predictPipeline - else Models.predict + then if k /= 1 + then error $ "GramLab.Morfette.Utils.predict: " + ++ "pipeline mode doesn't work with n-best output" + else \ n ms -> map (map return) + . Models.predictPipeline n ms + else Models.predict k putStr . unlines . map format . f n models . toksToForms . getToks flags mwes $ txt +predict _fs _fspecs _flags _args = do + error $ "GramLab.Morfette.Utils.predict: " + ++ "Incorrect arguments to command predict." confFile dir = dir "conf.model" mweFile dir = dir "mwe.model" @@ -158,8 +183,10 @@ extractFeatures (prepr,fmt) [fspos,fslem] flags [modeldir] = do dict <- getDict flags Nothing -- dict == dict `seq` return () + clusters <- getClusters flags let langConf = case [f | Lang f <- flags ] of { [] -> "xx" ; [f] -> f } lex = Conf { dictLex = dict + , clusterDict = clusters , lang = langConf } fs = case [f | ModelId f <- flags ] of ["pos"] -> fspos lex @@ -180,7 +207,10 @@ $ xys B.writeFile (classMapFile modeldir) . encode $ ym B.writeFile (featMapFile modeldir) . encode $ xm - +extractFeatures _fs _fspecs _flags _args = do + error $ "GramLab.Morfette.Utils.extractFeatures: " + ++ "Incorrect arguments to command extract-features." + format :: (String,(IntMap.IntMap Double,Int)) -> String format (w,(x,y)) = unwords (w:show y : [ show i ++ ":" ++ show n | (i,n) <- IntMap.toList x ]) @@ -210,8 +240,10 @@ toks <- fmap (map parseToken . lines) (readFile dat) let tokSet = Set.fromList [ s | t@(s,_,_) <- toks ] dict <- getDict flags Nothing + clusters <- getClusters flags let langConf = case [f | Lang f <- flags ] of { [] -> "xx" ; [f] -> f } lex = Conf { dictLex = dict + , clusterDict = clusters , lang = langConf } mwes = mweSet toks g = case [f | EntropyTh f <- flags ] of @@ -237,7 +269,10 @@ B.writeFile (modelFile modeldir) (encode models) saveConf (confFile modeldir) lex saveMwes (mweFile modeldir) mwes - +train _fs _fspecs _flags _args = do + error $ "GramLab.Morfette.Utils.train: " + ++ "Incorrect arguments to command train." + toksToSentences :: (Token -> Models.Tok a) -> [Token] -> [[Models.Tok a]] toksToSentences f toks = map (map f) $ splitWith isNullToken toks @@ -252,11 +287,15 @@ getDict :: [Flag] -> Maybe (Set.Set String) -> IO Lexicon getDict flags tokSet = do case [f | DictFile f <- flags ] of - [f] -> do - d <- fmap (parseLexicon tokSet) $ readFile f - return d + [f] -> fmap (parseLexicon tokSet) $ readFile f [] -> return emptyLexicon +getClusters :: [Flag] -> IO ClusterDict +getClusters flags = do + case [f | ClusterFile f <- flags ] of + [f] -> fmap parseClusterDict $ readFile f + [] -> return Map.empty + getToks :: [Flag] -> [[String]] -> String -> [Token] getToks flags mwes text = let f = if Tokenize `elem` flags @@ -325,7 +364,10 @@ -- putStrLn $ "Sentence accuracy:\n" ++ showAccuracy sent_acc where toks xs = filter (not . isNullToken) xs sents xs = splitWith isNullToken xs - +eval _flags _args = do + error $ "GramLab.Morfette.Utils.eval: " + ++ "Incorrect arguments to command eval." + filterZip :: [Bool] -> [a] -> [a] filterZip xs ys = catMaybes $ zipWith (\b x -> if b then Just x else Nothing) xs ys diff --git a/src/GramLab/Perceptron/Model.hs b/src/GramLab/Perceptron/Model.hs --- a/src/GramLab/Perceptron/Model.hs +++ b/src/GramLab/Perceptron/Model.hs @@ -1,16 +1,17 @@ {-# LANGUAGE FlexibleContexts , BangPatterns #-} -module GramLab.Perceptron.Model ( train - , distribution - , classify - , save - , load - , I.TrainSettings(..) - , Model(..) - , ModelData(..) - , dump - , dumpMapping - , DumpMode(..) - ) +module GramLab.Perceptron.Model + ( train + , distribution + , classify + , save + , load + , I.TrainSettings(..) + , Model(..) + , ModelData(..) + , dump + , dumpMapping + , DumpMode(..) + ) where import qualified GramLab.Perceptron.IntModel as I import qualified Data.ByteString.Lazy as BS diff --git a/src/GramLab/Perceptron/Multiclass.hs b/src/GramLab/Perceptron/Multiclass.hs --- a/src/GramLab/Perceptron/Multiclass.hs +++ b/src/GramLab/Perceptron/Multiclass.hs @@ -12,6 +12,7 @@ import Data.Array.ST import qualified Data.Array.Unboxed as A import Control.Monad.ST +import qualified Control.Monad.ST.Unsafe as STUnsafe import Data.STRef import Control.Monad import GramLab.Perceptron.Vector @@ -152,7 +153,7 @@ writeArray params i (e - (e_a * (1/c'))) {-# NOINLINE runLogger #-} -runLogger f = unsafeIOToST f +runLogger f = STUnsafe.unsafeIOToST f m `at` i = Map.findWithDefault 0 i m diff --git a/src/Lemma.hs b/src/Lemma.hs --- a/src/Lemma.hs +++ b/src/Lemma.hs @@ -11,8 +11,14 @@ , check = theCheck , trainSettings = lemmaTrainSettings } -theCheck z (ES s) = E.check s (prepare (getForm (fromMaybe (error "Lemma.featureSpec.check: Nothing") - (focus z)))) +theCheck z (ES s) = + let wf = prepare + . getForm + . fromMaybe (error "Lemma.featureSpec.check: Nothing") + . focus + $ z + in E.check s wf && not (null (E.apply s wf)) + theLabel (Str form:Str pos:Str lemma:_) = make form lemma theLabel (Str _ :Str pos:ES s:_) = ES s theLabel other = error $ "Lemma.theLabel: match failed with " ++ show other @@ -28,12 +34,16 @@ where focusFeatures (Just (Str form:Str label:_)) = [ Sym $ low form, Sym $ label , Sym $ spellingSpec form , lexmap (low form) + , cluster form ] ++ prefixes maxPrefix (low form) ++ suffixes maxSuffix (low form) focusFeatures other = error $ "Lemma.theFeatures: " ++ show other low = lowercase lexmap w = Set $ map (show . make w . fst) $ Map.findWithDefault [] w (dictLex global) + cluster w = case Map.lookup w (clusterDict global) of + Nothing -> Null + Just c -> Sym c decode str = case reads str of [(s,"")] -> s diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -5,12 +5,16 @@ import qualified Lemma as L import GramLab.Morfette.Models import GramLab.Morfette.Utils (morfette) +import Debug.Trace main = morfette (prep,format) [P.featureSpec,L.featureSpec] -format = unlines . map (\ [Str f,Str p,ES s] -> - unwords [f,L.apply s . lowercase $ f,p]) - +format = unlines + . map (\ ([Str f,Str p, ES s]:ts) -> + unwords $ [f, L.apply s . lowercase $ f, p ] + ++ [ unwords [L.apply s . lowercase $ f , p ] + | [Str f, Str p , ES s ] <- ts ] + ) prep (f,Just l, Just p) = [Str f,Str p, L.make f l] diff --git a/src/POS.hs b/src/POS.hs --- a/src/POS.hs +++ b/src/POS.hs @@ -30,12 +30,17 @@ leftFeatures Nothing = [Null , Null , Null] focusFeatures (Just (Str form:_)) = [ Sym $ low form , Sym $ spellingSpec form - , lexmap (low form) ] + , lexmap (low form) + , cluster form + ] ++ prefixes maxPrefix (low form) ++ suffixes maxSuffix (low form) rightFeatures (Just (Str form:_)) = [Sym (low form),lexmap (low form)] rightFeatures Nothing = [Null, Null] low = lowercase lexmap w = Set $ map snd $ Map.findWithDefault [] w (dictLex global) + cluster w = case Map.lookup w (clusterDict global) of + Nothing -> Null + Just c -> Sym c getpos Nothing = "" getpos (Just (Str form:Str label:_)) = head (splitPOS (lang global) label) diff --git a/src/ghc_rts_opts.c b/src/ghc_rts_opts.c new file mode 100644 --- /dev/null +++ b/src/ghc_rts_opts.c @@ -0,0 +1,1 @@ +char *ghc_rts_opts = "-K100m -H500m";