Question

我对Haskell相对较新，但我试图通过阅读和尝试解决Project Euler上的问题来学习。我目前正在尝试实现一个函数，它接受一个无限的整数列表，并返回所述列表中元素的成对和的有序列表。我真的在寻找解决我所面临的具体问题的方法，而不是针对不同策略或方法的建议，但这些也是受欢迎的，因为编写程序并不意味着知道如何实施策略，而是选择最好的战略可用。

我的方法依赖于遍历无限生成器的无限列表并按顺序检索元素，其中有几个数学属性可用于实现我的解决方案。

如果我试图获得自然数的成对和的序列，例如，这将是我的代码：

myList :: [Integer]
myList = [1..]

myGens :: [[Integer]]
myGens = gens myList
    where
        gens = \xs -> map (\x -> [x+y|y<-(dropWhile (<x) xs)]) xs

无论使用的数字集如何，只要它已排序，以下条件成立：

∀i≥0，head (gens xs !! i) == 2*(myList !! i)
∀i，j，k≥0，l> 0，(((gens xs) !! i) !! j) < (((gens xs) !! i+k) !! j+l)

第二个条件的特殊情况是：

∀i，j≥0，(((gens xs) !! i) !! j) < (((gens xs) !! i+1) !! j)
∀i，j≥0，k> 0，(((gens xs) !! i) !! j) < (((gens xs) !! i+k) !! j)

以下是我要修改的特定代码：

stride :: [Integer] -> [Int] -> [[Integer]] -> [Integer]
stride xs cs xss = x : stride xs counts streams
        where
            (x,i) = step xs cs xss
            counts = inc i cs
            streams = chop i xss

step :: [Integer] -> [Int] -> [[Integer]] -> (Integer,Int)
step xs cs xss = pace xs (defer cs xss)

pace :: [Integer] -> [(Integer,Int)] -> (Integer,Int)
pace hs xs@((x,i):xt) = minim (x,i) hs xt
    where
        minim :: (Integer,Int) -> [Integer] -> [(Integer,Int)] -> (Integer,Int)
        minim m _ [] = m
        minim m@(g,i) hs (y@(h,n):ynt) | g > h && 2*(hs !! n) > h = y
                                       | g > h = minim y hs ynt
                                       | 2*(hs !! n) > g = m
                                       | otherwise = minim m hs ynt


defer :: [Int] -> [[a]] -> [(a,Int)]
defer cs xss = (infer (zip cs (zip (map head xss) [0..])))

infer :: [(Int,(a,Int))] -> [(a,Int)]
infer [] = []
infer ((c,xi):xis) | c == 0 = xi:[]
                   | otherwise = xi:(infer (dropWhile (\(p,(q,r)) -> p>=c) xis))

我使用的问题集具有多个不同对产生相同总和的属性。我想要一种有效的方法来同时处理所有重复元素，以避免计算所有成对总和达到N的成本增加，因为如果M是重复数，则需要M次测试。

有人有任何建议吗？

编辑：

我对代码进行了一些更改，与所建议的内容无关，并希望得到有关我原始代码，修订后的代码和目前提案的相对效率的反馈。

stride :: [Integer] -> [Int] -> [[Integer]] -> [Integer]
stride xs cs xss = x : stride xs counts streams
where
    (x,is) = step xs cs xss
    counts = foldr (\i -> inc i) cs is
    streams = foldr (\i -> chop i) xss is

step :: [Integer] -> [Int] -> [[Integer]] -> (Integer,[Int])
step xs cs xss = pace xs (defer cs xss)

pace :: [Integer] -> [(Integer,Int)] -> (Integer,[Int])
pace hs xs@((x,i):xt) = minim (x,(i:[])) hs xt
    where
    minim :: (Integer,[Int]) -> [Integer] -> [(Integer,Int)] -> (Integer,[Int])
    minim m _ [] = m
    minim m@(g,is@(i:_)) hs (y@(h,n):ynt) | g > h && 2*(hs !! n) > h = (h,[n])
                              | g > h = minim (h,[n]) hs ynt
                              | g == h && 2*(hs !! n) > h = (g,n:is)
                          | g == h = minim (g,n:is) hs ynt
                          | g < h && 2*(hs !! n) > g = m
                          | g < h = minim m hs ynt

另外，我遗漏了inc和chop的代码：

alter :: (a->a) -> Int -> [a] -> [a]
alter = \f -> \n -> \xs -> (take (n) xs) ++ [f (xs !! n)] ++ (drop (n+1) xs)

inc :: Int -> [Int] -> [Int]
inc = alter (1+)

chop :: Int -> [[a]] -> [[a]]
chop = alter (tail)

Answer 1

我将提出一个使用无限pairing heap的解决方案。我们将构造每个元素的对数开销，但是no one knows how to do better（在基于比较的方法和实数的模型中）。

第一部分代码只是标准的配对堆。

module Queue where
import Data.Maybe (fromMaybe)

data Queue k = E
             | T k [Queue k]
             deriving Show

