如何用惯用的方式编写这个函数？

Question

我正在寻找一个函数，它可以在列表的元素上测试谓词，为每个满足谓词的元素创建一个新列表，并将函数仅应用于该元素。

例子：

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction = ...

let ys = someFunction isOdd (* 2) [1..10]
    {- ys == [[2, 2, 3, 4, 5,  ...],
              [1, 2, 6, 4, 5,  ...],
              [1, 2, 3, 4, 10, ...],
              ...] -}

在ys中，第一个列表等于原来的列表，除了第一个满足谓词的元素，乘以2。第二个列表也等于原始列表，除了第三个元素，依此类推。

我已经能够通过获取满足谓词的值的索引然后通过索引映射来编写这样的函数。但是，这似乎不是很实用，我希望看到一种更惯用的方法。

Answer 1

您可以从标准或应有的部分组装此功能。接受的答案有关于拉链的正确线索。我的回答about differentiation and comonads给出了相关操作的一般处理，但我在这里具体说一下。

我将“一个元素洞的列表”的类型定义如下：

data Bwd x = B0 | Bwd x :< x deriving Show
type HoleyList x = (Bwd x, [x])

严格来说，我不需要引入反向列表来做到这一点，但如果我必须在脑海中扭转事情，我很容易混淆。 （碰巧HoleyList 是[] 的形式派生词。）

我现在可以在其上下文中定义什么是列表元素。

type InContext x = (HoleyList x, x)

这个想法是该对的第二个组件属于后向列表和前向列表之间。我可以定义将列表重新组合在一起的函数（在通用处理中称为upF。）

plug :: InContext x -> [x]
plug ((B0, xs), y)      = y : xs
plug ((xz :< x, xs), y) = plug ((xz, y : xs), x)

我还可以定义提供所有方法来拆分列表的函数（通常是downF）。

selections :: [x] -> [InContext x]
selections = go B0 where
  go xz [] = []
  go xz (x : xs) = ((xz, xs), x) : go (xz :< x) xs

注意

map snd  (selections xs) = xs 
map plug (selections xs) = map (const xs) xs

现在我们很高兴遵循 Bartek 的食谱。

selectModify :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
selectModify p f = map (plug . (id *** f)) . filter (p . snd) . selections

即：通过测试过滤选择，将函数应用于焦点元素，然后重新组合在一起。如果你有拉链设备，它是单线的，它应该适用于任何可微的函子，而不仅仅是列表！大功告成！

> selectModify ((1 ==) . (`mod` 2)) (2*) [1..10]
[[2,2,3,4,5,6,7,8,9,10]
,[1,2,6,4,5,6,7,8,9,10]
,[1,2,3,4,10,6,7,8,9,10]
,[1,2,3,4,5,6,14,8,9,10]
,[1,2,3,4,5,6,7,8,18,10]]

Answer 2

怎么样：

从列表开始：

[1,2,3,4]

复制列表 n 次，n 为其大小 (:: [[]])：

[
 [1,2,3,4],
 [1,2,3,4],
 [1,2,3,4],
 [1,2,3,4]
]

在每个元素上拆分列表（或多或少“对角线”）（:: [([], [])]）：

[
 ([],[1,2,3,4]),
 ([1],[2,3,4]),
 ([1,2],[3,4]),
 ([1,2,3],[4])
]

过滤掉head . snd 不满足你的谓词的行

[
 ([],    [1,2,3,4]),
 ([1,2], [3,4])
]

将你的函数应用于剩余的磁头

[
 ([],    [2,2,3,4])
 ([1,2], [6,4]),
]

将这些对串联起来

[
 [2,2,3,4],
 [1,2,6,4]
]

Answer 3

您可以使用手指（例如 zipper :D 将手指移到每个项目上 :D 就像阅读时一样）

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction check f xs = r [] xs
  where r _  []     = []
        r ps (y:ys) = let rs = r (ps ++ [y]) ys
                      in  if check y then [ps ++ [f y] ++ ys] ++ rs
                                     else rs

r 函数采用ps“已处理元素”和(y:ys)“待处理元素”。

如果您需要线性成本（ps ++ [y] 操作，请使用 cuadratic）使用高效的尾部插入结构。

使用splitAt你可以写

someFunction check f xs = map (\(a,(x:b)) -> a ++ [f x] ++ b) $
                          filter (check.head.snd)
                          [splitAt n xs | n <- [0..length xs - 1]]

或者使用列表推导

someFunction check f xs =
    [ a ++ [f x] ++ b | n <- [0..length xs - 1]
                      , let (a, (x:b)) = splitAt n xs
                      , check x]

使用@chi 建议的zip 解决方案采用线性成本（生成列表，最终为 O(n^2)）

someFunction check f xs = 
    [ a ++ [f x] ++ b | (a, (x:b)) <- init $ zip (inits xs) (tails xs)
                      , check x]

最后（？）@ØrjanJohansen 注意删除init $（我保留了两个版本，我认为这是一个很好的例子）

避免init $

someFunction check f xs = 
    [ a ++ [f x] ++ b | (a, (x:b)) <- zip (inits xs) (tails xs)
                      , check x]

最后一个(xs, []) "zipped" 元素被列表理解避免了，@ØrjanJohansen 指出了here 它是如何翻译的

[e | p <- l, Q] = let ok p = [e | Q]
                      ok _ = []
                  in concatMap ok l

（感谢@WillNess）

Answer 4

查看此处发布的所有不错且大多花哨的解决方案（包括@josejuan 的最后一个基于zip 的解决方案，这基本上是我自己匆忙使用的成语），我不禁觉得列表是缺少真正的直接，但仍然是使用显式、惰性递归的惯用解决方案——如果someFunction 是标准函数，您可能会在标准库中看到这种代码。所以这是一个版本（包括你也会看到的go worker 包装）：

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction p f xs = go xs where
    go [] = []
    go (x:xs)
      | p x         = (f x : xs) : rest
      | otherwise   = rest
      where
        rest = map (x :) (go xs)