diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,12 @@ +# Changes in version 0.3 + * Remove `Patience.itemChar` and `Patience.itemValue`. + * Remove `M` and related functions. + +# Changes in version 0.2.1.1 + * Deprecate `Patience.itemChar` and `Patience.itemValue`. + * Add module `Patience.Map`. + +# Changes in version 0.2.0.0 + * Move `Data.Algorithm.Patience` to `Patience` + * Remove use of deprecated `Data.Map.insertWith'` + * Add strictness/UNPACK annotations to `Int` values diff --git a/Data/Algorithm/Patience.hs b/Data/Algorithm/Patience.hs deleted file mode 100644 --- a/Data/Algorithm/Patience.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE - DeriveDataTypeable - , ViewPatterns - , CPP #-} --- | Implements \"patience diff\" and the patience algorithm for the longest --- increasing subsequence problem. -module Data.Algorithm.Patience - ( -- * Patience diff - diff - , Item(..), itemChar, itemValue - -- * Longest increasing subsequence - , longestIncreasing - ) where -import qualified Data.Sequence as S -import Data.Sequence ( (<|), (|>), (><), ViewL(..), ViewR(..) ) -import qualified Data.Foldable as F -import qualified Data.Map as M -import qualified Data.IntMap as IM - -import Data.List -import Data.Ord - -import Data.Typeable ( Typeable ) -import Data.Data ( Data ) - --- If key xi is in the map, move it to xf while adjusting the value with f. -adjMove :: (a -> a) -> Int -> Int -> IM.IntMap a -> IM.IntMap a -adjMove f xi xf m = case IM.updateLookupWithKey (\_ _ -> Nothing) xi m of - (Just v, mm) -> IM.insert xf (f v) mm - (Nothing, _) -> m - --- A "card" is an integer value (with annotation) plus a "backpointer" to --- a card in the previous pile, if any. -data Card a = Card Int a (Maybe (Card a)) - --- | Given: a list of distinct integers. Picks a subset of the integers --- in the same order, i.e. a subsequence, with the property that --- --- * it is monotonically increasing, and --- --- * it is at least as long as any other such subsequence. --- --- This function uses patience sort: --- . --- For implementation reasons, the actual list returned is the reverse of --- the subsequence. --- --- You can pair each integer with an arbitrary annotation, which will be --- carried through the algorithm. -longestIncreasing :: [(Int,a)] -> [(Int,a)] -longestIncreasing = extract . foldl' ins IM.empty where - -- Insert a card into the proper pile. - -- type Pile a = [Card a] - -- type Piles a = IM.IntMap (Pile a) -- keyed by smallest element - ins m (x,a) = - let (lt, gt) = IM.split x m - prev = (head . fst) `fmap` IM.maxView lt - new = Card x a prev - in case IM.minViewWithKey gt of - Nothing -> IM.insert x [new] m -- new pile - Just ((k,_),_) -> adjMove (new:) k x m -- top of old pile - -- Walk the backpointers, starting at the top card of the - -- highest-keyed pile. - extract (IM.maxView -> Just (c,_)) = walk $ head c - extract _ = [] - walk (Card x a c) = (x,a) : maybe [] walk c - --- Elements whose second component appears exactly once. -unique :: (Ord t) => S.Seq (a,t) -> M.Map t a -unique = M.mapMaybe id . F.foldr ins M.empty where - ins (a,x) = M.insertWith' (\_ _ -> Nothing) x (Just a) - --- Given two sequences of numbered "lines", returns a list of points --- where unique lines match up. -solveLCS :: (Ord t) => S.Seq (Int,t) -> S.Seq (Int,t) -> [(Int,Int)] -solveLCS ma mb = - let xs = M.elems $ M.intersectionWith (,) (unique ma) (unique mb) - in longestIncreasing $ sortBy (comparing snd) xs - --- Type for decomposing a diff problem. We either have two --- lines that match, or a recursive subproblem. -data Piece a - = Match a a - | Diff (S.Seq a) (S.Seq a) - deriving (Show) - --- Subdivides a diff problem according to the indices of matching lines. -chop :: S.Seq t -> S.Seq t -> [(Int,Int)] -> [Piece t] -chop xs ys [] - | S.null xs && S.null ys = [] - | otherwise = [Diff xs ys] -chop xs ys ((nx,ny):ns) = - let (xsr, S.viewl -> (x :< xse)) = S.splitAt nx xs - (ysr, S.viewl -> (y :< yse)) = S.splitAt ny ys - in Diff xse yse : Match x y : chop xsr ysr ns - --- Zip a list with a Seq. -zipLS :: [a] -> S.Seq b -> S.Seq (a, b) -#if MIN_VERSION_containers(0,3,0) -zipLS = S.zip . S.fromList -#else -zipLS xs = S.fromList . zip xs . F.toList -#endif - --- Number the elements of a Seq. -number :: S.Seq t -> S.Seq (Int,t) -number xs = zipLS [0..S.length xs - 1] xs - --- | An element of a computed difference. -data Item t - = Old t -- ^ Value taken from the \"old\" list, i.e. left argument to 'diff' - | New t -- ^ Value taken from the \"new\" list, i.e. right argument to 'diff' - | Both t t -- ^ Value taken from both lists. Both values are provided, in case - -- your type has a non-structural definition of equality. - deriving (Eq, Ord, Show, Read, Typeable, Data) - -instance Functor Item where - fmap f (Old x ) = Old (f x) - fmap f (New x ) = New (f x) - fmap f (Both x y) = Both (f x) (f y) - --- | The difference between two lists, according to the --- \"patience diff\" algorithm. -diff :: (Ord t) => [t] -> [t] -> [Item t] -diff xsl ysl = F.toList $ go (S.fromList xsl) (S.fromList ysl) where - -- Handle common elements at the beginning / end. - go (S.viewl -> (x :< xs)) (S.viewl -> (y :< ys)) - | x == y = Both x y <| go xs ys - go (S.viewr -> (xs :> x)) (S.viewr -> (ys :> y)) - | x == y = go xs ys |> Both x y - -- Find an increasing sequence of matching unique lines, then - -- subdivide at those points and recurse. - go xs ys = case chop xs ys $ solveLCS (number xs) (number ys) of - -- If we fail to subdivide, just record the chunk as is. - [Diff _ _] -> fmap Old xs >< fmap New ys - ps -> recur ps - - -- Apply the algorithm recursively to a decomposed problem. - -- The decomposition list is in reversed order. - recur [] = S.empty - recur (Match x y : ps) = recur ps |> Both x y - recur (Diff xs ys : ps) = recur ps >< go xs ys - --- | The character @\'-\'@ or @\'+\'@ or @\' \'@ for 'Old' or 'New' or 'Both' respectively. -itemChar :: Item t -> Char -itemChar (Old _ ) = '-' -itemChar (New _ ) = '+' -itemChar (Both _ _) = ' ' - --- | The value from an 'Item'. For 'Both', returns the \"old\" value. -itemValue :: Item t -> t -itemValue (Old x ) = x -itemValue (New x ) = x -itemValue (Both x _) = x diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ Copyright (c) Keegan McAllister 2011 +Copyright (c) chessai 2018 All rights reserved. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +[![Hackage](https://img.shields.io/hackage/v/patience.svg)](https://hackage.haskell.org/package/patience) + +# patience + +## About +This library implements the "patience diff" algorithm, as well as the patience algorithm for the +longest increasing subsequence problem. + +Patience diff computes the difference between two lists, for example the lines of two versions of +a source file. It provides a good balance of performance, nice output for humans, and implementation +simplicity. For more information, see these two blog posts: [alfedenzo](http://alfedenzo.livejournal.com/170301.html), [bramcohen](http://bramcohen.livejournal.com/73318.html) + +## Install + +Install with `cabal (new-)install patience`. diff --git a/patience.cabal b/patience.cabal --- a/patience.cabal +++ b/patience.cabal @@ -1,13 +1,14 @@ -name: patience -version: 0.1.1 -license: BSD3 -license-file: LICENSE -synopsis: Patience diff and longest increasing subsequence -category: Algorithms, Text -author: Keegan McAllister -maintainer: Keegan McAllister -build-type: Simple -cabal-version: >=1.2 +cabal-version: 2.0 +name: + patience +version: + 0.3 +license: + BSD3 +license-file: + LICENSE +synopsis: + Patience diff and longest increasing subsequence description: This library implements the \"patience diff\" algorithm, as well as the patience algorithm for the longest increasing subsequence problem. @@ -17,16 +18,35 @@ performance, nice output for humans, and implementation simplicity. For more information, see and . - . - New in version 0.1.1: relaxed @containers@ dependency, so it should build on - GHC 6.10. - +category: + Algorithms, Text +author: + Keegan McAllister + chessai +maintainer: + chessai +homepage: + https://github.com/chessai/patience +build-type: + Simple extra-source-files: - test/test.hs + CHANGELOG.md + README.md library - exposed-modules: Data.Algorithm.Patience - ghc-options: -Wall + hs-source-dirs: + src + exposed-modules: + Patience + Patience.Map + ghc-options: + -Wall + default-language: + Haskell2010 build-depends: - base >= 3 && < 5 - , containers >= 0.2 + base >= 4.3 && < 5 + , containers >= 0.5.9 && < 0.7 + +source-repository head + type: git + location: https://github.com/chessai/patience.git diff --git a/src/Patience.hs b/src/Patience.hs new file mode 100644 --- /dev/null +++ b/src/Patience.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Implements \"patience diff\" and the patience algorithm for the longest +-- increasing subsequence problem. +module Patience + ( -- * Patience diff + diff + , Item(..) + -- * Longest increasing subsequence + , longestIncreasing + ) where + +import Data.Data (Data) +import qualified Data.Foldable as F +import qualified Data.IntMap as IM +import Data.List +import qualified Data.Map as M +import qualified Data.Map.Strict as MS +import Data.Ord +import Data.Sequence ( (<|), (|>), (><), ViewL(..), ViewR(..) ) +import qualified Data.Sequence as S +import Data.Typeable (Typeable) + +-- If key xi is in the map, move it to xf while adjusting the value with f. +adjMove :: (a -> a) -> Int -> Int -> IM.IntMap a -> IM.IntMap a +adjMove f !xi !xf m = case IM.updateLookupWithKey (\_ _ -> Nothing) xi m of + (Just v, mm) -> IM.insert xf (f v) mm + (Nothing, _) -> m + +-- A "card" is an integer value (with annotation) plus a "backpointer" to +-- a card in the previous pile, if any. +data Card a = Card {-# UNPACK #-} !Int a (Maybe (Card a)) + +-- | Given: a list of distinct integers. Picks a subset of the integers +-- in the same order, i.e. a subsequence, with the property that +-- +-- * it is monotonically increasing, and +-- +-- * it is at least as long as any other such subsequence. +-- +-- This function uses patience sort: +-- . +-- For implementation reasons, the actual list returned is the reverse of +-- the subsequence. +-- +-- You can pair each integer with an arbitrary annotation, which will be +-- carried through the algorithm. +longestIncreasing :: [(Int,a)] -> [(Int,a)] +longestIncreasing = extract . F.foldl' ins IM.empty where + -- Insert a card into the proper pile. + -- type Pile a = [Card a] + -- type Piles a = IM.IntMap (Pile a) -- keyed by smallest element + ins m (x,a) = + let (lt, gt) = IM.split x m + prev = (head . fst) `fmap` IM.maxView lt + new = Card x a prev + in case IM.minViewWithKey gt of + Nothing -> IM.insert x [new] m -- new pile + Just ((k,_),_) -> adjMove (new:) k x m -- top of old pile + -- Walk the backpointers, starting at the top card of the + -- highest-keyed pile. + extract (IM.maxView -> Just (c,_)) = walk $ head c + extract _ = [] + walk (Card x a c) = (x,a) : maybe [] walk c + +-- Elements whose second component appears exactly once. +unique :: (Ord k) => S.Seq (a,k) -> M.Map k a +unique = M.mapMaybe id . F.foldr ins M.empty where + ins (a,x) = MS.insertWith (\_ _ -> Nothing) x (Just a) + +-- Given two sequences of numbered "lines", returns a list of points +-- where unique lines match up. +solveLCS :: (Ord a) => S.Seq (Int,a) -> S.Seq (Int,a) -> [(Int,Int)] +solveLCS ma mb = + let xs = M.elems $ M.intersectionWith (,) (unique ma) (unique mb) + in longestIncreasing $ sortBy (comparing snd) xs + +-- Type for decomposing a diff problem. We either have two +-- lines that match, or a recursive subproblem. +data Piece a + = Match a a + | Diff (S.Seq a) (S.Seq a) + deriving (Show) + +-- Subdivides a diff problem according to the indices of matching lines. +chop :: S.Seq a -> S.Seq a -> [(Int,Int)] -> [Piece a] +chop xs ys [] + | S.null xs && S.null ys = [] + | otherwise = [Diff xs ys] +chop xs ys (!(!nx,!ny):ns) = + let (xsr, S.viewl -> (x :< xse)) = S.splitAt nx xs + (ysr, S.viewl -> (y :< yse)) = S.splitAt ny ys + in Diff xse yse : Match x y : chop xsr ysr ns + +-- Zip a list with a Seq. +zipLS :: [a] -> S.Seq b -> S.Seq (a, b) +zipLS = S.zip . S.fromList + +-- Number the elements of a Seq. +number :: S.Seq a -> S.Seq (Int,a) +number xs = zipLS [0..S.length xs - 1] xs + +-- | An element of a computed difference. +data Item a + = Old a -- ^ Value taken from the \"old\" list, i.e. left argument to 'diff' + | New a -- ^ Value taken from the \"new\" list, i.e. right argument to 'diff' + | Both a a -- ^ Value taken from both lists. Both values are provided, in case + -- your type has a non-structural definition of equality. + deriving (Eq, Ord, Show, Read, Typeable, Data, Functor) + +-- | The difference between two lists, according to the +-- \"patience diff\" algorithm. +diff :: (Ord a) => [a] -> [a] -> [Item a] +diff xsl ysl = F.toList $ go (S.fromList xsl) (S.fromList ysl) where + -- Handle common elements at the beginning / end. + go (S.viewl -> (x :< xs)) (S.viewl -> (y :< ys)) + | x == y = Both x y <| go xs ys + go (S.viewr -> (xs :> x)) (S.viewr -> (ys :> y)) + | x == y = go xs ys |> Both x y + -- Find an increasing sequence of matching unique lines, then + -- subdivide at those points and recurse. + go xs ys = case chop xs ys $ solveLCS (number xs) (number ys) of + -- If we fail to subdivide, just record the chunk as is. + [Diff _ _] -> fmap Old xs >< fmap New ys + ps -> recur ps + + -- Apply the algorithm recursively to a decomposed problem. + -- The decomposition list is in reversed order. + recur [] = S.empty + recur (Match x y : ps) = recur ps |> Both x y + recur (Diff xs ys : ps) = recur ps >< go xs ys diff --git a/src/Patience/Map.hs b/src/Patience/Map.hs new file mode 100644 --- /dev/null +++ b/src/Patience/Map.hs @@ -0,0 +1,254 @@ +{-# language BangPatterns #-} +{-# language DeriveGeneric #-} +{-# language DeriveFoldable #-} +{-# language DeriveFunctor #-} +{-# language DeriveTraversable #-} +{-# language NoImplicitPrelude #-} +{-# language ScopedTypeVariables #-} + +-- | This module provides a lossless way to do +-- diffing between two 'Map's, and ways to +-- manipulate the diffs. +module Patience.Map + ( -- * Types + Delta(..) + + -- * Diffing + , diff + + -- * Case analysis on 'Delta' + , getSame + , getOld + , getNew + , getDelta + , getOriginals + + , isSame + , isOld + , isNew + , isDelta + + -- * Construction of special maps from a diff + , toSame + , toOld + , toNew + , toDelta + , toOriginals + + -- * Mapping + , mapSame + , mapOld + , mapNew + + , mapSame' + , mapOld' + , mapNew' + ) where + +import Data.Bool (Bool(True, False)) +import Data.Eq (Eq((==))) +import Data.Foldable (Foldable) +import Data.Function ((.)) +import Data.Functor (Functor(fmap)) +import Data.Maybe (Maybe(Just,Nothing)) +import Data.Ord (Ord) +import Data.Tuple (fst,snd) +import Data.Traversable (Traversable) +import GHC.Generics (Generic, Generic1) +import GHC.Show (Show) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as DMS +import qualified Data.Map.Merge.Strict as Merge + +-- | The result of a diff of an entry within two 'Map's. +-- +-- In two 'Map's m1 and m2, when performing a diff, this type encodes the following situations: +-- +-- Same key, different values: Stores the two values in the Delta constructor. +-- +-- Same key, same values: Stores the value in the Same constructor. +-- +-- Key exists in m1 but not m2: Stores the value in the Old constructor. +-- +-- Key exists in m2 but not m1: Stores the value in the New constructor. +-- +-- This behaviour ensures that we don't lose any information, meaning +-- we can reconstruct either of the original 'Map' 'k' 'a' from a 'Map' 'k' ('Delta' 'a'). +-- (Note that this slightly differs from `Patience.diff`, which does not +-- care about the possibility of reconstruction). +data Delta a + = Delta !a !a + | Same !a + | Old !a + | New !a + deriving (Eq, Foldable, Functor, Generic, Generic1, Ord, Show, Traversable) + +-- | Takes two 'Map's and returns a 'Map' from the same key type to 'Delta' 'a', +-- where 'Delta' 'a' encodes differences between entries. +diff :: (Eq a, Ord k) + => Map k a -- ^ first, /old/ 'Map' + -> Map k a -- ^ second, /new/ 'Map' + -> Map k (Delta a) -- ^ 'Map' encoding the diff +diff !m1 !m2 = + Merge.merge + (Merge.mapMissing (\_ x -> Old x)) -- preserve keys found in m1 but not m2 + (Merge.mapMissing (\_ x -> New x)) -- preserve keys found in m2 but not m1 + (Merge.zipWithMatched (\_ v1 v2 -> if v1 == v2 then Same v1 else Delta v1 v2)) + m1 + m2 +{-# INLINABLE diff #-} + +-- | Is the 'Delta' an encoding of same values? +isSame :: Eq a => Delta a -> Bool +isSame (Same _) = True +isSame (Delta x y) = x == y +isSame _ = False +{-# INLINABLE isSame #-} + +-- | Is the 'Delta' an encoding of old values? +isOld :: Delta a -> Bool +isOld (Old _) = True +isOld (Delta _ _) = True +isOld _ = False +{-# INLINE isOld #-} + +-- | Is the 'Delta' an encoding of new values? +isNew :: Delta a -> Bool +isNew (New _) = True +isNew (Delta _ _) = True +isNew _ = False +{-# INLINE isNew #-} + +-- | Is the 'Delta' an encoding of changed values? +isDelta :: Delta a -> Bool +isDelta (Delta _ _) = True +isDelta _ = False +{-# INLINE isDelta #-} + +-- | Potentially get the 'Same' value out of a 'Delta'. +getSame :: Eq a => Delta a -> Maybe a +getSame (Same a) = Just a +getSame (Delta x y) = if x == y then Just x else Nothing +getSame _ = Nothing +{-# INLINABLE getSame #-} + +-- | Potentially get the 'Old' value out of a 'Delta'. +getOld :: Delta a -> Maybe a +getOld (Delta a _) = Just a +getOld (Old a) = Just a +getOld _ = Nothing +{-# INLINE getOld #-} + +-- | Potentially get the 'New' value out of a 'Delta'. +getNew :: Delta a -> Maybe a +getNew (Delta _ a) = Just a +getNew (New a) = Just a +getNew _ = Nothing +{-# INLINE getNew #-} + +-- | Potentially get the 'Changed' value out of a 'Delta'. +getDelta :: Delta a -> Maybe (a,a) +getDelta (Delta d1 d2) = Just (d1,d2) +getDelta _ = Nothing +{-# INLINE getDelta #-} + +-- | Get the original values out of the 'Delta'. +getOriginals :: Delta a -> (Maybe a, Maybe a) +getOriginals (Delta x y) = (Just x, Just y) +getOriginals (Same x ) = (Just x, Just x) +getOriginals (Old x ) = (Just x, Nothing) +getOriginals (New x ) = (Nothing, Just x) +{-# INLINE getOriginals #-} + +-- | Retrieve the 'Same' values out of the diff map. +toSame :: Eq a => Map k (Delta a) + -> Map k a +toSame = DMS.mapMaybe getSame +{-# INLINABLE toSame #-} + +-- | Retrieve only the 'Old' values out of the diff map. +toOld :: Map k (Delta a) + -> Map k a +toOld = DMS.mapMaybe getOld +{-# INLINE toOld #-} + +-- | Retrieve only the 'New' values out of the diff map. +toNew :: Map k (Delta a) + -> Map k a +toNew = DMS.mapMaybe getNew +{-# INLINE toNew #-} + +-- | Retrieve only the 'DeltaUnit' values out of the diff map. +toDelta :: Map k (Delta a) + -> Map k (a,a) +toDelta = DMS.mapMaybe getDelta +{-# INLINE toDelta #-} + +-- | Reconstruct both original 'Map's. +toOriginals :: Map k (Delta a) + -> (Map k a, Map k a) +toOriginals m = (DMS.mapMaybe (fst . getOriginals) m, DMS.mapMaybe (snd . getOriginals) m) + +-- | Map over all 'Same' values, returning a map of just +-- the transformed values. +-- This can be more efficient than calling 'toSame' and +-- then Data.Map's 'DMS.map'. +mapSame :: Eq a + => (a -> b) + -> Map k (Delta a) + -> Map k b +mapSame f = DMS.mapMaybe (fmap f . getSame) +{-# INLINABLE mapSame #-} + +-- | Map over all 'Old' values, returning a map of just +-- the transformed values. +-- This can be more efficient than calling 'toOld' and +-- then Data.Map's 'DMS.map'. +mapOld :: (a -> b) + -> Map k (Delta a) + -> Map k b +mapOld f = DMS.mapMaybe (fmap f . getOld) +{-# INLINE mapOld #-} + +-- | Map over all 'New' values, returning a map of just +-- the transformed values. +-- This can be more efficient than calling 'toNew' and +-- then Data.Map's 'DMS.map'. +mapNew :: (a -> b) + -> Map k (Delta a) + -> Map k b +mapNew f = DMS.mapMaybe (fmap f . getNew) +{-# INLINE mapNew #-} + +-- | Map over all the 'Same' values, preserving the +-- remaining values in the map. +mapSame' :: Eq a + => (a -> a) + -> Map k (Delta a) + -> Map k (Delta a) +mapSame' f = DMS.map (\x -> if isSame x then fmap f x else x) +{-# INLINABLE mapSame' #-} + +-- | Map over all the 'Old' values, preserving the +-- remaining values in the map. +mapOld' :: (a -> a) + -> Map k (Delta a) + -> Map k (Delta a) +mapOld' f = DMS.map go + where + go (Old x) = Old (f x) + go (Delta x y) = Delta (f x) y + go x = x +{-# INLINE mapOld' #-} + +-- | Map over all the 'New' values, preserving the +-- remaining values in the map. +mapNew' :: (a -> a) + -> Map k (Delta a) + -> Map k (Delta a) +mapNew' f = DMS.map go + where + go (New x) = New (f x) + go (Delta x y) = Delta x (f y) + go x = x +{-# INLINE mapNew' #-} diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,45 +0,0 @@ --- Simple test for Data.Algorithm.Patience --- --- Invoke as: ./test r n --- for ints r, n --- --- Reads lines of standard input, then repeats r times: --- - Generate two documents of n lines each, by picking --- randomly from the stdin lines, with replacement --- - Compute their patience diff --- - Check that each document is recovered by keeping the --- respective side of the diff -module Main(main) where - -import Control.Monad -import Data.Array -import Data.Maybe -import System.Environment -import System.Random - -import Data.Algorithm.Patience - -keepOld :: [Item a] -> [a] -keepOld = catMaybes . map f where - f (Old x ) = Just x - f (New _) = Nothing - f (Both x _) = Just x - -keepNew :: [Item a] -> [a] -keepNew = catMaybes . map f where - f (Old _ ) = Nothing - f (New x) = Just x - f (Both _ x) = Just x - -main :: IO () -main = do - [r,n] <- map read `fmap` getArgs - xs <- lines `fmap` getContents - let ar = listArray (0, length xs - 1) xs - pick = replicateM n ((ar !) `fmap` randomRIO (bounds ar)) - replicateM_ r $ do - da <- pick - db <- pick - let d = diff da db - good = (da == keepOld d) && (db == keepNew d) - when (not good) $ print (da, db, d)