github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Reformat the algebra.

Browse Source
This commit is contained in:
Rob Rix 2016-08-09 16:10:56 -04:00
parent 50c52af354
commit 0facfdbb7f
1 changed files with 2 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Data/RandomWalkSimilarity.hs
View File

@ -74,7 +74,8 @@ featureVector d bag = sumVectors $ unitVector d . hash <$> bag
-- | Annotates a term with the corresponding p,q-gram at each node.
pqGramDecorator :: Traversable f => (forall b. CofreeF f (Record fields) b -> label) -> Int -> Int -> Cofree f (Record fields) -> Cofree f (Record (Gram label ': fields))
pqGramDecorator getLabel p q = cata algebra
where algebra (rest :< functor) = let label = getLabel (rest :< functor) in cofree ((Gram (padToSize p []) (padToSize q (pure (Just label))) .: rest) :< (`evalState` (siblingLabels functor)) (for functor (assignLabels label)))
where algebra term = let label = getLabel term in
cofree ((Gram (padToSize p []) (padToSize q (pure (Just label))) .: headF term) :< (`evalState` (siblingLabels (tailF term))) (for (tailF term) (assignLabels label)))
assignLabels :: label -> Cofree f (Record (Gram label ': fields)) -> State [Maybe label] (Cofree f (Record (Gram label ': fields)))
assignLabels label a = case runCofree a of
RCons gram rest :< functor -> do