patience-0.2.1.1/0000755000000000000000000000000000000000000011570 5ustar0000000000000000patience-0.2.1.1/CHANGELOG.md0000755000000000000000000000042400000000000013404 0ustar0000000000000000# Changes in version TBA * Deprecate `Patience.itemChar`. * 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 patience-0.2.1.1/LICENSE0000644000000000000000000000274700000000000012607 0ustar0000000000000000Copyright (c) Keegan McAllister 2011 Copyright (c) chessai 2018 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his 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 AUTHORS 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. patience-0.2.1.1/README.md0000755000000000000000000000127200000000000013054 0ustar0000000000000000[![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`.patience-0.2.1.1/Setup.hs0000644000000000000000000000010600000000000013221 0ustar0000000000000000#! /usr/bin/runhaskell import Distribution.Simple main = defaultMain patience-0.2.1.1/patience.cabal0000644000000000000000000000243500000000000014350 0ustar0000000000000000cabal-version: 2.0 name: patience version: 0.2.1.1 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. . 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 and . category: Algorithms, Text author: Keegan McAllister chessai maintainer: chessai homepage: https://github.com/chessai/patience build-type: Simple extra-source-files: CHANGELOG.md README.md library hs-source-dirs: src exposed-modules: Patience Patience.Map ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4.6 && < 5 , containers >= 0.5.9 && < 0.7 source-repository head type: git location: https://github.com/chessai/patience.git patience-0.2.1.1/src/0000755000000000000000000000000000000000000012357 5ustar0000000000000000patience-0.2.1.1/src/Patience.hs0000644000000000000000000001326300000000000014450 0ustar0000000000000000{-# 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(..), itemChar, itemValue -- * 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 -- | The character @\'-\'@ or @\'+\'@ or @\' \'@ for 'Old' or 'New' or 'Both' respectively. {-# DEPRECATED itemChar "Don't use this. It will be removed in a later version." #-} itemChar :: Item a -> Char itemChar (Old _ ) = '-' itemChar (New _ ) = '+' itemChar (Both _ _) = ' ' -- | The value from an 'Item'. For 'Both', returns the \"old\" value. {-# DEPRECATED itemValue "Don't use this. It will be removed in a later version." #-} itemValue :: Item a -> a itemValue (Old x ) = x itemValue (New x ) = x itemValue (Both x _) = x patience-0.2.1.1/src/Patience/0000755000000000000000000000000000000000000014107 5ustar0000000000000000patience-0.2.1.1/src/Patience/Map.hs0000644000000000000000000002002200000000000015154 0ustar0000000000000000{-# 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(..) , M(..) -- * Diffing , diff -- * Case analysis on 'Delta' , getSame , getOld , getNew , getDelta , getOriginal , getOriginals , isSame , isOld , isNew , isDelta -- * Construction of special maps from a diff , toSame , toOld , toNew , toDelta , toOriginal , 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.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) -- | M1 = First 'Map', M2 = Second 'Map'. -- Used as an argument for functions that care about which 'Map' to reconstruct. data M = M1 | M2 -- | 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) = if x == y then True else False 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 #-} -- | Potentially get the original value out of the 'Delta'. getOriginal :: M -> Delta a -> Maybe a getOriginal M1 (Delta x _) = Just x getOriginal M2 (Delta _ y) = Just y getOriginal _ (Same x ) = Just x getOriginal M1 (Old x ) = Just x getOriginal _ (Old _ ) = Nothing getOriginal M2 (New x ) = Just x getOriginal _ (New _ ) = Nothing {-# INLINE getOriginal #-} -- | 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 #-} -- | Construct either the old 'Map' or new 'Map' from a diff toOriginal :: M -> Map k (Delta a) -> Map k a toOriginal m = DMS.mapMaybe (getOriginal m) {-# INLINE toOriginal #-} -- | Reconstruct both original 'Map's. toOriginals :: Map k (Delta a) -> (Map k a, Map k a) toOriginals m = (DMS.mapMaybe (getOriginal M1) m, DMS.mapMaybe (getOriginal M2) 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' #-}