给定一个列表，如何仅对每两个元素满足二元谓词的子列表执行一些转换？
Given a list, how can I perform some transformation only on sub-lists whose each two elements satisfy a binary predicate?
(在我的实际用例中，我有一个类型为 [SomeType]、SomeType 的列表，它具有有限数量的构造函数，全部为零；在下文中，我将使用 String而不是 [SomeType] 并且只使用 4 Chars，以简化一点。）
我有一个这样的列表 "aaassddddfaaaffddsssadddssdffsdf"，其中每个元素可以是 'a'、's'、'd'、'f' 之一，我想要对非 a 的每个连续序列做一些进一步处理，假设将它们转为大写并反转序列，从而获得 "aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"。 （我添加了反向要求，以明确处理同时涉及 所有 个连续的非 'a'-s。)
要将每个子 String 转为大写，我可以使用这个：
func :: String -> String
func = reverse . map Data.Char.toUpper
但是我如何 运行 func 仅在非 'a' 的子 String 上？
我的第一个想法是Data.List.groupBy可能有用，整体解决方案可能是：
concat $ map (\x -> if head x == 'a' then x else func x)
$ Data.List.groupBy ((==) `on` (== 'a')) "aaassddddfaaaffddsssadddssdffsdf"
然而，这个解决方案并不能说服我，因为我在分组时（对我来说这似乎很好而且不可避免）和决定是否应该将组转为大写时都使用 == 'a'。
我正在寻求有关如何以最佳方式完成这项小任务的建议。
如果我们需要记住 'a' 和其余的区别，让我们将它们放在 Either 的不同分支中。事实上，现在让我们定义一个新类型：
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Bifoldable
import Data.Char
import Data.List
newtype Bunched a b = Bunched [Either a b] deriving (Functor, Foldable)
instance Bifunctor Bunched where
bimap f g (Bunched b) = Bunched (fmap (bimap f g) b)
instance Bifoldable Bunched where
bifoldMap f g (Bunched b) = mconcat (fmap (bifoldMap f g) b)
fmap 将让我们完成 non-separators。 fold will return the concatenation of the non-separators, bifold 将 return 所有内容串联起来。当然，我们可以定义与 Foldable 和 Bifoldable 无关的单独函数，但为什么要避免已经存在的抽象？
要拆分列表，我们可以使用 unfoldr that alternately searches for as and non-as with the span 函数：
splitty :: Char -> String -> Bunched String String
splitty c str = Bunched $ unfoldr step (True, str)
where
step (_, []) = Nothing
step (True, span (== c) -> (as, ys)) = Just (Left as, (False, ys))
step (False, span (/= c) -> (xs, ys)) = Just (Right xs, (True, ys))
投入使用：
ghci> bifold . fmap func . splitty 'a' $ "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
注意：Bunched实际上与bifunctors包中的Tannen [] Either相同，如果你不介意额外的依赖的话.
您可以在 分组之前通过谓词 对列表元素进行分类。请注意，我颠倒了谓词的含义以指示哪些元素受到转换，而不是哪些元素被保留。
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow ((&&&))
import Data.Function (on)
import Data.Monoid (First(..))
mapSegmentsWhere
:: forall a. (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
mapSegmentsWhere p f
= concatMap (applyMatching . sequenceA) -- [a]
. groupBy ((==) `on` fst) -- [[(First Bool, a)]]
. map (First . Just . p &&& id) -- [(First Bool, a)]
where
applyMatching :: (First Bool, [a]) -> [a]
applyMatching (First (Just matching), xs)
= applyIf matching f xs
applyIf :: forall a. Bool -> (a -> a) -> a -> a
applyIf condition f
| condition = f
| otherwise = id
使用示例：
> mapSegmentsWhere (/= 'a') (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
这里我使用 First 幺半群和 sequenceA 来合并从 [(Bool, a)] 到 (Bool, [a]) 的相邻匹配元素的列表，但你也可以使用一些东西喜欢 map (fst . head &&& map snd)。如果你不想写类型签名，你也可以跳过 ScopedTypeVariables；为了清楚起见，我只是将它们包括在内。
这是一个简单的解决方案 - 下面的函数 process - 只需要定义两个函数 isSpecial 和 func。给定类型 SomeType 的构造函数，isSpecial 确定它是否是构成特殊子列表的那些构造函数之一。函数 func 是您在问题中包含的函数；它定义了特殊子列表应该发生什么。
下面的代码用于字符列表。只需更改 isSpecial 和 func 即可使其适用于您的构造函数列表。
isSpecial c = c /= 'a'
func = reverse . map toUpper
turn = map (\x -> ([x], isSpecial x))
amalgamate [] = []
amalgamate [x] = [x]
amalgamate ((xs, xflag) : (ys, yflag) : rest)
| xflag /= yflag = (xs, xflag) : amalgamate ((ys, yflag) : rest)
| otherwise = amalgamate ((xs++ys, xflag) : rest)
work = map (\(xs, flag) -> if flag then func xs else xs)
process = concat . work . amalgamate . turn
让我们在您的示例中尝试一下：
*Main> process "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
一次应用一个函数，显示所采取的中间步骤：
*Main> turn "aaassddddfaaaffddsssadddssdffsdf"
[("a",False),("a",False),("a",False),("s",True),("s",True),("d",True),
("d",True),("d",True),("d",True),("f",True),("a",False),("a",False),
("a",False),("f",True),("f",True),("d",True),("d",True),("s",True),
("s",True),("s",True),("a",False),("d",True),("d",True),("d",True),
("s",True),("s",True),("d",True),("f",True),("f",True),("s",True),
("d",True),("f",True)]
*Main> amalgamate it
[("aaa",False),("ssddddf",True),("aaa",False),("ffddsss",True),
("a",False),("dddssdffsdf",True)]
*Main> work it
["aaa","FDDDDSS","aaa","SSSDDFF","a","FDSFFDSSDDD"]
*Main> concat it
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
这里还有其他答案，但我认为他们对迭代抽象过于兴奋。手动递归，交替获取匹配谓词的东西和不匹配谓词的东西，使这个问题非常简单：
onRuns :: Monoid m => (a -> Bool) -> ([a] -> m) -> ([a] -> m) -> [a] -> m
onRuns p = go p (not . p) where
go _ _ _ _ [] = mempty
go p p' f f' xs = case span p xs of
(ts, rest) -> f ts `mappend` go p' p f' f rest
在 ghci 中尝试：
Data.Char> onRuns ('a'==) id (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
我们可以按照您的描述一步一步地做，得到一个清晰简单的最小代码，我们以后可以轻松阅读和理解：
foo :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
foo p f xs = [ a
| g <- groupBy ((==) `on` fst)
[(p x, x) | x <- xs] -- [ (True, 'a'), ... ]
, let (t:_, as) = unzip g -- ( [True, ...], "aaa" )
, a <- if t then as else (f as) ] -- final concat
-- unzip :: [(b, a)] -> ([b], [a])
我们将列表分成相同的 p 段，并在 unzip 的帮助下解压每个组。尝试一下：
> foo (=='a') reverse "aaabcdeaa"
"aaaedcbaa"
所以不，使用 == 'a' 是 可以避免的，因此不是特别好，当我们只需要布尔值相等时，就会对您的数据类型引入不必要的约束。
(在我的实际用例中，我有一个类型为 [SomeType]、SomeType 的列表，它具有有限数量的构造函数，全部为零；在下文中，我将使用 String而不是 [SomeType] 并且只使用 4 Chars，以简化一点。）
我有一个这样的列表 "aaassddddfaaaffddsssadddssdffsdf"，其中每个元素可以是 'a'、's'、'd'、'f' 之一，我想要对非 a 的每个连续序列做一些进一步处理，假设将它们转为大写并反转序列，从而获得 "aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"。 （我添加了反向要求，以明确处理同时涉及 所有 个连续的非 'a'-s。)
要将每个子 String 转为大写，我可以使用这个：
func :: String -> String
func = reverse . map Data.Char.toUpper
但是我如何 运行 func 仅在非 'a' 的子 String 上？
我的第一个想法是Data.List.groupBy可能有用，整体解决方案可能是：
concat $ map (\x -> if head x == 'a' then x else func x)
$ Data.List.groupBy ((==) `on` (== 'a')) "aaassddddfaaaffddsssadddssdffsdf"
然而，这个解决方案并不能说服我，因为我在分组时（对我来说这似乎很好而且不可避免）和决定是否应该将组转为大写时都使用 == 'a'。
我正在寻求有关如何以最佳方式完成这项小任务的建议。
如果我们需要记住 'a' 和其余的区别，让我们将它们放在 Either 的不同分支中。事实上，现在让我们定义一个新类型：
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Bifoldable
import Data.Char
import Data.List
newtype Bunched a b = Bunched [Either a b] deriving (Functor, Foldable)
instance Bifunctor Bunched where
bimap f g (Bunched b) = Bunched (fmap (bimap f g) b)
instance Bifoldable Bunched where
bifoldMap f g (Bunched b) = mconcat (fmap (bifoldMap f g) b)
fmap 将让我们完成 non-separators。 fold will return the concatenation of the non-separators, bifold 将 return 所有内容串联起来。当然，我们可以定义与 Foldable 和 Bifoldable 无关的单独函数，但为什么要避免已经存在的抽象？
要拆分列表，我们可以使用 unfoldr that alternately searches for as and non-as with the span 函数：
splitty :: Char -> String -> Bunched String String
splitty c str = Bunched $ unfoldr step (True, str)
where
step (_, []) = Nothing
step (True, span (== c) -> (as, ys)) = Just (Left as, (False, ys))
step (False, span (/= c) -> (xs, ys)) = Just (Right xs, (True, ys))
投入使用：
ghci> bifold . fmap func . splitty 'a' $ "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
注意：Bunched实际上与bifunctors包中的Tannen [] Either相同，如果你不介意额外的依赖的话.
您可以在 分组之前通过谓词 对列表元素进行分类。请注意，我颠倒了谓词的含义以指示哪些元素受到转换，而不是哪些元素被保留。
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow ((&&&))
import Data.Function (on)
import Data.Monoid (First(..))
mapSegmentsWhere
:: forall a. (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
mapSegmentsWhere p f
= concatMap (applyMatching . sequenceA) -- [a]
. groupBy ((==) `on` fst) -- [[(First Bool, a)]]
. map (First . Just . p &&& id) -- [(First Bool, a)]
where
applyMatching :: (First Bool, [a]) -> [a]
applyMatching (First (Just matching), xs)
= applyIf matching f xs
applyIf :: forall a. Bool -> (a -> a) -> a -> a
applyIf condition f
| condition = f
| otherwise = id
使用示例：
> mapSegmentsWhere (/= 'a') (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
这里我使用 First 幺半群和 sequenceA 来合并从 [(Bool, a)] 到 (Bool, [a]) 的相邻匹配元素的列表，但你也可以使用一些东西喜欢 map (fst . head &&& map snd)。如果你不想写类型签名，你也可以跳过 ScopedTypeVariables；为了清楚起见，我只是将它们包括在内。
这是一个简单的解决方案 - 下面的函数 process - 只需要定义两个函数 isSpecial 和 func。给定类型 SomeType 的构造函数，isSpecial 确定它是否是构成特殊子列表的那些构造函数之一。函数 func 是您在问题中包含的函数；它定义了特殊子列表应该发生什么。
下面的代码用于字符列表。只需更改 isSpecial 和 func 即可使其适用于您的构造函数列表。
isSpecial c = c /= 'a'
func = reverse . map toUpper
turn = map (\x -> ([x], isSpecial x))
amalgamate [] = []
amalgamate [x] = [x]
amalgamate ((xs, xflag) : (ys, yflag) : rest)
| xflag /= yflag = (xs, xflag) : amalgamate ((ys, yflag) : rest)
| otherwise = amalgamate ((xs++ys, xflag) : rest)
work = map (\(xs, flag) -> if flag then func xs else xs)
process = concat . work . amalgamate . turn
让我们在您的示例中尝试一下：
*Main> process "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
一次应用一个函数，显示所采取的中间步骤：
*Main> turn "aaassddddfaaaffddsssadddssdffsdf"
[("a",False),("a",False),("a",False),("s",True),("s",True),("d",True),
("d",True),("d",True),("d",True),("f",True),("a",False),("a",False),
("a",False),("f",True),("f",True),("d",True),("d",True),("s",True),
("s",True),("s",True),("a",False),("d",True),("d",True),("d",True),
("s",True),("s",True),("d",True),("f",True),("f",True),("s",True),
("d",True),("f",True)]
*Main> amalgamate it
[("aaa",False),("ssddddf",True),("aaa",False),("ffddsss",True),
("a",False),("dddssdffsdf",True)]
*Main> work it
["aaa","FDDDDSS","aaa","SSSDDFF","a","FDSFFDSSDDD"]
*Main> concat it
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
这里还有其他答案，但我认为他们对迭代抽象过于兴奋。手动递归，交替获取匹配谓词的东西和不匹配谓词的东西，使这个问题非常简单：
onRuns :: Monoid m => (a -> Bool) -> ([a] -> m) -> ([a] -> m) -> [a] -> m
onRuns p = go p (not . p) where
go _ _ _ _ [] = mempty
go p p' f f' xs = case span p xs of
(ts, rest) -> f ts `mappend` go p' p f' f rest
在 ghci 中尝试：
Data.Char> onRuns ('a'==) id (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
我们可以按照您的描述一步一步地做，得到一个清晰简单的最小代码，我们以后可以轻松阅读和理解：
foo :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
foo p f xs = [ a
| g <- groupBy ((==) `on` fst)
[(p x, x) | x <- xs] -- [ (True, 'a'), ... ]
, let (t:_, as) = unzip g -- ( [True, ...], "aaa" )
, a <- if t then as else (f as) ] -- final concat
-- unzip :: [(b, a)] -> ([b], [a])
我们将列表分成相同的 p 段，并在 unzip 的帮助下解压每个组。尝试一下：
> foo (=='a') reverse "aaabcdeaa"
"aaaedcbaa"
所以不，使用 == 'a' 是 可以避免的，因此不是特别好，当我们只需要布尔值相等时，就会对您的数据类型引入不必要的约束。