从基于规则集的列表中删除连续的对

Question

作为一个更大函数的一部分，我试图从列表中删除连续的基数方向对，如果它们返回到相同的位置(例如，如果我们在"South"之后找到"North"，我们会删除它们，因为它们相互抵消(。

我曾想过使用内置函数来实现这一点，但我发现我不知道如何过滤这些对，而不是列表中的单个项目。

有什么方法可以通过filter、zipWith等来实现这一点吗？

例如，我试着用zipWith来做这个，但它不起作用，因为我去掉了"；移除"；一对物品。(例如，removePairs [N,S,E,W]导致[S,E]而不是[](

data Dir = N | W | S | E
instance Show (Dir) where
show (N) = "N"
show (E) = "E"
show (W) = "W"
show (S) = "S"

removePairs :: [Dir] -> [Dir]
removePairs [] = []
removePairs [a] = [a]
removePairs (a:as) = concat(zipWith (removeIfRedundant) (a:as) as)

removeIfRedundant :: Dir -> Dir -> [Dir]
removeIfRedundant (N) (S) = []
removeIfRedundant (S) (N) = []
removeIfRedundant (E) (W) = []
removeIfRedundant (W) (E) = []
removeIfRedundant a b     = [a,b]

一个正常的规则集如下：

isRedundant :: Dir -> Dir -> Bool
isRedundant (N) (S) = True
isRedundant (S) (N) = True
isRedundant (E) (W) = True
isRedundant (W) (E) = True
isRedundant _ _     = False

Answer 1

Edit：原来的方法有点愚蠢，而且过于迭代。相反，你可以做

removePairs = foldr combine [] where
combine x [] = [x]
combine x (y:ys) = if redundant x y
then ys
else x : y : ys

我的原始解决方案如下。

一个天真的解决方案是

removePairs (x : y : ys) = if isRedundant x y
then removePairs ys
else x : removePairs (y : ys)
removePairs other = other

但这并不完全奏效——考虑一下[N, E, W, S]。我们想先消除[E, W]得到[N, S]，然后再额外消除[N, S]。

一种很好的线性时间方法如下：

import Control.Monad.State.Lazy (execState, modify)
import Data.Foldable (traverse_)
type WithStack = State [Dir]
removePairs = reverse . flip execState [] . traverse_ action
where
action :: Int -> WithStack ()
action element = do stack <- get
case stack of
[] -> push
(x:xs) -> if isRedundant x element
then put xs
else push
where push :: WithStack ()
push = modify (element:)

这将删除所有冗余，直到没有剩余。

Answer 2

使用fold:会更好

removePairs :: [Dir] -> [Dir]
removePairs = foldr op []
where
op :: Dir -> [Dir] -> [Dir]
op S (N:ds) = ds
op N (S:ds) = ds
op E (W:ds) = ds
op W (E:ds) = ds
op d ds = d:ds

该解决方案将列表折叠成一个新的列表，以处理取消"；我们走的时候"；。

Answer 3

是的，折叠是可行的，这里有另一个使用foldMap:的解决方案

import Data.Sequence as Seq
import Data.Foldable
newtype RemRed = RemRed { unRemRed :: Seq Dir }
instance Semigroup RemRed where
RemRed (xs :|> x) <> RemRed (y :<| ys)
| isRedundant x y = RemRed xs <> RemRed ys
RemRed xs <> RemRed ys = RemRed (xs <> ys)
instance Monoid RemRed where
mempty = RemRed Seq.empty
mappend = (<>)
removePairs xs = toList (unRemRed (foldMap (RemRed . singleton) xs))