patience 0.1.1 → 0.3
raw patch · 8 files changed
Files
- CHANGELOG.md +12/−0
- Data/Algorithm/Patience.hs +0/−154
- LICENSE +1/−0
- README.md +15/−0
- patience.cabal +39/−19
- src/Patience.hs +135/−0
- src/Patience/Map.hs +254/−0
- test/test.hs +0/−45
+ CHANGELOG.md view
@@ -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
− Data/Algorithm/Patience.hs
@@ -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:--- <http://en.wikipedia.org/wiki/Patience_sorting>.--- 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
LICENSE view
@@ -1,4 +1,5 @@ Copyright (c) Keegan McAllister 2011+Copyright (c) chessai 2018 All rights reserved.
+ README.md view
@@ -0,0 +1,15 @@+[](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`.
patience.cabal view
@@ -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 <mcallister.keegan@gmail.com>-maintainer: Keegan McAllister <mcallister.keegan@gmail.com>-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 <http://alfedenzo.livejournal.com/170301.html> and <http://bramcohen.livejournal.com/73318.html>.- .- New in version 0.1.1: relaxed @containers@ dependency, so it should build on- GHC 6.10.-+category:+ Algorithms, Text+author:+ Keegan McAllister <mcallister.keegan@gmail.com>+ chessai <chessai1996@gmail.com>+maintainer:+ chessai <chessai1996@gmail.com>+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
+ src/Patience.hs view
@@ -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:+-- <http://en.wikipedia.org/wiki/Patience_sorting>.+-- 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
+ src/Patience/Map.hs view
@@ -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' #-}
− test/test.hs
@@ -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)