diff --git a/Diff.cabal b/Diff.cabal index 155ef8b..2866881 100644 --- a/Diff.cabal +++ b/Diff.cabal @@ -62,3 +62,14 @@ test-suite diff-tests , QuickCheck , test-framework , test-framework-quickcheck2 + +benchmark simple + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: bench/bench.hs + build-depends: + Diff + , base >= 3 && <= 6 + , criterion + , deepseq + , random diff --git a/bench/bench.hs b/bench/bench.hs index c691237..a24391e 100644 --- a/bench/bench.hs +++ b/bench/bench.hs @@ -1,13 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +-- {-# OPTIONS_GHC -Wno-orphans #-} + module Main where import Criterion.Main import Control.DeepSeq +import GHC.Generics import System.Random import Data.Algorithm.Diff -instance NFData (Diff a) where - +deriving instance Generic (Diff a) + +instance NFData a => NFData (Diff a) main :: IO () main = doBenchMarks 37 diff --git a/src/Data/Algorithm/Diff.hs b/src/Data/Algorithm/Diff.hs index 9288954..43328cb 100644 --- a/src/Data/Algorithm/Diff.hs +++ b/src/Data/Algorithm/Diff.hs @@ -189,35 +189,29 @@ canDiag eq as bs lena lenb = \ i j -> -- 'addsnake' is applied to each candidate immediately to extend it along any -- available sequence of matching elements. -- --- The resulting candidate list interleaves the 'F' and 'S' successors of each --- wave front node. The head ('F' successor of the first node) is kept as-is, and --- 'selectBestDLFromPairs' is applied to the tail — pairing each 'S' successor with the 'F' --- successor of the next wave front node. When this function is iterated from a --- single-node seed (as in 'ses'), each such pair always lies on the same --- diagonal: an 'F' edge advances to the next higher diagonal while an 'S' edge --- retreats to the next lower one, so the two members of each pair straddle the --- same diagonal from opposite sides. +-- The resulting candidates are merged pairwise: the vertical successor of each +-- node is paired with the horizontal successor of the next node in the wave +-- front. When this function is iterated from a single-node seed (as in 'ses'), +-- each such pair always lies on the same diagonal: an 'F' edge advances to the +-- next higher diagonal while an 'S' edge retreats to the next lower one, so the +-- two members of each pair straddle the same diagonal from opposite sides. +-- +-- Precondition: The node list must be non-empty. dstep :: (Int -> Int -> Bool) -- ^ Diagonal predicate - -> [DL] -- ^ Wave front of D-paths at edit distance D - -> [DL] -- ^ Wave front of D-paths at edit distance D+1 -dstep cd dls = hd:selectBestDLFromPairs rst - where (hd:rst) = nextDLs dls - -- Extend each node by one edit step in both possible directions - -- and then follow any available snake from the resulting position. - nextDLs [] = [] - nextDLs (dl:rest) = dl':dl'':nextDLs rest - where dl' = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)} - dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)} - pdl = path dl - -- Select the furthest-reaching candidate from adjacent pairs of nodes. - -- Note that candidate pairs are always on the same /k-diagonal/ by construction - -- at call site (in 'ses' where it iterates starting from a single node - -- wave front), meaning that each compared pair @x@ and @y@ are such that: - -- @(poi x - poj x) = (poi y - poj y)@ - selectBestDLFromPairs [] = [] - selectBestDLFromPairs [x] = [x] - selectBestDLFromPairs (x:y:rest) = furthestReaching x y:selectBestDLFromPairs rest + -> [DL] -- ^ A non-empty wave front of nodes at edit distance D + -> [DL] -- ^ A non-empty wave front of nodes at edit distance D+1 +dstep _ [] = error "dstep: Cannot perform expansion on an empty list of nodes" +dstep cd (dl:dls) = hStep dl : stepAndMerge dl dls + where + hStep node = addsnake cd $ node {poi = poi node + 1, path = F : path node} + vStep node = addsnake cd $ node {poj = poj node + 1, path = S : path node} + -- Merge vertical step of previous node with horizontal step of next node, + -- selecting the furthest-reaching candidate for each shared k-diagonal. + stepAndMerge :: DL -> [DL] -> [DL] + stepAndMerge prev [] = [vStep prev] + stepAndMerge prev (next:rest) = + furthestReaching (vStep prev) (hStep next) : stepAndMerge next rest -- | Follow a /snake/ from the current position of a 'DL' node. --