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

🔥 pqGramDecorator.

Browse Source
This commit is contained in:
Rob Rix 2016-08-04 16:21:28 -04:00
parent 0a047d77cb
commit 8c31fd9794
1 changed files with 0 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Data/RandomWalkSimilarity.hs
View File

@ -84,14 +84,6 @@ pqGrams getLabel p q = uncurry DList.cons . cata merge . setRootBase . setRootSt
type TermDecorator f fields field = CofreeF f (Record fields) (Record (field ': fields)) -> field
pqGramDecorator :: (Prologue.Foldable f, Functor f) => (forall b. CofreeF f (Record a) b -> label) -> Int -> Int -> TermDecorator f a (Gram label, DList.DList (Gram label))
pqGramDecorator getLabel p q c@(a :< s) = (Gram [] [ Just label ], foldMap (childGrams label) s)
where childGrams :: HasField fields (Gram label, DList.DList (Gram label)) => label -> Record fields -> DList.DList (Gram label)
childGrams label record = let (child, grandchildren) = getField record in
DList.singleton (prependParent label child) <> grandchildren
prependParent label gram = gram { stem = Just label : stem gram }
label = getLabel c
-- | A sliding-window fold over _n_ items of a list per iteration.
windowed :: Int -> (a -> [a] -> b -> b) -> b -> [a] -> b