{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Implementation of the Myers algorithm, from "An O(ND) Difference Algorithm
-- and Its Variations", by Eugene Myers page 6 (figure 2).
--
-- Specification: if
--
--    f1 (InBoth v) = Just v
--    f1 (InFirst v) = Just v
--    f1 (InSecond v) = Nothing
--
-- and
--
--    f2 (InBoth v) = Just v
--    f2 (InFirst v) = Nothing
--    f2 (InSecond v) = Just v
--
-- then
--
--    mapPartial f1 (diff l1 l2) == l1
--
-- and
--
--    mapPartial f2 (diff l1 l2) == l2
module Util.Myers(
   diff,
   diff2,
   DiffElement(..),
   ) where


import Data.Array

import Control.Monad.ST
import Data.Array.ST

import Util.ExtendedPrelude

-- -----------------------------------------------------------------------
-- Datatypes
-- -----------------------------------------------------------------------

data DiffElement v =
      InBoth [v]
   |  InFirst [v]
   |  InSecond [v] deriving (Int -> DiffElement v -> ShowS
[DiffElement v] -> ShowS
DiffElement v -> String
(Int -> DiffElement v -> ShowS)
-> (DiffElement v -> String)
-> ([DiffElement v] -> ShowS)
-> Show (DiffElement v)
forall v. Show v => Int -> DiffElement v -> ShowS
forall v. Show v => [DiffElement v] -> ShowS
forall v. Show v => DiffElement v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiffElement v] -> ShowS
$cshowList :: forall v. Show v => [DiffElement v] -> ShowS
show :: DiffElement v -> String
$cshow :: forall v. Show v => DiffElement v -> String
showsPrec :: Int -> DiffElement v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> DiffElement v -> ShowS
Show)

-- -----------------------------------------------------------------------
-- The implementation.  The whole function, apart from the body of diff
-- itself, is taken from a message from Andrew Bromage
-- -----------------------------------------------------------------------

diff :: (Eq a) => [a] -> [a] -> [DiffElement a]
diff :: [a] -> [a] -> [DiffElement a]
diff [a]
l1 [a]
l2 =
   let
      common :: [a]
