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

Loosen the Eq constraint in RWS to an Eq1 constraint.

Browse Source
This commit is contained in:
Rob Rix 2017-02-23 11:03:25 -05:00
parent 361710dd65
commit 6dcfff4716
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/RandomWalkSimilarity.hs
View File

@ -21,6 +21,8 @@ import Control.Monad.Random
import Control.Monad.State import Control.Monad.State
import Data.Align.Generic import Data.Align.Generic
import Data.Array import Data.Array
import Data.Functor.Classes
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Listable import Data.Functor.Listable
import Data.Hashable import Data.Hashable
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
@ -46,7 +48,7 @@ type DiffTerms f fields = Term f (Record fields) -> Term f (Record fields) -> Ma
-- --
-- This implementation is based on the paper [_RWS-Diff—Flexible and Efficient Change Detection in Hierarchical Data_](https://github.com/github/semantic-diff/files/325837/RWS-Diff.Flexible.and.Efficient.Change.Detection.in.Hierarchical.Data.pdf). -- This implementation is based on the paper [_RWS-Diff—Flexible and Efficient Change Detection in Hierarchical Data_](https://github.com/github/semantic-diff/files/325837/RWS-Diff.Flexible.and.Efficient.Change.Detection.in.Hierarchical.Data.pdf).
rws :: forall f fields. rws :: forall f fields.
(GAlign f, Traversable f, Eq (f (Term f Category)), HasField fields Category, HasField fields (Maybe FeatureVector)) (GAlign f, Traversable f, Eq1 f, HasField fields Category, HasField fields (Maybe FeatureVector))
=> DiffTerms f fields -- ^ A function which compares a pair of terms recursively, returning 'Just' their diffed value if appropriate, or 'Nothing' if they should not be compared. => DiffTerms f fields -- ^ A function which compares a pair of terms recursively, returning 'Just' their diffed value if appropriate, or 'Nothing' if they should not be compared.
-> [Term f (Record fields)] -- ^ The list of old terms. -> [Term f (Record fields)] -- ^ The list of old terms.
-> [Term f (Record fields)] -- ^ The list of new terms. -> [Term f (Record fields)] -- ^ The list of new terms.
@ -149,7 +151,7 @@ rws compare as bs
-- Possibly replace terms in a diff. -- Possibly replace terms in a diff.
replaceIfEqual :: Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields)) replaceIfEqual :: Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields))
replaceIfEqual a b replaceIfEqual a b
| (category <$> a) == (category <$> b) = hylo wrap runCofree <$> zipTerms (eraseFeatureVector a) (eraseFeatureVector b) | gliftEq (==) (category <$> a) (category <$> b) = hylo wrap runCofree <$> zipTerms (eraseFeatureVector a) (eraseFeatureVector b)
| otherwise = Nothing | otherwise = Nothing
cost = iter (const 0) . (1 <$) cost = iter (const 0) . (1 <$)

5
src/Interpreter.hs
View File

@ -3,8 +3,9 @@ module Interpreter (diffTerms) where
import Algorithm import Algorithm
import Data.Align.Generic import Data.Align.Generic
import Data.Functor.Foldable
import Data.Functor.Both import Data.Functor.Both
import Data.Functor.Classes
import Data.Functor.Foldable
import Data.RandomWalkSimilarity as RWS import Data.RandomWalkSimilarity as RWS
import Data.Record import Data.Record
import Data.These import Data.These
@ -86,7 +87,7 @@ algorithmWithTerms t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap
(Nothing, Nothing) -> Nothing (Nothing, Nothing) -> Nothing
-- | Run an algorithm, given functions characterizing the evaluation. -- | Run an algorithm, given functions characterizing the evaluation.
runAlgorithm :: (GAlign f, HasField fields Category, Eq (f (Cofree f Category)), Traversable f, HasField fields (Maybe FeatureVector)) runAlgorithm :: (Eq1 f, GAlign f, Traversable f, HasField fields Category, HasField fields (Maybe FeatureVector))
=> (Cofree f (Record fields) -> Cofree f (Record fields) -> Maybe (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields))))) -- ^ A function to diff two subterms recursively, if they are comparable, or else return 'Nothing'. => (Cofree f (Record fields) -> Cofree f (Record fields) -> Maybe (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields))))) -- ^ A function to diff two subterms recursively, if they are comparable, or else return 'Nothing'.
-> Algorithm (Cofree f (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) a -- ^ The algorithm to run. -> Algorithm (Cofree f (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) a -- ^ The algorithm to run.
-> a -> a