module NLP.Scoring.Unigram where
import Data.Aeson
import Data.Hashable
import Data.HashMap.Strict
import GHC.Generics
import Data.ByteString.Interned
matchUnigram ∷ UnigramScoring k l → IBS k → IBS l → Double
matchUnigram UnigramScoring{..} x y =
lookupDefault (if getIBS x == getIBS y then usDefaultMatch else usDefaultMismatch) (x,y) usUnigramMatch
{-# Inline matchUnigram #-}
insertUnigramFstK ∷ UnigramScoring k l → IBS k → Double
insertUnigramFstK UnigramScoring{..} x =
lookupDefault usGapLinear x usUnigramInsertFstK
{-# Inline insertUnigramFstK #-}
insertUnigramSndL ∷ UnigramScoring k l → IBS l → Double
insertUnigramSndL UnigramScoring{..} x =
lookupDefault usGapLinear x usUnigramInsertSndL
{-# Inline insertUnigramSndL #-}
data UnigramScoring k l = UnigramScoring
{ usUnigramMatch ∷ !(HashMap (IBS k, IBS l) Double)
, usUnigramInsertFstK ∷ !(HashMap (IBS k) Double)
, usUnigramInsertSndL ∷ !(HashMap (IBS l) Double)
, usGapLinear ∷ !Double
, usGapOpen ∷ !Double
, usGapExtension ∷ !Double
, usDefaultMatch ∷ !Double
, usDefaultMismatch ∷ !Double
, usPrefixSuffixLinear ∷ !Double
, usPrefixSuffixOpen ∷ !Double
, usPrefixSuffixExtension ∷ !Double
}
deriving (Read,Show,Eq,Generic)
instance Hashable (UnigramScoring k l)
instance FromJSON (UnigramScoring k l) where
parseJSON (Object v)
= UnigramScoring
<$> (fromList `fmap` (v .: "unigramMatch"))
<*> (fromList `fmap` (v .: "unigramInsertFstK"))
<*> (fromList `fmap` (v .: "unigramInsertSndL"))
<*> v .: "gapLinear"
<*> v .: "gapOpen"
<*> v .: "gapExtension"
<*> v .: "defaultMatch"
<*> v .: "defaultMismatch"
<*> v .: "prefixSuffixLinear"
<*> v .: "prefixSuffixOpen"
<*> v .: "prefixSuffixExtension"
instance ToJSON (UnigramScoring k l) where
toJSON UnigramScoring {..}
= object [ "unigramMatch" .= toList usUnigramMatch
, "unigramInsertFstK" .= toList usUnigramInsertFstK
, "unigramInsertSndL" .= toList usUnigramInsertSndL
, "gapLinear" .= usGapLinear
, "gapOpen" .= usGapOpen
, "gapExtension" .= usGapExtension
, "defaultMatch" .= usDefaultMatch
, "defaultMismatch" .= usDefaultMismatch
, "prefixSuffixLinear" .= usPrefixSuffixLinear
, "prefixSuffixOpen" .= usPrefixSuffixOpen
, "prefixSuffixExtension" .= usPrefixSuffixExtension
]