Haskellでのリストの三角形化

triangularize :: [a] -> [[a]]（おそらく無限の）リストを取り、それをリストのリストに「三角形化」する効率的なHaskell関数を書くことに興味があります。たとえば、triangularize [1..19]返す必要があります

[[1,  3,  6,  10, 15]
,[2,  5,  9,  14]
,[4,  8,  13, 19]
,[7,  12, 18]
,[11, 17]
,[16]]

効率的には、リストの長さがO(n)どこにあるのかを実行することを意味しnます。

リスト（配列）の末尾への追加は一定時間の操作であるため、これはPythonなどの言語で非常に簡単に実行できることに注意してください。これを実現する非常に命令的なPython関数は次のとおりです。

def triangularize(elements):
    row_index = 0
    column_index = 0
    diagonal_array = []
    for a in elements:
        if row_index == len(diagonal_array):
            diagonal_array.append([a])
        else:
            diagonal_array[row_index].append(a)
        if row_index == 0:
            (row_index, column_index) = (column_index + 1, 0)
        else:
            row_index -= 1
            column_index += 1
    return diagonal_array

これは、Haskellを使用して、整数シーケンスのオンラインエンサイクロペディア（OEIS）で「tabl」シーケンスを記述していて、通常の（1次元）シーケンスを（2-次元）シーケンスのシーケンスは、まさにこの方法で。

おそらくfoldr、入力リストを整理するための巧妙な（またはそれほど賢くない）方法があるかもしれませんが、私はそれを整理することができませんでした。

増加するサイズのチャンクを作成します。

chunks :: [a] -> [[a]]
chunks = go 0 where
    go n [] = []
    go n as = b : go (n+1) e where (b,e) = splitAt n as

次に、2回転置します。

diagonalize :: [a] -> [[a]]
diagonalize = transpose . transpose . chunks

ghciで試してください：

> diagonalize [1..19]
[[1,3,6,10,15],[2,5,9,14],[4,8,13,19],[7,12,18],[11,17],[16]]

これは、整数ペアのセットが整数セットと1対1で対応していることを証明するセット理論の引数に直接関連しているようです（denumerable）。引数には、いわゆるカントールペアリング関数が含まれます。

それでは、好奇心から、diagonalizeその方法で関数を取得できるかどうか見てみましょう。Cankペアの無限リストをHaskellで再帰的に定義します。

auxCantorPairList :: (Integer, Integer) -> [(Integer, Integer)]
auxCantorPairList (x,y) =
    let nextPair = if (x > 0) then (x-1,y+1) else (x+y+1, 0)
    in (x,y) : auxCantorPairList nextPair

cantorPairList :: [(Integer, Integer)]
cantorPairList = auxCantorPairList (0,0)

そしてそれをghciの中で試してください：

 λ> take 15 cantorPairList
[(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3),(4,0),(3,1),(2,2),(1,3),(0,4)]
 λ> 

ペアに番号を付けることができ、たとえば、x座標がゼロのペアの番号を抽出できます。

 λ> 
 λ> xs = [1..]
 λ> take 5 $ map fst $ filter (\(n,(x,y)) -> (x==0)) $ zip xs cantorPairList
[1,3,6,10,15]
 λ> 

これは、質問のテキストのOPの結果の一番上の行であることを認識しています。同様に、次の2行について：

 λ> 
 λ> makeRow xs row = map fst $ filter (\(n,(x,y)) -> (x==row)) $ zip xs cantorPairList
 λ> take 5 $ makeRow xs 1
[2,5,9,14,20]
 λ> 
 λ> take 5 $ makeRow xs 2
[4,8,13,19,26]
 λ> 

そこから、diagonalize関数の最初のドラフトを書くことができます：

 λ> 
 λ> printAsLines xs = mapM_ (putStrLn . show) xs
 λ> diagonalize xs = takeWhile (not . null) $ map (makeRow xs) [0..]
 λ> 
 λ> printAsLines $ diagonalize [1..19]
[1,3,6,10,15]
[2,5,9,14]
[4,8,13,19]
[7,12,18]
[11,17]
[16]
 λ> 

編集：パフォーマンスの更新

100万項目のリストの場合、実行時間は18秒、400万項目の場合は145秒です。Reduが述べたように、これはO（n√n）の複雑さのようです。

ほとんどのフィルター操作が失敗するため、さまざまなターゲットサブリスト間でペアを分散することは非効率的です。

パフォーマンスを向上させるために、ターゲットサブリストにData.Map構造を使用できます。

{-#  LANGUAGE  ExplicitForAll       #-}
{-#  LANGUAGE  ScopedTypeVariables  #-}

import qualified  Data.List  as  L
import qualified  Data.Map   as  M

type MIL a = M.Map Integer [a]

buildCantorMap :: forall a.  [a] -> MIL a
buildCantorMap xs = 
    let   ts     =  zip xs cantorPairList -- triplets (a,(x,y))
          m0     = (M.fromList [])::MIL a
          redOp m (n,(x,y)) = let  afn as = case as of
                                              Nothing  -> Just [n]
                                              Just jas -> Just (n:jas)
                              in   M.alter afn x m
          m1r = L.foldl' redOp m0 ts
    in
          fmap reverse m1r

diagonalize :: [a] -> [[a]]
diagonalize xs = let  cm = buildCantorMap xs
                 in   map snd $ M.toAscList cm

その2番目のバージョンでは、パフォーマンスははるかに優れているようです。100万個のアイテムリストでは568ミリ秒、400万個のアイテムリストでは2669ミリ秒です。ですから、私たちが望んでいたO（n * Log（n））の複雑さに近いです。

それをクレイトするのは良い考えかもしれません combフィルターます。

では、combフィルターは何をするのでしょうか？それはようなものだsplitAt、それは単一のインデックスではなく、分割の一種のにcoresspondingアイテム分離するために与えられた櫛で与えられた無限のリストをジッパーTrueやFalse櫛でを。そのような;

comb :: [Bool]  -- yields [True,False,True,False,False,True,False,False,False,True...]
comb = iterate (False:) [True] >>= id

combWith :: [Bool] -> [a] -> ([a],[a])
combWith _ []          = ([],[])
combWith (c:cs) (x:xs) = let (f,s) = combWith cs xs
                         in if c then (x:f,s) else (f,x:s)

λ> combWith comb [1..19]
([1,3,6,10,15],[2,4,5,7,8,9,11,12,13,14,16,17,18,19])

ここで行う必要があるのは、無限リストを結合fstし、最初の行としてを取得sndして、と同じものを結合することcombです。

やってみましょう;

diags :: [a] -> [[a]]
diags [] = []
diags xs = let (h,t) = combWith comb xs
           in h : diags t

λ> diags [1..19]
[ [1,3,6,10,15]
, [2,5,9,14]
, [4,8,13,19]
, [7,12,18]
, [11,17]
, [16]
]

また、怠惰なようにも見えます:)

λ> take 5 . map (take 5) $ diags [1..]
[ [1,3,6,10,15]
, [2,5,9,14,20]
, [4,8,13,19,26]
, [7,12,18,25,33]
, [11,17,24,32,41]
]

複雑さはO（n√n）のようになると思いますが、確認できません。何か案は..？