diff --git a/NLP/Scoring/SimpleUnigram.hs b/NLP/Scoring/SimpleUnigram.hs --- a/NLP/Scoring/SimpleUnigram.hs +++ b/NLP/Scoring/SimpleUnigram.hs @@ -26,12 +26,14 @@ -- TODO binary and cereal instances data SimpleScoring = SimpleScoring - { simpleScore :: !(HashMap (BTI,BTI) Double) - , gapScore :: !Double - , gapOpen :: !Double - , gapExtend :: !Double - , defMatch :: !Double - , defMismatch :: !Double + { simpleScore :: !(HashMap (BTI,BTI) Double) + , gapScore :: !Double + , gapOpen :: !Double + , gapExt :: !Double + , defMatch :: !Double + , defMismatch :: !Double + , preSufOpen :: !Double + , preSufExt :: !Double } deriving (Read,Show,Eq,Generic) @@ -40,17 +42,21 @@ (fromList `fmap` (v .: "simpleScore")) <*> v .: "gapScore" <*> v .: "gapOpen" <*> - v .: "gapExtend" <*> + v .: "gapExt" <*> v .: "defMatch" <*> - v .: "defMismatch" + v .: "defMismatch" <*> + v .: "preSufOpen" <*> + v .: "preSufExt" instance ToJSON SimpleScoring where - toJSON (SimpleScoring ss gs go ge dm di) - = object [ "simpleScore" .= toList ss - , "gapScore" .= gs - , "gapOpen" .= go - , "gapExtend" .= ge - , "defMatch" .= dm - , "defMismatch" .= di + toJSON SimpleScoring {..} + = object [ "simpleScore" .= toList simpleScore + , "gapScore" .= gapScore + , "gapOpen" .= gapOpen + , "gapExt" .= gapExt + , "defMatch" .= defMatch + , "defMismatch" .= defMismatch + , "preSufOpen" .= preSufOpen + , "preSufExt" .= preSufExt ] diff --git a/NLP/Scoring/SimpleUnigram/Import.hs b/NLP/Scoring/SimpleUnigram/Import.hs --- a/NLP/Scoring/SimpleUnigram/Import.hs +++ b/NLP/Scoring/SimpleUnigram/Import.hs @@ -3,11 +3,11 @@ import Control.Applicative import Data.HashMap.Strict (fromList) -import Data.Stringable import Data.Text (Text) import qualified Data.Attoparsec.Text as AT import qualified Data.Text as T import qualified Data.Text.IO as T +import Data.Attoparsec.Text (()) import NLP.Text.BTI @@ -31,6 +31,8 @@ | PLgapextend Double | PLdefmatch Double | PLdefmismatch Double + | PLpresufOpen Double + | PLpresufExt Double | PLcomment Text deriving (Show,Eq,Ord) @@ -40,18 +42,20 @@ parseLine l = case AT.parseOnly (go <* AT.endOfInput) l of Left err -> error $ err ++ " " ++ show l Right p -> p - where go = PLset <$ "Set" <*> wd <*> mc `AT.sepBy1` AT.skipSpace -- AB.skipWhile AB.isHorizontalSpace - <|> PLeq <$ "Eq" <*> wd <*> nm - <|> PLinset <$ "InSet" <*> wd <*> wd <*> nm - <|> PLgap <$ "Gap" <*> nm - <|> PLgapopen <$ "GapOpen" <*> nm - <|> PLgapextend <$ "GapExtend" <*> nm - <|> PLdefmatch <$ "Match" <*> nm - <|> PLdefmismatch <$ "Mismatch" <*> nm - <|> PLeqset <$ "EqSet" <*> wd <*> mc `AT.sepBy1` AT.skipSpace - <|> PLcomment <$ "--" <*> AT.takeText + where go = PLset <$ "Set" <*> wd <*> mc `AT.sepBy1` AT.skipSpace -- AB.skipWhile AB.isHorizontalSpace + <|> PLeq <$ "Eq" <*> wd <*> nm + <|> PLinset <$ "InSet" <*> wd <*> wd <*> nm + <|> (PLgap <$ "Gap" <*> nm "(linear) Gap") + <|> (PLgapopen <$ "GapOpen" <*> nm "GapOpen") + <|> (PLgapextend <$ "GapExtend" <*> nm "GapExtend") + <|> (PLdefmatch <$ "Match" <*> nm "Match") + <|> (PLdefmismatch <$ "Mismatch" <*> nm "Mismatch") + <|> (PLpresufOpen <$ "PreSufOpen" <*> nm "PreSufOpen") + <|> (PLpresufExt <$ "PreSufExtend" <*> nm "PreSufExtend") + <|> PLeqset <$ "EqSet" <*> wd <*> mc `AT.sepBy1` AT.skipSpace + <|> PLcomment <$ "--" <*> AT.takeText wd = AT.skipSpace *> AT.takeWhile1 (not . AT.isHorizontalSpace) - mc = fromText <$> wd + mc = bti <$> wd nm = AT.skipSpace *> AT.double -- | Parses a bytestring to create a simple scoring. We don't do much error @@ -60,9 +64,16 @@ -- TODO obviously: implement error-checking genSimpleScoring :: Text -> SimpleScoring -genSimpleScoring l = SimpleScoring t g go ge dm di +genSimpleScoring l = SimpleScoring{..} -- SimpleScoring t g go ge dm di where - t = fromList ys + simpleScore = fromList ys + [defMatch] = [dm | PLdefmatch dm <- xs] + [defMismatch] = [di | PLdefmismatch di <- xs] + [gapScore] = [g | PLgap g <- xs] + [gapOpen] = [go | PLgapopen go <- xs] + [gapExt] = [ge | PLgapextend ge <- xs] + [preSufOpen] = [ps | PLpresufOpen ps <- xs] + [preSufExt] = [ps | PLpresufExt ps <- xs] ls = T.lines l xs = map parseLine ls ys = concatMap genPairs $ iss ++ eqs @@ -70,11 +81,6 @@ eqss = [e | e@(PLeqset _ _) <- xs] eqs = [e | e@(PLeq _ _) <- xs] iss = [i | i@(PLinset _ _ _) <- xs] - [dm] = [dm | PLdefmatch dm <- xs] - [di] = [di | PLdefmismatch di <- xs] - [g] = [g | PLgap g <- xs] - [go] = [go | PLgapopen go <- xs] - [ge] = [ge | PLgapextend ge <- xs] -- this generates all "equality pairs", i.e. that 'a' == 'a' -- the second list generates all equivalence classes, say that 'a' == 'ã' genPairs (PLeq x d) = let ss = lookupSet x diff --git a/NaturalLanguageAlphabets.cabal b/NaturalLanguageAlphabets.cabal --- a/NaturalLanguageAlphabets.cabal +++ b/NaturalLanguageAlphabets.cabal @@ -1,17 +1,17 @@ name: NaturalLanguageAlphabets -version: 0.1.0.0 +version: 0.1.1.0 author: Christian Hoener zu Siederdissen maintainer: choener@bioinf.uni-leipzig.de homepage: https://github.com/choener/NaturalLanguageAlphabets bug-reports: https://github.com/choener/NaturalLanguageAlphabets/issues -copyright: Christian Hoener zu Siederdissen, 2014-2015 +copyright: Christian Hoener zu Siederdissen, 2014-2017 category: Natural Language Processing license: BSD3 license-file: LICENSE build-type: Simple stability: experimental cabal-version: >= 1.10.0 -tested-with: GHC == 7.8.4, GHC == 7.10.2 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 synopsis: Simple scoring schemes for word alignments description: Provides a simple scoring scheme for word alignments. @@ -26,28 +26,14 @@ library - build-depends: base > 4.7 && < 4.9 - , aeson >= 0.8 && < 0.11 - , array >= 0.5 && < 0.6 - , attoparsec >= 0.10 && < 0.14 - , bimaps >= 0.0.0.4 && < 0.0.1 - , binary >= 0.7 && < 0.8 - , bytestring >= 0.10.4 - , cereal >= 0.4 && < 0.5 - , cereal-text >= 0.1 && < 0.2 - , deepseq >= 1.3 && < 1.5 - , file-embed >= 0.0.6 && < 0.0.10 - , hashable >= 1.2 && < 1.3 - , intern >= 0.9 && < 0.10 - , LinguisticsTypes >= 0.0.0 && < 0.0.1 - , QuickCheck >= 2.7 && < 2.9 - , stringable >= 0.1.2 && < 0.2 - , system-filepath >= 0.4.9 && < 0.5 - , text >= 0.11 && < 1.3 - , text-binary >= 0.1 && < 0.3 - , unordered-containers >= 0.2.3 && < 0.3 - , vector >= 0.10 && < 0.12 - , vector-th-unbox >= 0.2 && < 0.3 + build-depends: base > 4.7 && < 5.0 + , aeson >= 0.8 + , attoparsec >= 0.10 + , file-embed >= 0.0.6 + , text >= 0.11 + , unordered-containers >= 0.2.3 + -- + , LinguisticsTypes == 0.0.0.* exposed-modules: NLP.Scoring.SimpleUnigram @@ -75,15 +61,16 @@ benchmark BenchmarkNLA build-depends: base , containers - , criterion >= 1.0.2 && < 1.1.1 + , criterion >= 1.0.2 , deepseq , hashtables - , LinguisticsTypes - , mwc-random >= 0.13 && < 0.14 - , NaturalLanguageAlphabets - , random >= 1.0 && < 1.2 + , mwc-random >= 0.13 + , random >= 1.0 , unordered-containers , vector + -- + , LinguisticsTypes + , NaturalLanguageAlphabets hs-source-dirs: tests main-is: @@ -120,15 +107,15 @@ , aeson , binary , cereal - , LinguisticsTypes - , NaturalLanguageAlphabets , QuickCheck - , stringable - , test-framework >= 0.8 && < 0.9 - , test-framework-quickcheck2 >= 0.3 && < 0.4 - , test-framework-th >= 0.2 && < 0.3 + , tasty >= 0.11 + , tasty-quickcheck >= 0.8 + , tasty-th >= 0.1 , text , unordered-containers + -- + , LinguisticsTypes + , NaturalLanguageAlphabets diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.1.1.0 +------- + +- prefix / suffix affine scoring added to scoring system + 0.1.0.0 ------- diff --git a/scoring/simpleunigram.score b/scoring/simpleunigram.score --- a/scoring/simpleunigram.score +++ b/scoring/simpleunigram.score @@ -35,6 +35,9 @@ -- Later on we want affine gap scoring, it's already here but not used GapOpen -4 GapExtend -4 +-- Some types of grammars have differently scored prefixes and suffixes +PreSufOpen -1 +PreSufExtend 0 -- This score is used when we align the same character but it's one we didn't -- specify in our sets Match 1 diff --git a/tests/properties.hs b/tests/properties.hs --- a/tests/properties.hs +++ b/tests/properties.hs @@ -2,14 +2,13 @@ module Main where import Control.Applicative -import Data.Stringable +import Data.HashMap.Strict (fromList,union) import Debug.Trace import qualified Data.Aeson as A import qualified Data.Binary as B import qualified Data.Serialize as S -import Test.Framework.Providers.QuickCheck2 -import Test.Framework.TH -import Data.HashMap.Strict (fromList,union) +import Test.Tasty.QuickCheck +import Test.Tasty.TH import NLP.Text.BTI @@ -26,17 +25,22 @@ -- for equality. prop_Aeson ( xs :: [((String,String),Double)] - , (gs :: Double, go :: Double, ge :: Double, dm :: Double, di :: Double) + , ( (gs :: Double, go :: Double, ge :: Double) + , (dm :: Double, di :: Double) + , (pso :: Double, pse :: Double) + ) ) = Just def' == A.decode (A.encode def') where def = clvDefaults - xs' = fromList $ map (\((x,y),s) -> ((fromString x,fromString y),s)) xs + xs' = fromList $ map (\((x,y),s) -> ((btiFromCS x,btiFromCS y),s)) xs def' = def { simpleScore = simpleScore def `union` xs' , gapScore = gs , gapOpen = go - , gapExtend = ge + , gapExt = ge , defMatch = dm , defMismatch = di + , preSufOpen = pso + , preSufExt = pse }