如果条件为真，则合并多个列表

Question

我一直在努力解决这个问题，但似乎我缺乏 Haskell 经验无法让我通过它。我在 Stackoverflow 上找不到类似的问题（其中大多数与合并所有子列表有关，没有任何条件）

就这样吧。假设我有一个这样的列表：

[[1, 2, 3], [3, 5, 6], [20, 21, 22]]

如果某种条件为真，是否有一种有效的方法来合并列表？假设我需要合并至少共享一个元素的列表。例如，结果将是：

[[1, 2, 3, 3, 5, 6], [20, 21, 22]]

另一个例子（当所有列表都可以合并时）：

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

结果如下：

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

感谢您的帮助！

Answer 1

关于效率我不知道该说什么，但我们可以分解正在发生的事情并至少获得几个不同的功能。特定的功能可能是可优化的，但重要的是要明确需要什么。

让我重新表述这个问题：对于一些集合 X，一些二元关系 R，以及一些二元运算 +，产生一个集合 Q = {x+y | x in X, y in X, xRy}. 所以对于你的例子，我们可能有 X 是一组列表，R 是“xRy 当且仅当 x 和 y 中至少有一个元素”，和 + 是 ++。

一个简单的实现可能只是复制 set-builder 符号本身

shareElement :: Eq a => [a] -> [a] -> Bool
shareElement xs ys = or [x == y | x <- xs, y <- ys]

v1 :: (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [b]
v1 (?) (<>) xs = [x <> y | x <- xs, y <- xs, x ? y]

那么p = v1 shareElement (++) :: Eq a => [[a]] -> [[a]] 可能会实现你想要的。除非它可能没有。

Prelude> p [[1], [1]]
[[1,1],[1,1],[1,1],[1,1]]

最明显的问题是我们得到了四个副本：两个来自将列表与其自身合并，两个来自“双向”合并列表。出现问题是因为List 与Set 不同，所以我们不能杀死唯一性。当然，这很容易解决，我们将在任何地方使用Set

import Data.Set as Set

v2 :: (a -> a -> Bool) -> (a -> a -> b) -> Set.Set a -> Set.Set b
v2 (?) (<>) = Set.fromList . v1 (?) (<>) . Set.toList

所以我们可以再试一次，p = v2 (shareElementonSet.toList) Set.union 与

Prelude Set> p $ Set.fromList $ map Set.fromList [[1,2], [2,1]]
fromList [fromList [1,2]]

这似乎有效。请注意，我们必须“通过”List，因为由于 Ord 的约束，Set 不能成为 Monad 或 Applicative 的实例。

我还注意到Set 中有很多丢失的行为。例如，当我们的关系是对称的时，我们要么丢弃列表中的订单信息，要么不得不同时处理x <> y 和y <> x。

一些更方便的版本可以写成这样

v3 :: Monoid a => (a -> a -> Bool) -> [a] -> [a]
v3 r = v2 r mappend

如果我们假设关系是，比如说，从那时起的相等关系，而不是O(n^2) 操作，我们可以在O(nd) 中进行操作，其中d 是分区数，则可以构建更有效的关系关系的（陪集）。

一般来说，这是一个非常有趣的问题。

Answer 2

刚好在这里写了类似的东西：Finding blocks in arrays

你可以这样修改（虽然我不太确定效率）：

import Data.List (delete, intersect) 

example1 = [[1, 2, 3], [3, 5, 6], [20, 21, 22]]
example2 = [[1, 2], [2, 3], [3, 4]]

objects zs = map concat . solve zs $ [] where
  areConnected x y = not . null . intersect x $ y
  solve []     result = result
  solve (x:xs) result =
    let result' = solve' xs [x]
    in solve (foldr delete xs result') (result':result) where
  solve' xs result =
    let ys = filter (\y -> any (areConnected y) result) xs
    in if null ys 
          then result
          else solve' (foldr delete xs ys) (ys ++ result)

输出：

*Main> objects example1
[[20,21,22],[3,5,6,1,2,3]]

*Main> objects example2
[[3,4,2,3,1,2]]