根据 Haskell 列表中 n 的条件删除元素 n-1、n 和 n+1

Question

假设我有一个从2 到20 的所有整数的列表。

[2 .. 20]

我想使用函数f x 过滤列表（或者它是谓词？我不太习惯 Haskell 编程中使用的所有术语）。如果n 位置的元素对于这个函数f 等于true，我想删除位置n-1、n 和n+1 的元素。

示例： 假设列表[2 .. 20] 中位置4 的元素等于6，对于函数f 等于true。然后我想删除位置3、4和5的元素，它们分别等于5、6和7。 所以我的最终列表如下所示：

[2,3,4,8,9,10,11,12,13,14,15,16,17,18,19,20]

我是一个没有经验的 Haskell 程序员，只是为了好玩。我曾考虑过使用 lambda 函数作为谓词，但我不太确定如何去做。我还考虑过使用像remove xs ys 这样的函数来删除xs 中的所有元素，这也是ys 的元素，但我也不知道该怎么做。

任何帮助将不胜感激！

编辑：我意识到删除两个相邻元素是错误的，以产生我想要的结果。此外，最好将受影响元素（位置n 和n-1 的元素）的值更改为0，或以其他方式标记/标记它们，而不是完全删除它们。这样做的原因是我想继续“删除”元素，直到列表不再有任何适合谓词（及其前面的元素）的元素。我只想从原始列表中“删除”它们。 由于我的方法与原来的问题相比发生了很大变化，我将发布一个新问题来反映我的新方法。我要感谢您的所有回复，我从您的回答中学到了很多东西。谢谢！

编辑 2：这是我的新问题：Remove elements at positions n and n-1 in a Haskell list, when n fits a predicate

Answer 1

这是一种方法，但我相信还有更优雅的方法。

方法是首先将我们的列表[a] 映射到三元组列表[(Maybe a, a, Maybe a)]。 （Maybe 发挥作用是因为第一个和最后一个元素分别缺少前任/继任者。）

然后我们可以根据我们在这个三元组类型上构造的谓词adjacentF 来实现过滤器。 （请注意，与标准 filter 相比，您要求的过滤器是向后的——当谓词为真时，您希望 删除 东西。）

preprocess :: [a] -> [(Maybe a, a, Maybe a)]
preprocess xs = zip3 (beforeXs xs) xs (afterXs xs)

beforeXs :: [a] -> [Maybe a]
beforeXs xs = Nothing : (map Just xs)

afterXs :: [a] -> [Maybe a]
afterXs xs = concat [(map Just (tail xs)), [Nothing]]

middle3 :: (a, b, c) -> b
middle3 (_,x,_) = x

myfilter :: (a -> Bool) -> [a] -> [a]
myfilter f xs = map middle3 $ filter (not . adjacentF) (preprocess xs)
    where
        maybeF = maybe False f
        adjacentF (x,y,z) = (maybeF x) || (f y) || (maybeF z)

这应该会给出一般预期的结果：