fromOrderedList :: (Ord k) => [k] -> Queue k
fromOrderedList [] = E
fromOrderedList [k] = T k []
fromOrderedList (k1 : ks'@(k2 : _ks''))
  | k1 <= k2 = T k1 [fromOrderedList ks']

mergePairs :: (Ord k) => [Queue k] -> Queue k
mergePairs [] = E
mergePairs [q] = q
mergePairs (q1 : q2 : qs'') = merge (merge q1 q2) (mergePairs qs'')

merge :: (Ord k) => Queue k -> Queue k -> Queue k
merge (E) q2 = q2
merge q1 (E) = q1
merge q1@(T k1 q1's) q2@(T k2 q2's)
  = if k1 <= k2 then T k1 (q2 : q1's) else T k2 (q1 : q2's)

deleteMin :: (Ord k) => Queue k -> Maybe (k, Queue k)
deleteMin (E) = Nothing
deleteMin (T k q's) = Just (k, mergePairs q's)

toOrderedList :: (Ord k) => Queue k -> [k]
toOrderedList q
  = fromMaybe [] $
      do (k, q') <- deleteMin q
         return (k : toOrderedList q')

请注意fromOrderedList接受无限列表。我认为这在理论上可以通过假装无限的后代列表有效地“及时”合并来证明。这感觉就像文献中关于纯功能数据结构的东西一样，但我现在会变得很懒，而且现在看起来不太正确。

函数mergeOrderedByMin更进一步，并且合并了一个可能无限的队列列表，其中每个队列中的min元素都是非减少的。我不认为我们可以重复使用merge，因为merge似乎不够懒惰。

mergeOrderedByMin :: (Ord k) => [Queue k] -> Queue k
mergeOrderedByMin [] = E
mergeOrderedByMin (E : qs') = mergeOrderedByMin qs'
mergeOrderedByMin (T k q's : qs')
  = T k (mergeOrderedByMin qs' : q's)

下一个函数从排序列表中删除重复项。这是m09建议的库，但为了完整起见，我将在这里定义它。

nubOrderedList :: (Ord k) => [k] -> [k]
nubOrderedList [] = []
nubOrderedList [k] = [k]
nubOrderedList (k1 : ks'@(k2 : _ks''))
  | k1 < k2 = k1 : nubOrderedList ks'
  | k1 == k2 = nubOrderedList ks'

最后，我们把它们放在一起。我将以方块为例。

squares :: [Integer]
squares = map (^ 2) [0 ..]

sumsOfTwoSquares :: [Integer]
sumsOfTwoSquares
  = nubOrderedList $ toOrderedList $
      mergeOrderedByMin
        [fromOrderedList (map (s +) squares) | s <- squares]

Answer 2

如果您不想修改那么多代码，可以使用Data.List.Ordered的nub函数（可由cabal install data-ordlist安装）来过滤重复项。

它以线性时间运行，即复杂性方面，您的算法不会发生变化。

Answer 3

对于您的示例[1..]，结果只是[2..]。来自具有隐式堆的通用解决方案的“非常智能的编译器”could deduce this。

gens xs更好地表达为

gens xs = map (\t@(x:_) -> map (x+) t) $ tails xs   -- or should it be
     --   map (\(x:ys) -> map (x+) ys) $ tails xs   --                ?

由tree-like folding¹（pictured here）轻松合并其生成的列表列表，无需重复，

pairsums xs = foldi (\(x:l) r-> x : union l r) $ gens xs

这假设输入列表按递增顺序排序。如果它只是以非递减顺序（当然只有有限的运行等于它），你需要在它之上拍一个orderedNub（{{3} }），

pairsums' = orderedNub . pairsums

只需使用foldi foldr可行的foldi f (x:xs) = f x (foldi f (pairs f xs)) pairs f (x:y:t) = f x y : pairs f t union (x:xs) (y:ys) = case compare x y of LT -> x : union xs (y:ys) EQ -> x : union xs ys GT -> y : union (x:xs) ys，我们就可以从 n 到 log n 的因素中获得复杂度的算法改进，一个非常显着的加速。我一直用它作为一般工具。

¹代码，仅针对无限列表进行了调整：

{{1}}

另见：

Answer 4

我建议在对角线上面构建对，这样就不会产生很多重复：

sums xs = zipWith (map . (+)) hs ts where
  (hs:ts) = tails xs

现在您有一个列表列表，每个列表都包含已排序的总和。因为它们是有序的，所以可以通过有限的步骤确定序列的下一个元素：

filtermerge :: (Ord a) => [[a]]->[a]
filtermerge ((h:t):ts) = h : filtermerge (insert t ts) where
  insert [] ts = ts
  insert xs [] = [xs]   
  insert h ([]:t) = insert h t
  insert (h:t) ts@((h1:t1):t2)
    | h < h1  = (h:t):ts
    | h == h1 = insert (h:t) $ insert t1 t2
    | otherwise = insert (h1:t1) $ insert (h:t) t2
filtermerge _ = []

构造无限排序列表而不添加重复项

编辑：

4 个答案: