patience-0.3/0000755000000000000000000000000007346545000011335 5ustar0000000000000000patience-0.3/CHANGELOG.md0000755000000000000000000000065207346545000013154 0ustar0000000000000000# 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 patience-0.3/LICENSE0000644000000000000000000000274707346545000012354 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.3/README.md0000755000000000000000000000127207346545000012621 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.3/Setup.hs0000644000000000000000000000010607346545000012766 0ustar0000000000000000#! /usr/bin/runhaskell import Distribution.Simple main = defaultMain patience-0.3/patience.cabal0000644000000000000000000000234407346545000014114 0ustar0000000000000000cabal-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. . 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.3 && < 5 , containers >= 0.5.9 && < 0.7 source-repository head type: git location: https://github.com/chessai/patience.git patience-0.3/src/0000755000000000000000000000000007346545000012124 5ustar0000000000000000patience-0.3/src/Patience.hs0000644000000000000000000001220107346545000014204 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(..) -- * 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 patience-0.3/src/Patience/0000755000000000000000000000000007346545000013654 5ustar0000000000000000patience-0.3/src/Patience/Map.hs0000644000000000000000000001641707346545000014736 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(..) -- * 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' #-}