Бесконечное ленивое растровое изображение

Я пытаюсь построить ленивую структуру данных, которая содержит бесконечное растровое изображение. Я хотел бы поддержать следующие операции:

  • true :: InfBitMap

    Возвращает бесконечное битовое изображение True, то есть все позиции должны иметь значение True.

  • falsify :: InfBitMap -> [Int] -> InfBitMap

    Установите для всех позиций в списке значение False. Список возможен бесконечно. Например, falsify true [0,2..] вернет список, в котором все (и только) нечетные позиции имеют значение True.

  • check :: InfBitMap -> Int -> Bool

    Проверьте значение индекса.

Вот что я мог сделать до сих пор.

-- InfBitMap will look like [(@), (@, @), (@, @, @, @)..]
type InfBitMap = [Seq Bool]

true :: InfBitMap
true = iterate (\x -> x >< x) $ singleton True

-- O(L * log N) where N is the biggest index in the list checked for later
-- and L is the length of the index list. It is assumed that the list is
-- sorted and unique.
falsify :: InfBitMap -> [Int] -> InfBitMap
falsify ls is = map (falsify' is) ls
     where
         -- Update each sequence with all indices within its length
         -- Basically composes a list of (update pos False) for all positions
         -- within the length of the sequence and then applies it.
         falsify' is l = foldl' (.) id
                                (map ((flip update) False)
                                     (takeWhile (< length l) is))
                         $ l
-- O(log N) where N is the index.
check :: InfBitMap -> Int -> Bool
check ls i = index (fromJust $ find ((> i) . length) ls) i

Мне интересно, есть ли какая-то концепция/структура данных Haskellish, которые мне не хватает, что сделает мой код более элегантным/более эффективным (константы для меня не имеют значения, просто порядок). Я попытался взглянуть на молнии и линзы, но они, похоже, не помогают. Я хотел бы сохранить сложность обновлений и проверить логарифмический (возможно, просто амортизированный логарифмический).

Примечание: перед тем, как кто-то его заподозрит, это не проблема домашней работы!

Обновление

Мне просто пришло в голову, что проверка может быть улучшена:

-- O(log N) where N is the index.
-- Returns "collapsed" bitmap for later more efficient checks.
check :: InfBitMap -> Int -> (Bool, InfBitMap)
check ls i = (index l i, ls')
    where
        ls'@(l:_) = dropWhile ((<= i) . length) ls

Что может быть превращено в Monad для чистоты кода.

Ответы

Ответ 1

Небольшое отклонение от известного целого три кажется здесь применимым.

{-# LANGUAGE DeriveFunctor #-}

data Trie a = Trie a (Trie a) (Trie a) deriving (Functor)

true :: Trie Bool
true = Trie True true true

-- O(log(index))
check :: Trie a -> Int -> a
check t i | i < 0 = error "negative index"
check t i = go t (i + 1) where
    go (Trie a _ _) 1 = a
    go (Trie _ l r) i = go (if even i then l else r) (div i 2)

--O(log(index))
modify :: Trie a -> Int -> (a -> a) -> Trie a
modify t i f | i < 0 = error "negative index"
modify t i f = go t (i + 1) where
    go (Trie a l r) 1 = Trie (f a) l r
    go (Trie a l r) i | even i = Trie a (go l (div i 2)) r
    go (Trie a l r) i = Trie a l (go r (div i 2))

К сожалению, мы не можем использовать modify для реализации falsify, потому что мы не можем обрабатывать бесконечные списки индексов таким образом (все модификации должны выполняться до того, как элемент trie можно проверить). Вместо этого мы должны сделать что-то более похожее на слияние:

ascIndexModify :: Trie a -> [(Int, a -> a)] -> Trie a
ascIndexModify t is = go 1 t is where
    go _ t [] = t
    go i [email protected](Trie a l r) ((i', f):is) = case compare i (i' + 1) of
        LT -> Trie a (go (2*i) l ((i', f):is)) (go (2*i+1) r ((i', f):is))
        GT -> go i t is
        EQ -> Trie (f a) (go (2*i) l is) (go (2*i+1) r is)

falsify :: Trie Bool -> [Int] -> Trie Bool
falsify t is = ascIndexModify t [(i, const False) | i <- is]

Мы принимаем строго восходящие индексы в is, так как в противном случае мы пропустим места в trie или даже получим non-term, например, в check (falsify t (repeat 0)) 1.

Временные сложности немного сложнее лень. В check (falsify t is) index мы платим дополнительную стоимость постоянного количества сравнений log 2 index и еще одно количество сравнений length (filter (<index) is) (то есть стоимость перехода по всем индексам, меньшим, чем мы видим). Вы могли бы сказать это O(max(log(index), length(filter (<index) is)). В любом случае, это определенно лучше, чем O(length is * log (index)), которое мы получили бы для falsify, реализованного для конечных is -es, используя modify.

Мы должны иметь в виду, что узлы дерева оцениваются один раз, а последующие check -s для одного и того же индекса после первого check не платят никакой дополнительной стоимости за falsify. Опять же, ленивость делает это немного сложнее.

Этот falsify также очень хорошо себя ведет, когда мы хотим пересечь префикс trie. Возьмите эту функцию toList:

trieToList :: Trie a -> [a]
trieToList t = go [t] where
    go ts = [a | Trie a _ _ <- ts] 
            ++ go (do {Trie _ l r <- ts; [l, r]})

Это стандартный обход ширины в линейном времени. Время прохождения остается линейным при вычислении take n $ trieToList (falsify t is), так как falsify берет не более n + length (filter (<n) is) дополнительные сравнения, которые не превосходят 2 * n, предполагая строго возрастающее is.

(боковое примечание: потребность в пространстве для прохождения по ширине очень болезненна, но я не вижу простого способа помочь ей, так как итерационное углубление здесь еще хуже, потому что все дерево должно храниться в памяти, тогда как bfs должен помнить только нижний уровень дерева).

Ответ 2

Один из способов представить это как функцию.

true = const True

falsify ls is = \i -> not (i `elem` is) && ls i

check ls i = ls i

Истинные и фальсифицирующие функции хороши и эффективны. Функция проверки может быть такой же низкой, как и линейная. Это позволяет повысить эффективность одной и той же базовой идеи. Мне нравится его элегантность.