github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 04:51:57 +03:00
Code Issues Projects Releases Wiki Activity

Extract a function setting gram bases.

Browse Source
This commit is contained in:
Rob Rix 2016-08-09 13:11:10 -04:00
parent 4ad79e70d8
commit 45fce4dffd
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/RandomWalkSimilarity.hs
View File

@ -86,12 +86,14 @@ decorateTermWithPGram p = ana coalgebra . (,) []
decorateTermWithPQGram :: Traversable f => Int -> Int -> Cofree f (Record (label ': fields)) -> Cofree f (Record (Gram label ': fields))
decorateTermWithPQGram p q = cata algebra . decorateTermWithPGram p
where algebra :: Traversable f => CofreeF f (Record (Gram label ': fields)) (Cofree f (Record (Gram label ': fields))) -> Cofree f (Record (Gram label ': fields))
algebra (RCons gram rest :< functor) = cofree ((gram { base = padToSize q (base gram) } .: rest) :< (`evalState` (siblingLabels functor)) (for functor $ \ a -> case runCofree a of
algebra (RCons gram rest :< functor) = cofree ((setBase gram (base gram) .: rest) :< (`evalState` (siblingLabels functor)) (for functor $ \ a -> case runCofree a of
RCons gram rest :< functor -> do labels <- get
put (drop 1 labels)
pure $! cofree ((gram { base = padToSize q labels } .: rest) :< functor)))
pure $! cofree ((setBase gram labels .: rest) :< functor)))
siblingLabels :: Traversable f => f (Cofree f (Record (Gram label ': fields))) -> [Maybe label]
siblingLabels = foldMap (base . rhead . extract)
setBase :: Gram label -> [Maybe label] -> Gram label
setBase gram labels = gram { base = padToSize q labels }
-- | Replaces a p,q-gram at the head of a term’s annotation with corresponding feature vectors.
decorateTermWithFeatureVector :: (Hashable label, Prologue.Foldable f, Functor f) => Int -> Cofree f (Record (Gram label ': fields)) -> Cofree f (Record (Vector.Vector Double ': fields))