Triangularizando una lista en Haskell

Estoy interesado en escribir una función eficiente de Haskell triangularize :: [a] -> [[a]]que tome una lista (quizás infinita) y la "triangularice" en una lista de listas. Por ejemplo, triangularize [1..19]debería volver

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

Por eficiente, quiero decir que quiero que se ejecute a O(n)tiempo donde nestá la longitud de la lista.

Tenga en cuenta que esto es bastante fácil de hacer en un lenguaje como Python, porque agregar al final de una lista (matriz) es una operación de tiempo constante. Una función de Python muy imprescindible que logra esto es:

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

Esto surgió porque he estado usando Haskell para escribir algunas secuencias "tabl" en la Enciclopedia en línea de secuencias enteras (OEIS), y quiero poder transformar una secuencia ordinaria (unidimensional) en un (2- dimensional) secuencia de secuencias exactamente de esta manera.

Quizás haya alguna forma inteligente (o no tan inteligente) de foldrsobrepasar la lista de entrada, pero no he podido resolverlo.

Haga trozos de tamaño creciente:

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

Luego solo transponga dos veces:

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

Pruébalo en ghci:

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

Esto parece estar directamente relacionado con el argumento de la teoría de conjuntos que demuestra que el conjunto de pares de enteros están en correspondencia uno a uno con el conjunto de enteros ( numerable ). El argumento involucra una llamada función de emparejamiento de Cantor .

Entonces, por curiosidad, veamos si podemos obtener una diagonalizefunción de esa manera. Defina la lista infinita de pares de Cantor recursivamente en 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)

Y prueba eso dentro de 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)]
 λ> 

Podemos numerar los pares y, por ejemplo, extraer los números de esos pares que tienen una coordenada cero x:

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

Reconocemos que esta es la fila superior del resultado del OP en el texto de la pregunta. Del mismo modo para las siguientes dos filas:

 λ> 
 λ> 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]
 λ> 

A partir de ahí, podemos escribir nuestro primer borrador de una diagonalizefunción:

 λ> 
 λ> 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]
 λ> 

EDITAR: actualización de rendimiento

Para una lista de 1 millón de elementos, el tiempo de ejecución es de 18 segundos y 145 segundos para 4 millones de elementos. Como mencionó Redu, esto parece una complejidad O (n√n).

La distribución de los pares entre las diversas sublistas objetivo es ineficiente, ya que la mayoría de las operaciones de filtro fallan.

Para mejorar el rendimiento, podemos usar una estructura Data.Map para las sublistas objetivo.

{-#  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

Con esa segunda versión, el rendimiento parece ser mucho mejor: 568 ms para la lista de elementos de 1 millón, 2669 ms para la lista de elementos de 4 millones. Por lo tanto, está cerca de la complejidad O (n * Log (n)) que podríamos haber esperado.

Puede ser una buena idea crear un combfiltro.

Entonces, ¿qué hace el combfiltro ...? Es como splitAtpero en lugar de la división en un único índice que tipo de cremalleras la lista infinita dada con el peine dada para separar los elementos de coressponding Truey Falseen el peine. Tal que;

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])

Ahora todo lo que tenemos que hacer es peinar nuestra lista infinita y tomar el fstcomo la primera fila y continuar peinando sndcon la misma comb.

Vamos a hacerlo;

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]
]

También parece ser perezoso también :)

λ> 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]
]

Creo que la complejidad podría ser como O (n√n) pero no puedo asegurarme. Algunas ideas..?