diff --git a/Data/List/CommonSubstring.hs b/Data/List/CommonSubstring.hs new file mode 100644 --- /dev/null +++ b/Data/List/CommonSubstring.hs @@ -0,0 +1,27 @@ +module Data.List.CommonSubstring where +import Data.SuffixTree +import Data.List +import Data.Ord + +-- | This is the suffixtree based implementation. +-- | If there are multiple longest substrings, which one is returned +-- | is undefined. + +longestSubstring ::(Eq a, Ord a) => [a] -> [a] -> [a] +longestSubstring first second = maximumBy (comparing length) + $ map (longestMatch $ construct second) + $ tails first + where longestMatch :: Eq a => STree a -> [a] -> [a] + longestMatch Leaf _ = [] + longestMatch (Node edges) candidate = + maximumBy (comparing length) $ map (prefixMatch candidate) edges + + prefixMatch :: Eq a => [a] -> Edge a -> [a] + prefixMatch candidate (p, tree) + | p' `isPrefixOf` candidate = p' ++ longestMatch tree (drop (length p') candidate) + | otherwise = commonSubstring p' candidate + where p' = prefix p + commonSubstring (a:as) (b:bs) + | a==b = a:commonSubstring as bs + | otherwise = [] + commonSubstring _ _ = [] diff --git a/Data/List/SlowSubstring.hs b/Data/List/SlowSubstring.hs new file mode 100644 --- /dev/null +++ b/Data/List/SlowSubstring.hs @@ -0,0 +1,13 @@ +module Data.List.SlowSubstring(longestSubstring,sharedPrefix) where +import Data.List(sortBy,tails) +import Data.Ord + +longestSubstring ::(Eq a, Ord a) => [a] -> [a] -> [a] +longestSubstring first second = head $ reverse $ sortBy (comparing length) comparisons + where comparisons = concatMap (\x -> map (sharedPrefix x) $ tails second) (tails first) + +sharedPrefix :: (Eq a, Ord a) => [a] -> [a] -> [a] +sharedPrefix (a:as) (b:bs) + | a==b = a:sharedPrefix as bs + | otherwise = [] +sharedPrefix _ _ = [] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Mark Wotton + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Mark Wotton nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs new file mode 100644 --- /dev/null +++ b/bench/BenchAll.hs @@ -0,0 +1,20 @@ +module Main where +import Criterion.Main + +import qualified Data.List.CommonSubstring as Suffix +import qualified Data.List.SlowSubstring as Slow + +first padlen = padding ++ "bbbbbbbb" ++ padding + where padding = concat $ replicate padlen "abcd" + +second padlen = padding ++ "bbbbbbb" ++ padding + where padding = concat (replicate padlen "efgh") + +main = defaultMain [ + bgroup "string-similarity" + [ bench "slow" $ whnf (Slow.longestSubstring $ first 100) (second 100), + bench "common" $ whnf (Suffix.longestSubstring $ first 100) (second 100), + bench "common" $ whnf (Suffix.longestSubstring $ first 1000) (second 1000), + bench "common" $ whnf (Suffix.longestSubstring $ first 10000) (second 10000) + ] + ] diff --git a/string-similarity.cabal b/string-similarity.cabal new file mode 100644 --- /dev/null +++ b/string-similarity.cabal @@ -0,0 +1,51 @@ +-- Initial string-similarity.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: string-similarity +version: 0.1.0.0 +synopsis: longest common substring +description: algorithms for finding the longest common substring in a set of documents +homepage: http://github.com/mwotton/string-similarity +license: BSD3 +license-file: LICENSE +author: Mark Wotton +maintainer: mwotton@gmail.com +category: Data +build-type: Simple +cabal-version: >=1.8 + +source-repository head + type: git + location: https://github.com/mwotton/string-similarity.git + + +library + exposed-modules: Data.List.CommonSubstring, + Data.List.SlowSubstring + -- other-modules: + ghc-options: -O2 + build-depends: base >= 4 && <= 5, + suffixtree + +test-suite tests + type: exitcode-stdio-1.0 + ghc-options: -Wall + hs-source-dirs: test/ + main-is: Spec.hs + build-depends: base >= 4 && <= 5 + , hspec + , QuickCheck + , bytestring + , string-similarity + +benchmark bench-lcs + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: BenchAll.hs + build-depends: base, + criterion, + string-similarity + ghc-options: -O2 + -fmax-simplifier-iterations=10 + -fdicts-cheap + -fspec-constr-count=6 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +-- file test/Spec.hs +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}