Triangulariser une liste en Haskell

Question

Je suis intéressé par l'écriture d'une fonction Haskell efficace triangularize :: [a] -> [[a]] qui prend une liste (peut-être infinie) et la "triangularise" en une liste de listes. Par exemple, triangularize [1..19] devrait retourner

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

Par efficace, je veux dire que je veux qu'il fonctionne en O(n) le moment où n est la longueur de la liste.

---

Notez que cela est assez facile à faire dans un langage comme Python, car l'ajout à la fin d'une liste (tableau) est une opération en temps constant. Une fonction Python très impérative qui accomplit ceci est :

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

---

Ce problème est apparu parce que j'ai utilisé Haskell pour écrire des séquences "tabl" dans la base de données de l'UE. Encyclopédie en ligne des séquences de nombres entiers (OEIS), et je veux pouvoir transformer une séquence ordinaire (à une dimension) en une séquence de séquences (à deux dimensions) exactement de cette manière.

Peut-être qu'il y a une façon intelligente (ou pas si intelligente) de foldr sur la liste d'entrée, mais je n'ai pas réussi à la démêler.

Answer 1

Faites des morceaux de taille croissante :

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

Ensuite, il suffit de transposer deux fois :

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

Essayez-le en ghci :

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

Answer 2

Cela semble être directement lié à l'argument de la théorie des ensembles prouvant que l'ensemble des paires d'entiers est en correspondance biunivoque avec l'ensemble des entiers ( dénombrable ). L'argument implique un soi-disant Fonction d'appariement de Cantor .

Donc, par curiosité, voyons si nous pouvons obtenir un diagonalize fonctionnent de cette façon. Définir la liste infinie des paires de Cantor de manière récursive 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)

Et essayez ça dans le 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)]
 > 

Nous pouvons numéroter les paires, et par exemple extraire les numéros pour les paires dont la coordonnée x est nulle :

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

Nous reconnaissons qu'il s'agit de la ligne supérieure du résultat du PO dans le texte de la question. De même pour les deux rangées suivantes :

 > 
 > 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 là, nous pouvons rédiger notre première ébauche d'une diagonalize funció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]
 > 

EDIT : mise à jour des performances

Pour une liste de 1 million d'éléments, le temps d'exécution est de 18 secondes, et de 145 secondes pour 4 millions d'éléments. Comme mentionné par Redu, cela semble d'une complexité O(nn).

La répartition des paires entre les différentes sous-listes de cibles est inefficace, car la plupart des opérations de filtrage échouent.

Pour améliorer les performances, nous pouvons utiliser une structure Data.Map pour les sous-listes cibles.

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

Avec cette deuxième version, les performances semblent être bien meilleures : 568 msec pour la liste de 1 million d'éléments, 2669 msec pour la liste de 4 millions d'éléments. On est donc proche de la complexité O(n*Log(n)) que l'on pouvait espérer.

Answer 3

Il pourrait être une bonne idée de craete un comb filtre.

Alors que fait comb filtre font.. ? C'est comme splitAt mais au lieu de se diviser à un seul index, elle en quelque sorte zippe la liste infinie donnée avec le peigne donné pour séparer les éléments coresspondant à True y False dans le peigne. Comme ça ;

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

Maintenant, tout ce que nous devons faire est de passer au peigne fin notre liste infinie et de prendre le fst comme la première rangée et continuez à peigner le snd avec le même comb .

C'est parti ;

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

semble aussi être paresseux :)

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

Je pense que la complexité pourrait être de l'ordre de O(nn) mais je ne peux pas en être sûr. Des idées ?