common = [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
lcss [a]
l1 [a]
l2

      addFirst :: [a] -> [DiffElement a] -> [DiffElement a]
      addFirst :: [a] -> [DiffElement a] -> [DiffElement a]
addFirst [] [DiffElement a]
de0 = [DiffElement a]
de0
      addFirst [a]
l1 [DiffElement a]
de0 = [a] -> DiffElement a
forall v. [v] -> DiffElement v
InFirst [a]
l1 DiffElement a -> [DiffElement a] -> [DiffElement a]
forall a. a -> [a] -> [a]
: [DiffElement a]
de0

      addSecond :: [a] -> [DiffElement a] -> [DiffElement a]
      addSecond :: [a] -> [DiffElement a] -> [DiffElement a]
addSecond [] [DiffElement a]
de0 = [DiffElement a]
de0
      addSecond [a]
l1 [DiffElement a]
de0 = [a] -> DiffElement a
forall v. [v] -> DiffElement v
InSecond [a]
l1 DiffElement a -> [DiffElement a] -> [DiffElement a]
forall a. a -> [a] -> [a]
: [DiffElement a]
de0

      doCommon :: Eq a => [a] -> [a] -> [a] -> [DiffElement a]
      doCommon :: [a] -> [a] -> [a] -> [DiffElement a]
doCommon [] [a]
l1 [a]
l2 = ([a] -> [DiffElement a] -> [DiffElement a]
forall a. [a] -> [DiffElement a] -> [DiffElement a]
addFirst [a]
l1) ([DiffElement a] -> [DiffElement a])
-> ([DiffElement a] -> [DiffElement a])
-> [DiffElement a]
-> [DiffElement a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [DiffElement a] -> [DiffElement a]
forall a. [a] -> [DiffElement a] -> [DiffElement a]
addSecond [a]
l2) ([DiffElement a] -> [DiffElement a])
-> [DiffElement a] -> [DiffElement a]
forall a b. (a -> b) -> a -> b
$ []
      doCommon (a
c:[a]
cs) [a]
l10 [a]
l20 =
         let
            Just ([a]
l1A,[a]
l11) = (a -> Bool) -> [a] -> Maybe ([a], [a])
forall a. (a -> Bool) -> [a] -> Maybe ([a], [a])
splitToElem (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c) [a]
l10
            Just ([a]
l2A,[a]
l21) = (a -> Bool) -> [a] -> Maybe ([a], [a])
forall a. (a -> Bool) -> [a] -> Maybe ([a], [a])
splitToElem (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c) [a]
l20
            de0 :: [DiffElement a]
de0 = [a] -> [a] -> [a] -> [DiffElement a]
forall a. Eq a => [a] -> [a] -> [a] -> [DiffElement a]
doCommon [a]
cs [a]
l11 [a]
l21
            de1 :: [DiffElement a]
de1 = case [DiffElement a]
de0 of
               (InBoth [a]
cs:[DiffElement a]
rest) -> [a] -> DiffElement a
forall v. [v] -> DiffElement v
InBoth (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)DiffElement a -> [DiffElement a] -> [DiffElement a]
forall a. a -> [a] -> [a]
:[DiffElement a]
rest
               [DiffElement a]
_ -> [a] -> DiffElement a
forall v. [v] -> DiffElement v
InBoth [a
c] DiffElement a -> [DiffElement a] -> [DiffElement a]
forall a. a -> [a] -> [a]
: [DiffElement a]
de0
         in
             ([a] -> [DiffElement a] -> [DiffElement a]
forall a. [a] -> [DiffElement a] -> [DiffElement a]
addFirst [a]
l1A) ([DiffElement a] -> [DiffElement a])
-> ([DiffElement a] -> [DiffElement a])
-> [DiffElement a]
-> [DiffElement a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [DiffElement a] -> [DiffElement a]
forall a. [a] -> [DiffElement a] -> [DiffElement a]
addSecond [a]
l2A) ([DiffElement a] -> [DiffElement a])
-> [DiffElement a] -> [DiffElement a]
forall a b. (a -> b) -> a -> b
$ [DiffElement a]
de1
   in
      [a] -> [a] -> [a] -> [DiffElement a]
forall a. Eq a => [a] -> [a] -> [a] -> [DiffElement a]
doCommon [a]
common [a]
l1 [a]
l2

-- stolen from message from Andrew Bromage
algb :: (Eq a) => [a] -> [a] -> [Int]
algb :: [a] -> [a] -> [Int]
algb [a]
xs [a]
ys
  = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [a] -> [(a, Int)] -> [Int]
forall t a. (Num t, Ord t, Eq a) => [a] -> [(a, t)] -> [t]
algb1 [a]
xs [ (a
y,Int
0) | a
y <- [a]
ys ]
  where
    algb1 :: [a] -> [(a, t)] -> [t]
algb1 [] [(a, t)]
ys' = ((a, t) -> t) -> [(a, t)] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (a, t) -> t
forall a b. (a, b) -> b
snd [(a, t)]
ys'
    algb1 (a
x:[a]
xs) [(a, t)]
ys'
      = [a] -> [(a, t)] -> [t]
algb1 [a]
xs (t -> t -> [(a, t)] -> [(a, t)]
forall t. (Num t, Ord t) => t -> t -> [(a, t)] -> [(a, t)]
algb2 t
0 t
0 [(a, t)]
ys')
      where
        algb2 :: t -> t -> [(a, t)] -> [(a, t)]
algb2 t
_ t
_ [] = []
        algb2 t
k0j1 t
k1j1 ((a
y,t
k0j):[(a, t)]
ys)
          = let kjcurr :: t
kjcurr = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then t
k0j1t -> t -> t
forall a. Num a => a -> a -> a
+t
1 else t -> t -> t
forall a. Ord a => a -> a -> a
max t
k1j1 t
k0j
            in (a
y,t
kjcurr) (a, t) -> [(a, t)] -> [(a, t)]
forall a. a -> [a] -> [a]
: t -> t -> [(a, t)] -> [(a, t)]
algb2 t
k0j t
kjcurr [(a, t)]
ys

algc :: (Eq a) => Int -> Int -> [a] -> [a] -> [a] -> [a]
algc :: Int -> Int -> [a] -> [a] -> [a] -> [a]
algc Int
m Int
n [a]
xs []  = [a] -> [a]
forall a. a -> a
id
algc Int
m Int
n [a
x] [a]
ys = if a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys then (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) else [a] -> [a]
forall a. a -> a
id
algc Int
m Int
n [a]
xs [a]
ys
  = Int -> Int -> [a] -> [a] -> [a] -> [a]
forall a. Eq a => Int -> Int -> [a] -> [a] -> [a] -> [a]
algc Int
m2 Int
k [a]
xs1 (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
k [a]
ys) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [a] -> [a] -> [a] -> [a]
forall a. Eq a => Int -> Int -> [a] -> [a] -> [a] -> [a]
algc (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m2) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [a]
xs2 (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k [a]
ys)
  where
    m2 :: Int
m2 = Int
m Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

    xs1 :: [a]
xs1 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
m2 [a]
xs
    xs2 :: [a]
xs2 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
m2 [a]
xs

    l1 :: [Int]
l1 = [a] -> [a] -> [Int]
forall a. Eq a => [a] -> [a] -> [Int]
algb [a]
xs1 [a]
ys
    l2 :: [Int]
l2 = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([a] -> [a] -> [Int]
forall a. Eq a => [a] -> [a] -> [Int]
algb ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs2) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys))

    k :: Int
