1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00

Roll the grams together in a single function.

This commit is contained in:
Rob Rix 2016-08-04 17:22:18 -04:00
parent d678f64ad1
commit 4b21c560c9

View File

@ -109,16 +109,13 @@ decorateTermWithPGram p = futu coalgebra . (,) []
coalgebra (parentLabels, c) = case extract c of
RCons label rest -> (Gram (take p (parentLabels <> repeat Nothing)) (pure (Just label)) .: rest) :< fmap (pure . (,) (take p (Just label : parentLabels))) (unwrap c)
decorateTermWithPQGram :: (Prologue.Foldable f, Functor f) => Int -> Cofree f (Record (Gram label ': fields)) -> Cofree f (Record ((Gram label, DList.DList (Gram label)) ': fields))
decorateTermWithPQGram q = cata algebra
decorateTermWithBagOfPQGrams :: (Typeable label, Prologue.Foldable f, Functor f) => Int -> Cofree f (Record (Gram label ': fields)) -> Cofree f (Record (DList.DList (Gram label) ': fields))
decorateTermWithBagOfPQGrams q = fmap (\ (RCons (first, rest) t) -> DList.cons first rest .: t) . cata algebra
where algebra :: (Prologue.Foldable f, Functor f) => CofreeF f (Record (Gram label ': fields)) (Cofree f (Record ((Gram label, DList.DList (Gram label)) ': fields))) -> Cofree f (Record ((Gram label, DList.DList (Gram label)) ': fields))
algebra (RCons gram rest :< functor) = cofree (((gram, DList.fromList (windowed q (\ gram siblings rest -> gram { base = take q (foldMap base siblings <> repeat Nothing) } : rest) [] (fst . getGrams . extract <$> toList functor)) <> foldMap (snd . getGrams . extract) functor) .: rest) :< functor)
getGrams :: HasField fields (Gram label, DList.DList (Gram label)) => Record fields -> (Gram label, DList.DList (Gram label))
getGrams = getField
decorateTermWithBagOfPQGrams :: (Typeable label, Functor f) => Cofree f (Record ((Gram label, DList.DList (Gram label)) ': fields)) -> Cofree f (Record (DList.DList (Gram label) ': fields))
decorateTermWithBagOfPQGrams = fmap (\ (RCons (first, rest) t) -> DList.cons first rest .: t)
decorateTermWithFeatureVector :: (Hashable label, Functor f) => Int -> Cofree f (Record (DList.DList (Gram label) ': fields)) -> Cofree f (Record (Vector.Vector Double ': fields))
decorateTermWithFeatureVector d = fmap $ \ (RCons grams rest) -> featureVector d grams .: rest