无限列表的交集

Question

我从可计算性理论知道可以取两个无限列表的交集，但我找不到在Haskell中表达它的方法。

一旦第二个列表无限大，传统方法就会失败，因为您将所有时间都花在了检查第一个列表中的不匹配元素上。

示例：

let ones = 1 : ones -- an unending list of 1s
intersect [0,1] ones

这永远不会产生 1，因为它永远不会停止检查 ones 元素 0。

一个成功的方法需要确保每个列表的每个元素都在有限的时间内被访问。

这可能是通过遍历两个列表，并花费大致相等的时间来检查每个列表中所有先前访问过的元素。

如果可能的话，我还希望有一种方法可以忽略列表中的重复项，因为偶尔需要这样做，但这不是必需的。

Answer 1

一个想法可能是使用递增边界。让我们先稍微放松一下这个问题：允许产生重复值。在这种情况下，您可以使用：

import Data.List (intersect)

intersectInfinite :: Eq a => [a] -> [a] -> [a]
intersectInfinite = intersectInfinite' 1
    where intersectInfinite' n = intersect (take n xs) (take n ys) ++ intersectInfinite' (n+1)

换句话说，我们声称：

A∩B = A₁∩B₁∪A₂∩B₂ ∪ ... ∪ ...

with A₁ 是包含 A 的 first i 个元素的集合（是的集合中没有顺序，但假设有某种顺序）。如果集合包含 less 个元素，则返回完整集合。

如果c在A（索引i）和B（在索引 j），c 将在段中发出（不是索引）max(i,j).

因此无论给定列表是否有限，这将始终生成一个无限列表（具有无限数量的重复项）。唯一的例外是当你给它一个空列表时，在这种情况下它将永远花费。尽管如此，我们在这里确保交叉点中的每个元素至少被发射一次。

使结果有限（如果给定的列表是有限的）

现在我们可以改进我们的定义了。首先我们做一个更高级的版本take，takeFinite（让我们先给出一个straight-forward，但不是很有效的定义）：

takeFinite :: Int -> [a] -> (Bool,[a])
takeFinite _ [] = (True,[])
takeFinite 0 _  = (False,[])
takeFinite n (x:xs) = let (b,t) = takeFinite (n-1) xs in (b,x:t)

现在我们可以迭代加深直到两个列表都到达末尾：

intersectInfinite :: Eq a => [a] -> [a] -> [a]
intersectInfinite = intersectInfinite' 1

intersectInfinite' :: Eq a => Int -> [a] -> [a] -> [a]
intersectInfinite' n xs ys | fa && fb = intersect xs ys
                           | fa = intersect ys xs
                           | fb = intersect xs ys
                           | otherwise = intersect xfa xfb ++ intersectInfinite' (n+1) xs ys
    where (fa,xfa) = takeFinite n xs
          (fb,xfb) = takeFinite n ys

鉴于两个列表都是有限的，这现在将终止，但仍会产生大量重复项。肯定有更多的方法可以解决这个问题。

Answer 2

这是一种方法。对于每个 x，我们制作一个可能列表，其中包含 Just x 仅在 x 出现在 ys 中。然后我们交织所有这些列表。

isect :: Eq a => [a] -> [a] -> [a]
isect xs ys = (catMaybes . foldr interleave [] . map matches) xs
  where
    matches x = [if x == y then Just x else Nothing | y <- ys]

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

也许可以使用某种更公平的交错来改进它 - 下面的例子已经很慢了，因为（我认为）它正在做指数级的工作。

> take 10 (isect [0..] [0,2..])
[0,2,4,6,8,10,12,14,16,18]

Answer 3

如果列表中的元素是有序的，那么你可以很容易地做到这一点。

intersectOrd :: Ord a => [a] -> [a] -> [a]
intersectOrd [] _ = []
intersectOrd _ [] = []
intersectOrd (x:xs) (y:ys) = case x `compare` y of
    EQ -> x : intersectOrd xs ys
    LT -> intersectOrd xs (y:ys)
    GT -> intersectOrd (x:xs) ys

Answer 4

使用 universe package's Cartesian product operator 我们可以这样写 one-liner:

import Data.Universe.Helpers