k = Int -> Int -> Int -> [(Int, Int)] -> Int
forall t a. (Ord t, Num t, Num a) => a -> a -> t -> [(t, t)] -> a
findk Int
0 Int
0 (-Int
1) ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
l1 [Int]
l2)

    findk :: a -> a -> t -> [(t, t)] -> a
findk a
k a
km t
m [] = a
km
    findk a
k a
km t
m ((t
x,t
y):[(t, t)]
xys)
      | t
xt -> t -> t
forall a. Num a => a -> a -> a
+t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
m  = a -> a -> t -> [(t, t)] -> a
findk (a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
1) a
k  (t
xt -> t -> t
forall a. Num a => a -> a -> a
+t
y) [(t, t)]
xys
      | Bool
otherwise = a -> a -> t -> [(t, t)] -> a
findk (a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
1) a
km t
m     [(t, t)]
xys

lcss :: (Eq a) => [a] -> [a] -> [a]
lcss :: [a] -> [a] -> [a]
lcss [a]
xs [a]
ys = Int -> Int -> [a] -> [a] -> [a] -> [a]
forall a. Eq a => Int -> Int -> [a] -> [a] -> [a] -> [a]
algc ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys) [a]
xs [a]
ys []


{- Here, as an appendix, is my slow inefficient version -}
diff2 :: Eq v => [v] -> [v] -> [DiffElement v]
diff2 :: [v] -> [v] -> [DiffElement v]
diff2 [] [] = []
diff2 [v]
a [v]
b = (forall s. ST s [DiffElement v]) -> [DiffElement v]
forall a. (forall s. ST s a) -> a
runST ([v] -> [v] -> ST s [DiffElement v]
forall v s. Eq v => [v] -> [v] -> ST s [DiffElement v]
diffST2 [v]
a [v]
b)

-- NB. diffST does not work if both arguments are null, so that
-- case should be handled separately.
diffST2 :: forall v s . Eq v => [v] -> [v] -> ST s [DiffElement v]
diffST2 :: [v] -> [v] -> ST s [DiffElement v]
diffST2 [v]
a [v]
b =
   do
      let
         m :: Int
m = [v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
a
         (Array Int v
aArr :: Array Int v) = (Int, Int) -> [v] -> Array Int v
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
m) [v]
a

         n :: Int
n = [v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
b
         (Array Int v
bArr :: Array Int v) = (Int, Int) -> [v] -> Array Int v
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
n) [v]
b

         match :: Int -> Int -> Bool
         match :: Int -> Int -> Bool
match Int
x Int
y = (Array Int v
aArr Array Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
! Int
x) v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== (Array Int v
bArr Array Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
! Int
y)

         -- Given (x,y) return the highest (x+k,y+k) such that (x+1,y+1),
         -- (x+2,y+2)...(x+k,y+k) match.
         scan :: Int -> Int -> (Int,Int)
         scan :: Int -> Int -> (Int, Int)
scan Int
x Int
y =
            if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
               then
                  let
                     x' :: Int
x' = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                     y' :: Int
y' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                  in
                     if Int -> Int -> Bool
match Int
x' Int
y' then Int -> Int -> (Int, Int)
scan Int
x' Int
y' else (Int
x,Int
y)
               else
                  (Int
x,Int
y)

         max :: Int
max = Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n
      -- We do the computation using an STArray for V
      -- We arrange that there is always a -1 on either side of the
      -- existing range, to simplify handling of the end-cases.
      (STUArray s Int Int
v :: STUArray s Int Int) <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-Int
maxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
maxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (-Int
1)
      STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
