模块化游程编码

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元组，也不能在手头的三个元组中合并一对元组，则只向前推进一个元组。

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，直到它的结果不变，看起来肯定会更简单。但它感觉它扫描了很多次整个列表，而我的三分球实现只扫描了一次整个列表。也许我们可以从左边弹出一个元素，并将其添加到新的堆栈中，同时合并相同的连续项？或者可能使用应用函数？例如，这是有效的，但不确定其效率/性能：reduce = (until =<< ((==) =<<)) (nest . flatten)。

Answer 1

算法

我认为你从字符串的角度来思考这个问题会让这个问题变得更加困难。相反，做一个初步的通行证，只做无聊的RLE部分。这样，第二次传递相对容易，因为您可以使用表示特定长度的运行的"令牌"，而不必一次处理一个字符。

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

性能

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

正确性

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

Minutiae

最后要注意的是，我使用自定义数据类型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

我的第一个观察结果是，您只需要对解析的一个步骤进行编码，因为您可以将该步骤传递给一个函数，该函数将为其提供自己的输出，直到它稳定下来。这个SO问题讨论了这个函数，@galvat:给出了一个聪明的答案

--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)]。然后我们得到一个括号内的块，它包含我们的阶跃函数。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行代码非常容易阅读。