isect :: Eq a => [a] -> [a] -> [a]
xs `isect` ys = [x | (x, y) <- xs +*+ ys, x == y]
-- or this, which may do marginally less allocation
xs `isect` ys = foldr ($) [] $ cartesianProduct 
    (\x y -> if x == y then (x:) else id)
    xs ys

在 ghci 中尝试：

> take 10 $ [0,2..] `isect` [0,3..]
[0,6,12,18,24,30,36,42,48,54]

如果输入列表没有任何重复项，此实现将不会产生任何重复项；但如果他们这样做，您可以在调用 isect 之前或之后添加您最喜欢的 dup-remover。例如，对于 nub，您可以写成

> nub ([0,1] `isect` repeat 1)
[1

然后很好地加热你的计算机，因为如果它看起来足够深，它永远无法确定第二个列表中的某个地方可能没有 0。

这种方法比 David Fletcher 的方法快得多，产生的重复项少得多，产生新值的速度比 Willem Van Onsem 的方法快得多，并且不假设列表像自由泳那样排序（但因此在此类列表上要慢得多比自由式）。

Answer 5

还有另一种选择，利用 Control.Monad.WeightedSearch

import Control.Monad (guard)
import Control.Applicative
import qualified Control.Monad.WeightedSearch as W

我们首先定义在列表内部挖掘的成本。访问尾部要多花费 1 个单位。这将确保两个无限列表之间的公平调度。

eachW :: [a] -> W.T Int a
eachW = foldr (\x w -> pure x <|> W.weight 1 w) empty

那么，我们干脆忽略无限列表。

intersection :: [Int] -> [Int] -> [Int]
intersection xs ys = W.toList $ do
   x <- eachW xs
   y <- eachW ys
   guard (x==y)
   return y

使用 MonadComprehensions 更好：

intersection2 :: [Int] -> [Int] -> [Int]
intersection2 xs ys = W.toList [ y | x <- eachW xs, y <- eachW ys, x==y ]

Answer 6

解决方案

我最终使用了以下实现； David Fletcher 对答案稍作修改：

isect :: Eq a => [a] -> [a] -> [a]
isect [] = const [] -- don't bother testing against an empty list
isect xs = catMaybes . diagonal . map matches
    where matches y = [if x == y then Just x else Nothing | x <- xs]

这可以通过 nub 进行扩充以过滤掉重复项：

isectUniq :: Eq a => [a] -> [a] -> [a]
isectUniq xs = nub . isect xs

说明

行isect xs = catMaybes . diagonal . map matches

(map matches) ys 计算 xs 和 ys 元素之间的比较列表列表，其中列表索引指定 ys 和 [=14= 中的索引] 分别是：即 (map matches) ys !! 3 !! 0 表示 ys !! 3 与 xs !! 0 的比较，如果这些值不同，则为 Nothing。如果这些值相同，则该值将是 Just。

diagonals 接受一个列表列表和 returns 一个列表列表，其中第 n 个输出列表包含前 n 个列表中的每个元素。将其概念化的另一种方法是 (diagonals . map matches) ys !! n 包含元素之间的比较，这些元素在 xs 和 ys 中的索引总和为 n.
diagonal 只是 diagonals (diagonal = concat diagonals)

的平面版本

因此(diagonal . map matches) ys是xs和ys的元素比较的列表，其中元素大致按[=15的元素的索引之和排序=] 和 xs 进行比较；这意味着较早元素与较晚元素的比较具有与相互比较的中间元素相同的优先级。

(catMaybes . diagonal . map matches) ys 是仅包含两个列表中元素的列表，其中元素大致按所比较的两个元素的索引之和排序。

备注
(diagonal . map (catMaybes . matches)) ys 做 not 工作：catMaybes . matches 只在找到匹配时产生，而不是在没有匹配时也产生 Nothing，所以交错什么都不做分配工作。

相比之下，在所选解决方案中，Nothing 和 Just 值被 diagonal 交错意味着程序将注意力分配给 'searching' 多个不同的元素，而不是等待一个人成功；而如果 Nothing 值在交错之前被删除，程序可能会花费太多时间等待给定元素成功的无结果 'search'。

因此，我们会遇到与原问题相同的问题：当一个元素不匹配另一个列表中的任何元素时，程序会挂起；而所选的解决方案只会在未找到任何列表中任何元素的匹配项时挂起。

无限列表的交集

Intersection of infinite lists

haskell

list

infinite

解决方案

说明