模块化游程编码

Question

问题

如何实现一个运行长度编码模数n>=1？对于n=4，考虑到输入AAABBBBABCCCCBBBDAAA，我们想要输出[('D', 1), ('A', 3)]。请注意由于模运算而导致的长距离合并。见说明。

说明

BBBB 的第一次出现编码为(B, 4)，其modulus 4 是(B, 0)，从而抵消了自身。参见图表（忽略空格；它们仅用于说明目的）：

AAABBBBABCCCCBBBDAAA
A3  B4 ABCCCCBBBDAAA
A3  B0 ABCCCCBBBDAAA
A3     ABCCCCBBBDAAA
A4      BCCCCBBBDAAA
A0      BCCCCBBBDAAA
        BCCCCBBBDAAA
        ... 
                DA3

一个更简单的例子，当没有合并发生时，因为没有被modulus 4取消：输入AAABABBBC产生输出[('A',3),('B',1),('A',1),('B',3),('C',1)]。

要求

• Haskell 实现是首选，但也欢迎其他实现！
• 首选标准/通用库函数而不是第三方库。
• 更喜欢使用高阶函数的可读且简洁的程序。
• 优先考虑效率（不必要时不要遍历整个列表）

我的程序

我在 Haskell 中实现了这一点，但它看起来太冗长且难以阅读。关键思想是一次检查三个元组，如果我们既不能取消0 元组，也不能合并手头的三个元组中的一对元组，只能向前推进一个元组。 p>

import Data.List (group)

test = [('A', 1), ('A', 2), ('B', 2), ('B', 2), ('A', 1), ('B', 1), ('C', 1), ('C', 3), ('B', 3), ('D', 1), ('A', 3)] :: [(Char, Int)]
expected = [('D', 1), ('A', 3)] :: [(Char, Int)]


reduce' :: [(Char, Int)] -> [(Char, Int)]
reduce' [           ] = []                                           -- exit
reduce' (   (_,0):xs) = reduce' xs
reduce' (x1:(_,0):xs) = reduce' (x1:xs)
reduce' (   (x,n):[]) = (x,n):[]                                     -- exit

