wordsetdiff 0.0.1 → 0.0.2
raw patch · 2 files changed
+138/−47 lines, 2 filesdep +hashmap
Dependencies added: hashmap
Files
- Text/WordSetDiff/Main.hs +129/−44
- wordsetdiff.cabal +9/−3
Text/WordSetDiff/Main.hs view
@@ -1,4 +1,4 @@-#!/usr/bin/env runhaskell+{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------------------s {-| @@ -14,6 +14,9 @@ Run `wordsetdiff` with no arguments to print the help information. -}++-- TODO: can make the map of sets more efficient by defining a non-empty set type.+ ------------------------------------------------------------------------------------------s module Main where@@ -37,12 +40,64 @@ import Data.Char import Data.Function import Data.Word as W-import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.List as List-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8 as B +--import qualified Data.ByteString.Lazy as L+--import Data.ByteString.Lazy.Char8 as B+import Data.ByteString as B+import Data.ByteString.Lazy.Char8 as BC++import Data.ByteString.Internal (w2c,c2w)++-- define TRIEVERSION+#define HASHVERSION++#ifdef TRIEVERSION+import qualified Data.Trie as M+import Data.Trie.Convenience as M+type TupMap a = M.Trie a+-- This may not be very efficient:+difference a b = M.mergeBy (\ a b -> Nothing) (M.unionL a b) a +-- INEFFICIENT AND SERIAL:+intersection left right = +-- trace ("LEFT "++show left++ "\n\n RIGHT "++ show right++ "\n\nINTERSECT " ++ show x ++"\n")$ + x+ where + x = M.fromList$+ List.filter (\ (k,_) -> k `M.member` right) $ + M.toList left+pack_window ls = B.concat$ List.intersperse (B.singleton$ c2w ' ') ls+-- A window of words is just represented as a single bytestring+-- separated by single spaces.+type Window = B.ByteString+#else+#ifdef HASHVERSION+#warning "Using HashMap instead of Data.Map"+import qualified Data.HashMap as M+type TupMap a = M.HashMap [B.ByteString] a+#else+import qualified Data.Map as M+type TupMap a = M.Map [B.ByteString] a+#endif+intersection = M.intersection+difference = M.difference+pack_window = id+-- A window of words is represented as a list+type Window = [B.ByteString]+#endif++pack_window :: [B.ByteString] -> Window+toStrict :: BC.ByteString -> B.ByteString+toStrict lazy = + case BC.toChunks lazy of + [] -> B.empty+ [a] -> a+ ls -> B.concat ls++--------------------------------------------------------------------------------+-- CONFIGURATION VARIABLES:+ -- How many consecutive words should we look at? default_word_sequence_size = 3 clump_distance = 10@@ -94,16 +149,20 @@ right (Loc _ r) = r -- | Returns words satisfying whose characters satisfy a predicate along with their ZERO BASED locations.-words_wloc :: (Char -> Bool) -> ByteString -> [(ByteString, Loc)]+words_wloc :: (Char -> Bool) -> BC.ByteString -> [(B.ByteString, Loc)] words_wloc isWordChar bs = -- Convert each point location into a start/end Loc structure:- List.map (\ (word,pos) -> (word,Loc pos (pos + B.length word))) filtered + List.map withLoc filtered where - filtered = List.filter (not . null . fst) withpos- split = splitWith (not . isWordChar) bs- withpos = List.scanl (\ (last,pos) chunk -> (chunk, pos + B.length last + 1)) (empty,-1) split + withLoc :: (B.ByteString,Int64) -> (B.ByteString,Loc)+ withLoc (word,pos) = (word, Loc pos (pos + (fromIntegral$ B.length word))) + filtered = List.filter (not . B.null . fst) withpos+ withpos = List.scanl scanner (B.empty,-1) split + scanner (last,pos) chunk = (toStrict chunk, pos + (fromIntegral$ B.length last) + 1)+ split = BC.splitWith (not . isWordChar) bs + -- | Cluster regions together if they are "almost touching". -- Any regions within clump_distance characters of one another are joined. -- The result should have no overlaps:@@ -120,32 +179,38 @@ combine_locs [a] = a combine_locs ls = Loc (left$ List.head ls) (right$ List.last ls) --- | Form a map mapping words to a set of occurrence locations within the bytestring.-wordmap :: (Char -> Bool) -> ByteString -> Map.Map ByteString (Set.Set Loc)-wordmap isWordChar new = - Map.fromListWith Set.union $- List.map (\ (a,b) -> (a, Set.singleton b)) $ - words_wloc isWordChar $ new --- | Like wordmap, but this version forms a map using consecutive sequences of+-- | Form a map mapping words to a set of occurrence locations within the bytestring.+-- | This version forms a map using consecutive sequences of -- | N words (represented as lists) as the keys instead of individual words.-wordmapN :: (Char -> Bool) -> Int -> ByteString -> Map.Map [ByteString] (Set.Set Loc)+wordmapN :: (Char -> Bool) -> Int -> BC.ByteString -> TupMap (Set.Set Loc) wordmapN isWordChar n bs = - Map.fromListWith Set.union $- List.map (\ ls -> (List.map fst ls, Set.singleton (combine_locs (List.map snd ls)))) $ - sliding_win n $ - words_wloc isWordChar $ bs+ M.fromListWith Set.union $ + combined where loc_list ls = Loc (List.head ls) (List.last ls)++ -- TODO, could try not to use lists here and manually fuse all this stuff:+ combined :: [(Window, Set.Set Loc)]+ combined = List.map (combine_entries) $ + sliding_win n $ + words_wloc isWordChar $ bs++ combine_entries :: [(B.ByteString, Loc)] -> (Window, Set.Set Loc)+ combine_entries ls = (pack_window (List.map fst ls), Set.singleton (combine_locs (List.map snd ls))) -- Perhaps not the most efficient...- sliding_win n ls = List.take (List.length ls - n + 1) $- List.map (List.take n) $- List.tails ls +--sliding_win :: Int -> [ByteString] -> [Window]+sliding_win :: Int -> [(B.ByteString,Loc)] -> [[(B.ByteString,Loc)]]+--sliding_win :: Int -> [a] -> [[a]]+sliding_win n ls = List.take (List.length ls - n + 1) $+ List.map (List.take n) $+ List.tails ls + -- | The region of interest will end up bloated with separator -- charactors around the edges. This will trim those down.-trim_separators :: (Char -> Bool) -> ByteString -> [Loc] -> [Loc]+trim_separators :: (Char -> Bool) -> BC.ByteString -> [Loc] -> [Loc] trim_separators isWordChar bs [] = [] trim_separators isWordChar bs diffs@(Loc start end : _) = -- Note: passing isWordChar as a function is probably less efficient than passing a boolean flag.@@ -158,22 +223,22 @@ loop offset bs origd@(Loc start end : diffs) -- Need to scroll the tape.- | offset < start = loop start (B.drop (start - offset) bs) origd+ | offset < start = loop start (BC.drop (start - offset) bs) origd - | isWordChar (B.head bs) = + | isWordChar (BC.head bs) = -- Scroll past to the next (non-overlapping) segment:- let tail = loop end (B.drop (end-offset) bs) diffs in + let tail = loop end (BC.drop (end-offset) bs) diffs in case trim_tail offset bs end of Nothing -> tail Just trimmed -> Loc start trimmed : tail -- Otherwise scroll forward one character:- | otherwise = loop (offset+1) (B.tail bs) (Loc (start+1) end : diffs)+ | otherwise = loop (offset+1) (BC.tail bs) (Loc (start+1) end : diffs) -- Trim from the other end. trim_tail offset bs end | end == offset = Nothing -- The whole section is nixed is trimmed- | isWordChar (B.index bs (end - offset - 1)) = Just end+ | isWordChar (BC.index bs (end - offset - 1)) = Just end | otherwise = trim_tail offset bs (end - 1) --baseline = [SetColor Background Dull Black]@@ -184,16 +249,16 @@ setSGR [] -- | Print out results, i.e. the distinct regions of text within one file and not the other.-print_diff_regions :: Bool -> ByteString -> [Loc] -> IO ()+print_diff_regions :: Bool -> BC.ByteString -> [Loc] -> IO () print_diff_regions color bs ls = - loop 0 0 (B.lines bs) ls+ loop 0 0 (BC.lines bs) ls where loop lnum pos lines [] = return () loop lnum pos [] diff = error$ "difference regions beyond end of file: " ++ show diff loop lnum pos (ln:lines) origd@(Loc start end : diffs) -- NOTE: This adds ONE character for the newline, won't work with carriage-return/newline:- | pos + B.length ln < start = - loop (lnum+1) (pos + B.length ln + 1) lines origd+ | pos + BC.length ln < start = + loop (lnum+1) (pos + BC.length ln + 1) lines origd | otherwise = do -- Make all these locations one-based? For now I make just the lines one-based. --withCol Dull Red $ Prelude.putStr$ "\n==== line "++ show (lnum+1) ++": " @@ -201,12 +266,12 @@ Prelude.putStr$ "Found distinct material, "++ show (end-start) ++" characters (chars "++ show start ++ " to " ++ show end ++ ") " -- starting on withCol color Dull Red $ Prelude.putStrLn$ "line "++ show (lnum+1) ++"\n" - let snip = B.take (end-start) $ B.drop (start-pos) $ B.unlines (ln:lines)- header = B.take (start-pos) $ B.repeat ' '+ let snip = BC.take (end-start) $ BC.drop (start-pos) $ BC.unlines (ln:lines)+ header = BC.take (start-pos) $ BC.repeat ' ' withCol color Dull Green $ do- B.putStr header -- Not sure if this helps readability- B.putStrLn snip+ BC.putStr header -- Not sure if this helps readability+ BC.putStrLn snip loop lnum pos (ln:lines) diffs -- Finished printing that diff, move to next data Config = @@ -251,13 +316,13 @@ AlphaOnly -> cfg { with_punctuation = False } CaseInsensitive -> cfg { case_insensitive = True } - _bs_left <- B.readFile left - _bs_rights <- mapM B.readFile rights+ _bs_left <- BC.readFile left + _bs_rights <- mapM BC.readFile rights let -- This is a sloppy way to implement case insesitivity. Do it at the outset: isWordChar = if with_punctuation cfg then not . isSpace else isAlpha- lower = if case_insensitive cfg then B.map toLower else id+ lower = if case_insensitive cfg then BC.map toLower else id bs_left = lower _bs_left bs_rights = List.map lower _bs_rights snips_left = wordmapN isWordChar (word_sequence_size cfg) bs_left @@ -265,8 +330,8 @@ sub_one_file (remain,common) bs_right = let snips_right = wordmapN isWordChar (word_sequence_size cfg) bs_right- remain' = Map.difference remain snips_right- common' = Map.intersection common snips_right+ remain' = difference remain snips_right+ common' = intersection common snips_right in (remain',common') -- We go through each of the files to carve its contents out@@ -274,7 +339,7 @@ (remain,common) = List.foldl sub_one_file (snips_left, snips_left) bs_rights sorted_locs map = List.sort $ List.concat $ - List.map Set.toList $ Map.elems $ map+ List.map Set.toList $ M.elems $ map diff_area = clump_regions $ sorted_locs remain common_area = clump_regions $ sorted_locs common @@ -328,5 +393,25 @@ Comparing against some stray versions of my large amorphous computing notes file it does indeed prove useful. +[2010.10.17] I subtracted a 16.5 meg file from a 566K file... this+took about 54 seconds and went over 1.3 gb usage just eyeballing+activity monitor. (Though RTS -s claims only 641mb max memory.) 55.55% productivity.+5.1 gb alloc... so I guess I can't really just turn it off.++(There were NO remaining differences. Nice.)+++[2010.10.18] {Tried a Trie implementation}+.+It's not working yet... it gets slightly wrong answers.+I tried to time it anyway for fun on that .56/16.5 mb file combo.+Hmm.. running my VM so I don't have enough memory... going to turn that off.+Well... in any case it seems to be taking a very very long time (5min have passed).++Let's try a smaller file.+What about just subtracting a 566K file from itself? 6.5 seconds with+initial Trie implementation vs. 3.0 seconds for the data.map one.++What about a hashmap? That speeds it up to 2.1 seconds. -}
wordsetdiff.cabal view
@@ -1,14 +1,18 @@ +-- CHANGELOG:+-- version 0.0.1: initial release+-- version 0.0.2: switched to HashMap Name: wordsetdiff-Version: 0.0.1+Version: 0.0.2 License: BSD3 License-file: LICENSE Stability: Beta Author: Ryan Newton <rrnewton@gmail.com> Maintainer: Ryan Newton <rrnewton@gmail.com> --- homepage: +homepage: http://people.csail.mit.edu/newton/wordsetdiff+ -- Copyright: Copyright (c) 2009-2010 Ryan Newton Synopsis: Compare two files as sets of words or sets of N-tuples of words. @@ -35,5 +39,7 @@ Main-is: Text/WordSetDiff/Main.hs Build-Depends: base >= 3 && < 5, directory, process, filepath, ansi-terminal, bytestring >= 0.9.1, containers >= 0.3+ , hashmap+-- , bytestring-trie, binary, GHC-Options: -O2 -+-- -threaded