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

Move the p,q-gram decorator to the RWS module.

Browse Source
This commit is contained in:
Rob Rix 2016-08-02 15:08:21 -04:00
parent 3d3874ee14
commit f546b21ea2
2 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Data/RandomWalkSimilarity.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
module Data.RandomWalkSimilarity
( rws
, pqGrams
@ -15,6 +15,7 @@ import Data.Functor.Foldable as Foldable
import Data.Hashable
import qualified Data.KdTree.Static as KdTree
import qualified Data.List as List
import Data.Record
import qualified Data.Vector as Vector
import Patch
import Prologue
@ -80,6 +81,17 @@ pqGrams getLabel p q = uncurry DList.cons . cata merge . setRootBase . setRootSt
setRootBase term = let (a :< f) = runCofree term in cofree (setBase a (base a) :< f)
setRootStem = foldr (\ p rest -> assignParent Nothing p . rest) identity [0..p]
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
windowed n f seed = para alg

9
src/Diffing.hs
View File

@ -4,10 +4,8 @@ module Diffing where
import qualified Prologue
import Prologue hiding (fst, snd)
import qualified Data.ByteString.Char8 as B1
import qualified Data.DList as DList
import Data.Functor.Both
import Data.Functor.Foldable
import Data.RandomWalkSimilarity
import Data.Record
import qualified Data.Text.IO as TextIO
import qualified Data.Text.ICU.Detect as Detect
@ -128,13 +126,6 @@ compareCategoryEq = (==) `on` category . extract
termCostDecorator :: (Prologue.Foldable f, Functor f) => TermDecorator f a Cost
termCostDecorator c = 1 + sum (cost <$> tailF c)
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
-- | The sum of the node count of the diff’s patches.
diffCostWithCachedTermCosts :: HasField fields Cost => Diff leaf (Record fields) -> Integer