reduce' (        (x1,n1):(x2,n2):[])              -- [previous,current,NONE]
  | x1 == x2  = reduce' ((x1, d4 (n1+n2)):[])
  | otherwise = (x1,n1):(                                         -- advance
                reduce' ((x2, d4     n2 ):[]))

reduce' ((x1,n1):(x2,n2):(x3,n3):xs)              -- [previous,current,next]
  | n3 == 0   = reduce' ((x1, d4  n1    ):(x2, d4  n2    ):xs)
  | n2 == 0   = reduce' ((x1, d4  n1    ):(x3, d4     n3 ):xs)
  | x2 == x3  = reduce' ((x1, d4  n1    ):(x2, d4 (n2+n3)):xs)
  | x1 == x2  = reduce' ((x2, d4 (n1+n2)):(x3, d4     n3 ):xs)
  | otherwise = (x1,n1):(                                         -- advance
                reduce' ((x2, d4  n2    ):(x3, d4     n3 ):xs)
                )

-- Helpers
flatten :: [(Char, Int)] -> String
flatten nested = concat $ (\(x, n) -> replicate n x) <$> nested

nest :: String -> [(Char, Int)]
nest flat = zip (head <$> xg) (d4 .length <$> xg)
  where xg = group flat

reduce = reduce' . nest
d4 = (`rem` 4)

想法

我的输入就像上面截图中的 test 变量。我们可以继续做flatten 然后nest 直到它的结果没有改变，并且肯定看起来更简单。但感觉它是多次扫描整个列表，而我的 3 指针实现只扫描整个列表一次。也许我们可以在合并相同的连续项目时从左侧弹出一个元素并将其添加到新堆栈中？或者也许使用应用函子？例如。这可行，但不确定其效率/性能：reduce = (until =<< ((==) =<<)) (nest . flatten)。

Answer 1

算法

我认为您完全从字符串的角度来考虑这个问题会使这个问题变得更加困难。相反，做一个初步的传递，只做无聊的 RLE 部分。这样一来，第二遍比较容易，因为您可以使用代表一定长度的运行的“令牌”来工作，而不必一次处理一个字符。

我们在第二次遍历列表时需要维护的唯一数据结构是堆栈，我们只需要查看它的顶部元素。我们将正在检查的每个令牌与堆栈顶部进行比较。如果它们相同，我们将它们混合成一个表示它们连接的标记；否则，我们只需将下一个令牌压入堆栈。在任何一种情况下，我们都会减少令牌大小 mod N 并丢弃大小为 0 的令牌。

性能

• 此算法以线性时间运行：它只处理每个输入标记一次，并为每个标记执行恒定量的工作。
• 它不能懒惰地产生输出。没有输入的前缀足以自信地产生输出的前缀，所以我们必须等到我们消耗完整个输入才能产生任何输出。如果字符串的其余部分是 CCCBBBAAA...，即使是像 ABCABCABCABCABC 这样“看起来很糟糕”的东西最终也可以被取消。
• 最后的反面很糟糕，但摊销到所有代币上是相当便宜的，而且无论如何不会恶化我们的线性时间保证。它同样不会改变我们的空间需求，因为我们已经需要 O(N) 空间来缓冲输出（因为正如前面的注释所说，永远不可能发出部分结果）。

正确性

写下我关于懒惰的评论让我想起了你的reduce 解决方案，它似乎会懒惰地产生输出，我认为这是不可能的。事实证明，解释是您的实现不仅如您所说的那样不优雅，而且也不正确。它过早地产生输出，错过了用后面的元素取消的机会。我能找到你失败的最简单的测试用例是reduce "ABABBBBAAABBBAAA" == [('A',1),('A',3)]。我们可以通过注意到 take 1 $ reduce ("ABAB" ++ undefined) 产生 [(1, 'A')] 来确认这是由于太早产生结果，即使元素可能稍后出现，与第一个 A 取消。

细节

最后请注意，我使用自定义数据类型Run 只是为了给概念命名；当然你可以很便宜地将它转换成一个元组，或者如果你愿意的话，你可以重写函数以在内部使用元组。

实施

import Data.List (group)

data Run a = Run Int a deriving Show

modularRLE :: Eq a => Int -> [a] -> [Run a]
modularRLE groupSize = go [] . tokenize
  where go stack [] = reverse stack
        go stack (Run n x : remainder) = case stack of
          [] -> go (blend n []) remainder
          (Run m y : prev) | x == y -> go (blend (n + m) prev) remainder
                           | otherwise -> go (blend n stack) remainder
          where blend i s = case i `mod` groupSize of
                              0 -> s
                              j -> Run j x : s
        tokenize xs = [Run (length run) x | run@(x:_) <- group xs]
λ> modularRLE 4 "AAABBBBABCCCCBBBDAAA"
[Run 1 'D',Run 3 'A']
λ> modularRLE 4 "ABABBBBAAABBBAAA"
[]

Answer 2

我的第一个观察结果是您只需要编写分辨率的一个步骤，因为您可以将该步骤传递给一个函数，该函数将为其提供自己的输出，直到它稳定为止。这个函数在this SO question 中讨论过，@galva 给出了一个聪明的答案：

--from https://stackoverflow.com/a/23924238/7096763
converge :: Eq a => (a -> a) -> a -> a
converge = until =<< ((==) =<<)

这是算法的入口点：

--               |-------------step----------------------|    |---------------process------|   
solve = converge (filter (not . isFullTuple) . collapseOne) . fmap (liftA2 (,)  head length) . group

从行尾开始向后移动（按照执行顺序），我们首先使用fmap (liftA2 (,) head length) . group将String处理成[(Char, Int)]。然后我们到达一个包含我们的 step 函数的括号块。 collapseOne 获取一个元组列表并折叠最多一对元组，如有必要（如果 mod 4 == 0）删除结果元组（[('A', 1), ('A', 2), ('B', 2)] ==> [('A', 3), ('B', 2)]）：

collapseOne [x] = [x]
collapseOne [] = []
collapseOne (l:r:xs)
  | fst l == fst r = (fst l, (snd l + snd r) `mod` 4):xs
  | otherwise          = l:(collapseOne (r:xs))

您还需要知道元组是否“成熟”并需要过滤掉：

isFullTuple = (==0) . (`mod` 4) . snd

我认为这 8 行代码更容易阅读。