模块化运行长度编码
Modular run-length encoding
问题
如何实现运行长度编码模数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
一个更简单的例子，当 none 被 modulus 4 取消后没有合并发生：输入 AAABABBBC 产生输出 [('A',3),('B',1),('A',1),('B',3),('C',1)].
要求
- Haskell 实现是首选，但也欢迎其他实现！
- 比第 3 方库更喜欢 standard/common 库函数。
- 更喜欢使用高阶函数的可读和简洁的程序。
- 更注重效率（不要在不必要的时候循环整个列表）
我的程序
我在 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 直到它的结果不变，并且看起来肯定更简单。但是感觉它在多次扫描整个列表，而我的 3-pointer 实现只扫描整个列表一次。也许我们可以从左边弹出一个元素并将其添加到新堆栈中，同时合并相同的连续项目？或者也许使用 Applicative Functors？例如。这有效但不确定它的 efficiency/performance: reduce = (until =<< ((==) =<<)) (nest . flatten).
算法
我认为你完全从字符串的角度来考虑这个问题会使这个问题变得更加困难。相反，做一个只做无聊的 RLE 部分的初步传递。这样，第二遍就相对容易了，因为您可以在代表一定长度的 运行 的 "tokens" 中工作，而不必一次处理一个字符。
当我们第二次遍历列表时，我们唯一需要维护的数据结构是一个堆栈，我们只需要查看它的顶部元素。我们将正在检查的每个标记与堆栈顶部进行比较。如果它们相同，我们将它们混合成一个表示它们串联的标记；否则，我们只需将下一个标记压入堆栈。在任何一种情况下，我们都会减少令牌大小 mod N 并删除大小为 0.
的令牌
性能
- 此算法在线性时间内 运行s：它只处理每个输入令牌一次，并为每个令牌执行恒定量的工作。
- 它不能懒惰地产生输出。没有足以自信地产生输出前缀的输入前缀，因此我们必须等到我们消耗了整个输入才能产生任何输出。如果字符串的其余部分是
CCCBBBAAA.... ，即使像 ABCABCABCABCABC 这样的 "looks bad" 最终也可以被抵消
- 最后的反转令人失望，但在所有代币上摊销它是相当便宜的，并且在任何情况下都不会恶化我们的线性时间保证。它同样不会改变我们的 space 要求，因为我们已经需要 O(N) space 来缓冲输出（因为正如前面的注释所说，永远不可能发出部分结果）。
正确性
写下我关于懒惰的评论让我想到了您的 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"
[]
我的第一个观察是您只需要对解决方案的一个步骤进行编码，因为您可以将该步骤传递给一个函数，该函数将为其提供自己的输出，直到它稳定下来。这个函数在 this SO question 中讨论过，@galva 给了一个聪明的答案：
--from
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))
你还需要知道元组是否"ripe"需要过滤掉：
isFullTuple = (==0) . (`mod` 4) . snd
我认为这 8 行代码更容易阅读。
问题
如何实现运行长度编码模数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
一个更简单的例子，当 none 被 modulus 4 取消后没有合并发生：输入 AAABABBBC 产生输出 [('A',3),('B',1),('A',1),('B',3),('C',1)].
要求
- Haskell 实现是首选，但也欢迎其他实现！
- 比第 3 方库更喜欢 standard/common 库函数。
- 更喜欢使用高阶函数的可读和简洁的程序。
- 更注重效率（不要在不必要的时候循环整个列表）
我的程序
我在 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 直到它的结果不变，并且看起来肯定更简单。但是感觉它在多次扫描整个列表，而我的 3-pointer 实现只扫描整个列表一次。也许我们可以从左边弹出一个元素并将其添加到新堆栈中，同时合并相同的连续项目？或者也许使用 Applicative Functors？例如。这有效但不确定它的 efficiency/performance: reduce = (until =<< ((==) =<<)) (nest . flatten).
算法
我认为你完全从字符串的角度来考虑这个问题会使这个问题变得更加困难。相反，做一个只做无聊的 RLE 部分的初步传递。这样，第二遍就相对容易了，因为您可以在代表一定长度的 运行 的 "tokens" 中工作，而不必一次处理一个字符。
当我们第二次遍历列表时，我们唯一需要维护的数据结构是一个堆栈，我们只需要查看它的顶部元素。我们将正在检查的每个标记与堆栈顶部进行比较。如果它们相同，我们将它们混合成一个表示它们串联的标记；否则，我们只需将下一个标记压入堆栈。在任何一种情况下，我们都会减少令牌大小 mod N 并删除大小为 0.
的令牌性能
- 此算法在线性时间内 运行s：它只处理每个输入令牌一次，并为每个令牌执行恒定量的工作。
- 它不能懒惰地产生输出。没有足以自信地产生输出前缀的输入前缀，因此我们必须等到我们消耗了整个输入才能产生任何输出。如果字符串的其余部分是
CCCBBBAAA.... ，即使像 ABCABCABCABCABC 这样的 "looks bad" 最终也可以被抵消
- 最后的反转令人失望，但在所有代币上摊销它是相当便宜的，并且在任何情况下都不会恶化我们的线性时间保证。它同样不会改变我们的 space 要求，因为我们已经需要 O(N) space 来缓冲输出（因为正如前面的注释所说，永远不可能发出部分结果）。
正确性
写下我关于懒惰的评论让我想到了您的 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"
[]
我的第一个观察是您只需要对解决方案的一个步骤进行编码，因为您可以将该步骤传递给一个函数，该函数将为其提供自己的输出，直到它稳定下来。这个函数在 this SO question 中讨论过，@galva 给了一个聪明的答案：
--from
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))
你还需要知道元组是否"ripe"需要过滤掉：
isFullTuple = (==0) . (`mod` 4) . snd
我认为这 8 行代码更容易阅读。