Триангуляция списка в Haskell

Question

Мне интересно написать эффективную Haskell функцию triangularize :: [a] -> [[a]], которая берет (возможно, бесконечный) список и «треугольнизирует» его в список списков. Например, 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 для записи некоторых последовательностей "tabl" в On-Line Энциклопедия целочисленных последовательностей (OEIS), и я хочу иметь возможность преобразовывать обычную (одномерную) последовательность в (двумерную) последовательность последовательностей именно таким образом.

Возможно, есть какой-то умный (или не очень умный) способ foldr по списку ввода, но я не смог разобраться.

Answer 1

Сделайте фрагменты увеличенного размера:

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

Затем просто транспонируйте дважды:

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

Answer 2

Это, по-видимому, напрямую связано с аргументом теории множеств, доказывающим, что набор целочисленных пар находится в взаимно однозначном соответствии с набором целых чисел ( denumerable ). Аргумент включает в себя так называемую функцию связывания Кантора .

Итак, из любопытства, давайте посмотрим, сможем ли мы получить функцию diagonalize таким способом. Определите бесконечный список пар Кантора рекурсивно в 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)]
 λ> 

Мы можем нумеровать пары и, например, извлечь числа для тех пар, которые имеют нулевую координату х:

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

Мы понимаем, что это верхняя строка из результата ОП в тексте вопроса. Аналогично для следующих двух строк:

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

РЕДАКТИРОВАТЬ: обновление производительности

Для списка из 1 миллиона элементов время выполнения равно 18 se c, а для 4 миллионов элементов - 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

С этой второй версией производительность выглядит намного лучше: 568 mse c для списка из 1 миллиона элементов, 2669 mse c для списка предметов 4 миллиона. Так что это близко к сложности O (n * Log (n)), на которую мы могли надеяться.

Answer 3

Было бы неплохо создать фильтр comb.

Так что же делает фильтр comb ..? Это похоже на splitAt, но вместо разделения по одному индексу это своего рода сжимает заданный бесконечный список с данной гребенкой, чтобы отделить элементы, соответствующие 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), но я не могу убедиться. Есть идеи ..?