*Main> myfilter (==20) [1..20]
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18]
*Main> myfilter (==1) [1..20]
[3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
*Main> myfilter (==5) [1..20]
[1,2,3,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
*Main> myfilter (\x -> x >= 12 && x <= 14) [1..20]
[1,2,3,4,5,6,7,8,9,10,16,17,18,19,20]
*Main> myfilter even [1..20]
[]

Answer 2

您可以只对多个元素进行模式匹配，然后将过滤器应用于中间元素。

eitherside :: (Int->Bool) -> [Int] -> [Int]
eitherside f (i1:i2:i3:is) = if (f i2) 
    then eitherside f is 
    else i1 : (eitherside f (i2:i3:is))
eitherside f is = is
*Main> eitherside (==4) [1..10]
[1,2,6,7,8,9,10]
*Main> eitherside (==5) [1..10]
[1,2,3,7,8,9,10]
*Main> eitherside (==6) [1..10]
[1,2,3,4,8,9,10]

不喜欢这个（我原来的帖子）：

eitherside :: (Int->Bool) -> [Int] -> [Int]
eitherside f (i1:i2:i3:is) = if (f i2) 
    then eitherside f is 
    else [i1,i2,i3] ++ (eitherside f is)
eitherside f is = is
*Main> eitherside (==5) [1..10]
[1,2,3,7,8,9,10]

这个坏的恰好为 5 工作，但为 6 失败，因为我在“else”分支中跳过它。

Answer 3

我使用小自制列表拉链实现的解决方案：

-- List zipper (think of this as a standard library routine):
data LZ a = LZ [a] a [a] deriving (Show)

listToLZ :: [a] -> LZ a
listToLZ (h:t) = LZ [] h t

lzToList :: LZ a -> [a]
lzToList (LZ l p r) = reverse l ++ p:r

moveRight, remLeft, remRight, remHere :: LZ a -> LZ a
moveRight (LZ l t (t':r)) = LZ (t:l) t' r
remLeft (LZ l p r) = LZ (tail l) p r
remRight (LZ l p r) = LZ l p (tail r)
remHere (LZ l _ (p:r)) = LZ l p r

-- And there's how one use this:
-- <business code>
traverse :: (a -> Bool) -> LZ a -> LZ a
traverse _ a@(LZ _ _ []) = a
traverse pr a@(LZ _ p _) 
   | pr p = traverse pr $ remHere $ remRight $ remLeft a
   | True = traverse pr $ moveRight a
-- </business code>

main = let
  l = [1..20]
  l' = lzToList $ traverse (==4) $ listToLZ l
in
  print l'

输出：

[1,2,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]

Answer 4

这是一个完成工作的解决方案，尽管它可能不是最有效的：

f p l = map snd $ filter (flip notElem indices . fst) l'
  where
    indices = concat [[i - 1, i, i + 1] | (i, _) <- filter (p . snd) l']
    l' = zip [0..] l

或者使用来自Data.List 的findIndices 更短一点：

f p l = map snd $ filter (flip notElem indices . fst) $ zip [0..] l
  where indices = concat [[i - 1, i, i + 1] | i <- findIndices p l]

测试：

*Main> f (\x -> x == 6 || x == 7) [2..20]
[2,3,4,9,10,11,12,13,14,15,16,17,18,19,20]

Answer 5

您可以转置问题并查看保留元素的条件：即如果谓词在位置n-1、n 和@ 位置为False，则保留位置n 的元素987654325@.

这指向以下方法：

keep3 :: (a -> Bool) -> [a] -> [a]
keep3 f xs = go xs bs
  where b0 = map f xs
        b1 = (tail b0) ++ [False]
        b2 = False : b0
        bs = zipWith (||) (zipWith (||) b0 b1) b2
        go [] _ = []
        go (x:xs) (b:bs) = if (not b) then x : go xs bs else go xs bs

一些解释点：

• b0 是一个列表，其长度与元素列表的长度相同，其中第 n 个值是在列表的第 n 个元素上评估的谓词的值。
• b1 与 b0 相同，但向左移动了一位；所以它的第 n 个值是在列表的 n+1-th 元素上评估的谓词
• b2 与b0 相同，但右移一位；所以它的第 n 个值是在列表的 n-1-th 元素上评估的谓词
• bs 是列表 b0、b1、b2 按元素完成的逻辑或，与 xs 长度相同的布尔值列表也是如此。 bs 的第 n 个元素决定是否应保留 xs 的第 n 个元素。
• 请注意，对于列表xs 的每个元素，谓词只计算一次。我也认为边界情况处理得当。

Answer 6

解决此问题的一种方法是捕捉列表中项目的邻域的概念。

-- A neighborhood of a point in a list 
data Neighborhood a = Neighborhood {
    predecessors :: ![a],
    point :: !a,
    successors :: ![a]
} deriving Show

我们可以通过在遍历列表时累积前辈来轻松计算列表的邻域：

-- On long lists or infinite stream, this will leak memory (it keeps all the predecessors in memory)
neighborhoods :: [a] -> [Neighborhood a]
neighborhoods = neighborhoods' []
    where
        neighborhoods' _ [] = []
        neighborhoods' ps (x:ss) = (Neighborhood ps x ss):(neighborhoods' (x:ps) ss)

这些邻域将包括每个列表项的所有前任和后继项目。能够考虑一个较小的社区within 每个社区的小半径会很方便。能够enumerate附近也很方便。 （interleave的定义如下，它以交替的顺序访问列表。）

within :: Int -> Neighborhood a -> Neighborhood a
within r n = Neighborhood (take r . predecessors $ n) (point n) (take r . successors $ n)

enumerate :: Neighborhood a -> [a]
enumerate n = (point n):(interleave (successors n) (predecessors n))

现在我们可以很容易地询问我们想要的东西——半径为 1 的邻域不包含不允许值的项目。 （pows 和 log2 定义如下/）

main = do
    let disallowed = \x -> x == pow2s !! log2 x
    print . map point . filter (not . any disallowed . enumerate . within 1) . neighborhoods $ [2..20]

如果我们要以增量方式处理非常大的列表，那么让垃圾收集器从附近很远的地方收集前辈会很有用。这将是一个有效的版本：

neighborhoodsRadius n = map (within n) . neighborhoods

为了获得这种效率，我们需要使邻域前辈的评估严格发生。在下面的代码中，严格评估是通过在遍历列表时使用 Data.Sequence.Seq 作为累加器来完成的。

下面是完整的运行代码：

module Main (
    pow2s,
    log2,
    main,

    interleave,
    Neighborhood (..),
    within,
    enumerate,  
    neighborhoods,
    neighborhoodsRadius,
) where

import qualified Data.Sequence as Seq
import Data.Sequence ((<|))
import Data.Foldable (toList)

-- Interleave lists
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x:(interleave ys xs)


-- A neighborhood of a point in a list 
data Neighborhood a = Neighborhood {
    predecessors :: ![a],
    point :: !a,
    successors :: ![a]
} deriving Show

within :: Int -> Neighborhood a -> Neighborhood a
within r n = Neighborhood (take r . predecessors $ n) (point n) (take r . successors $ n)

enumerate :: Neighborhood a -> [a]
enumerate n = (point n):(interleave (successors n) (predecessors n))

-- On long lists or infinite stream, this will leak memory (it keeps all the predecessors in memory)
neighborhoods :: [a] -> [Neighborhood a]
neighborhoods = neighborhoods' []
    where
        neighborhoods' _ [] = []
        neighborhoods' ps (x:ss) = (Neighborhood ps x ss):(neighborhoods' (x:ps) ss)

-- This is better on long lists or infinite stream as it will cull the predecessors before recursing
neighborhoodsRadius :: Int -> [a] -> [Neighborhood a]
neighborhoodsRadius radius = neighborhoods' Seq.empty
    where
        neighborhoods' _ [] = []
        neighborhoods' ps (x:ss) =
            (Neighborhood (toList radiusPs) x radiusSs):(neighborhoods' (x <| radiusPs) ss)
                where
                    radiusPs = Seq.take radius ps
                    radiusSs = take radius ss

-- example
pow2s = iterate (*2) 1
log2 n = length . takeWhile (< n) $ pow2s

main :: IO ()
main = do
    let disallowed = \x -> x == pow2s !! log2 x
    print . map point . filter (not . any disallowed . enumerate . within 1) . neighborhoods $ [2..20]
    getLine
    let steps = map (print . point) . filter (not . any disallowed . enumerate) . neighborhoodsRadius 1 $ [2..]
    sequence_ steps