diff --git a/Text/WordSetDiff/Main.hs b/Text/WordSetDiff/Main.hs --- a/Text/WordSetDiff/Main.hs +++ b/Text/WordSetDiff/Main.hs @@ -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. -} diff --git a/wordsetdiff.cabal b/wordsetdiff.cabal --- a/wordsetdiff.cabal +++ b/wordsetdiff.cabal @@ -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 Maintainer: Ryan Newton --- 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