v Int
1 Int
0

      -- The w array contains a list of integers (x,y) such that the snakes
      -- starting from the elements (x+1,y+1) together make up all the snakes
      -- needed in the optimal solution.
      --
      -- The idea is that storage for w should not get too big, either if a
      -- and b are much the same, or if they are completely different.  Thus
      -- in most cases quadratic behaviour *should* be avoided.
      (STArray s Int [(Int, Int)]
w :: STArray s Int [(Int,Int)]) <- (Int, Int) -> [(Int, Int)] -> ST s (STArray s Int [(Int, Int)])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-Int
max,Int
max) []

      let
         -- step carries out the algorithm for a given (d,k), returning
         -- the appropriate w-list.
         step :: Int -> Int -> ST s [(Int,Int)]
         step :: Int -> Int -> ST s [(Int, Int)]
step Int
d Int
k =
            if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
d
               then
                  Int -> Int -> ST s [(Int, Int)]
innerStep (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (-(Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
               else
                  Int -> Int -> ST s [(Int, Int)]
innerStep Int
d Int
k

         innerStep :: Int -> Int -> ST s [(Int,Int)]
         innerStep :: Int -> Int -> ST s [(Int, Int)]
innerStep Int
d Int
k =
            do
               Int
vkplus <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
v (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
               Int
vkminus <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
v (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
               (Int
x,[(Int, Int)]
l0) <- if Int
vkminus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
vkplus
                  then
                     do
                        [(Int, Int)]
l0 <- STArray s Int [(Int, Int)] -> Int -> ST s [(Int, Int)]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Int [(Int, Int)]
w (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                        (Int, [(Int, Int)]) -> ST s (Int, [(Int, Int)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
vkplus,[(Int, Int)]
l0)
                  else
                     do
                        [(Int, Int)]
l <- STArray s Int [(Int, Int)] -> Int -> ST s [(Int, Int)]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Int [(Int, Int)]
w (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                        (Int, [(Int, Int)]) -> ST s (Int, [(Int, Int)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
vkminusInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,[(Int, Int)]
l)
               let
                  y :: Int
y = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k

                  (Int
x',Int
_) = Int -> Int -> (Int, Int)
scan Int
x Int
y

                  l1 :: [(Int, Int)]
l1 =
                     if Int
x' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x
                        then
                           [(Int, Int)]
l0
                        else
                           (Int
x,Int
y) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
l0

               -- Can we finish now?
               if Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m Bool -> Bool -> Bool
&& (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                  then
                     [(Int, Int)] -> ST s [(Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int, Int)]
l1
                  else
                     do
                        STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
v Int
k Int
x'
                        STArray s Int [(Int, Int)] -> Int -> [(Int, Int)] -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Int [(Int, Int)]
w Int
k [(Int, Int)]
l1
                        Int -> Int -> ST s [(Int, Int)]
step Int
d (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)

      [(Int, Int)]
snakes <- Int -> Int -> ST s [(Int, Int)]
step Int
0 Int
0

      let
         -- The task is now to reassemble snakes to produce a list.  Since
         -- the snakes are given in reverse order, we may as well produce the
         -- elements in that order and work backwards.

         addSnake :: (Int,Int) -> (Int,Int)
            -> [DiffElement v] -> [DiffElement v]
         addSnake :: (Int, Int) -> (Int, Int) -> [DiffElement v] -> [DiffElement v]
addSnake (Int
lastX,Int
lastY) (Int
x,Int
y) [DiffElement v]
l0 =
            -- We assume that elements a[lastX+1...] and b[lastY+1...] have
            -- been dealt with, and we now add on a segment starting with a
            -- snake which begins at (x+1,y+1).
            let
               -- Compute the end of the snake
               (Int
x',Int
y') = Int -> Int -> (Int, Int)
scan Int
x Int
y

               -- Add on elements b[y'+1..lastY]
               l1 :: [DiffElement v]
l1 = ([v] -> DiffElement v
forall v. [v] -> DiffElement v
InSecond ((Int -> v) -> [Int] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
index -> Array Int v
bArr Array Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
! Int
index)
                       [Int
y'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
lastY])) DiffElement v -> [DiffElement v] -> [DiffElement v]
forall a. a -> [a] -> [a]
: [DiffElement v]
l0
               -- Add on elements a[x'+1..lastX]
               l2 :: [DiffElement v]
l2 = ([v] -> DiffElement v
forall v. [v] -> DiffElement v
InFirst ((Int -> v) -> [Int] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
index -> Array Int v
aArr Array Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
! Int
index)
                       [Int
x'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
lastX])) DiffElement v -> [DiffElement v] -> [DiffElement v]
forall a. a -> [a] -> [a]
: [DiffElement v]
l1
               -- Add on snake
               l3 :: [DiffElement v]
l3 = ([v] -> DiffElement v
forall v. [v] -> DiffElement v
InBoth ((Int -> v) -> [Int] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
index -> Array Int v
aArr Array Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
! Int
index)
                       [Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
x'])) DiffElement v -> [DiffElement v] -> [DiffElement v]
forall a. a -> [a] -> [a]
: [DiffElement v]
l2
            in
               [DiffElement v]
l3

         doSnakes :: (Int,Int) -> [(Int,Int)] -> [DiffElement v]
            -> [DiffElement v]
         doSnakes :: (Int, Int) -> [(Int, Int)] -> [DiffElement v] -> [DiffElement v]
doSnakes (Int, Int)
last [] [DiffElement v]
l0 =
            -- we pretend there's a zero-length snake starting at (1,1).
            if (Int, Int)
last (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
0,Int
0) then (Int, Int) -> (Int, Int) -> [DiffElement v] -> [DiffElement v]
addSnake (Int, Int)
last (Int
0,Int
0) [DiffElement v]
l0 else [DiffElement v]
l0
         doSnakes (Int, Int)
last ((Int, Int)
s:[(Int, Int)]
ss) [DiffElement v]
l0 =
            let
               l1 :: [DiffElement v]
l1 = (Int, Int) -> (Int, Int) -> [DiffElement v] -> [DiffElement v]
addSnake (Int, Int)
last (Int, Int)
s [DiffElement v]
l0
            in
               (Int, Int) -> [(Int, Int)] -> [DiffElement v] -> [DiffElement v]
doSnakes (Int, Int)
s [(Int, Int)]
ss [DiffElement v]
l1

         result0 :: [DiffElement v]
result0 = (Int, Int) -> [(Int, Int)] -> [DiffElement v] -> [DiffElement v]
doSnakes (Int
m,Int
n) [(Int, Int)]
snakes []

         result1 :: [DiffElement v]
result1 = (DiffElement v -> Bool) -> [DiffElement v] -> [DiffElement v]
forall a. (a -> Bool) -> [a] -> [a]
filter
            -- Filter out null elements
            (\ DiffElement v
de -> case DiffElement v
de of
               InFirst [] -> Bool
False
               InSecond [] -> Bool
False
               InBoth [] -> Bool
False
               DiffElement v
_ -> Bool
True
               )
            [DiffElement v]
result0

      [DiffElement v] -> ST s [DiffElement v]
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffElement v]
result1
{- -}


-- | This version was posted to the Haskell mailing list by Gertjan Kamsteeg
-- on Sun, 15 Dec 2002.
-- But it seems to be slightly slower than the others.
{-

data In a = F a | S a | B a deriving Show

diff xs ys = steps ([(0,0,[],xs,ys)],[]) where
  steps (((_,_,ws,[],[]):_),_) = reverse ws
  steps d                      = steps (step d) where
    step (ps,qs) = let (us,vs) = h1 ps in (h3 qs (h2 us),vs) where
      h1 []     = ([],[])
      h1 (p:ps) = let (rs,ss) = next p; (us,vs) = h1 ps in (rs++us,ss++vs)
         where
            next (k,n,ws,(x:xs),[])           = ([(k+1,n+1,F x:ws,xs,[])],[])
            next (k,n,ws,[],(y:ys))           = ([(k-1,n+1,S y:ws,[],ys)],[])
            next (k,n,ws,xs@(x:us),ys@(y:vs))
              | x == y    = ([],[(k,n+1,B x:ws,us,vs)])
              | otherwise = ([(k+1,n+1,F x:ws,us,ys),(k-1,n+1,S y:ws,xs,vs)],[])
      h2 []                                   = []
      h2 ps@[_]                               = ps
      h2 (p@(k1,n1,_,_,_):ps@(q@(k2,n2,_,_,_):us))
        | k1 == k2  = if n1 <= n2 then p:h2 us else q:h2 us
        | otherwise = p:h2 ps
      h3 ps [] = ps
      h3 [] qs = qs
      h3 (ps@(p@(k1,n1,_,_,_):us)) (qs@(q@(k2,n2,_,_,_):vs))
        | k1 > k2   = p:h3 us qs
        | k1 == k2  = if n1 <= n2 then p:h3 us vs else q:h3 us vs
        | otherwise = q:h3 ps vs
-}