Эффективная таблица для динамического программирования в Haskell - PullRequest
15 голосов
/ 07 марта 2011

Я кодировал проблему 0-1 Рюкзак в Haskell. Я довольно горжусь ленью и уровнем общности, достигнутым до сих пор.

Я начну с предоставления функций для создания и работы с ленивой 2d матрицей.

mkList f = map f [0..]
mkTable f = mkList (\i -> mkList (\j -> f i j))

tableIndex table i j = table !! i !! j

Затем я создаю конкретную таблицу для данной задачи о ранце

knapsackTable = mkTable f
    where f 0 _ = 0
          f _ 0 = 0
          f i j | ws!!i > j = leaveI
                | otherwise = max takeI leaveI
              where takeI  = tableIndex knapsackTable (i-1) (j-(ws!!i)) + vs!!i
                    leaveI = tableIndex knapsackTable (i-1) j

-- weight value pairs; item i has weight ws!!i and value vs!!i
ws  = [0,1,2, 5, 6, 7] -- weights
vs  = [0,1,7,11,21,31] -- values

И, наконец, пара вспомогательных функций для просмотра таблицы

viewTable table maxI maxJ = take (maxI+1) . map (take (maxJ+1)) $ table
printTable table maxI maxJ = mapM_ print $ viewTable table maxI maxJ

Это было довольно легко. Но я хочу сделать еще один шаг вперед.

Мне нужна лучшая структура данных для таблицы. В идеале это должно быть

  • Без коробки (неизменяемый) [править] Не обращайте на это внимания
  • Ленивый
  • Неограниченные
  • O(1) время построить
  • O(1) сложность времени для поиска данной записи,
    (более реалистично, в худшем случае O(log n), где n равно i*j для поиска записи в строке i, столбце j)

Бонусные баллы, если вы можете объяснить, почему / как ваше решение удовлетворяет этим идеалам.

Также бонусные баллы, если вы можете обобщить knapsackTable и доказать, что это эффективно.

При улучшении структуры данных вы должны попытаться достичь следующих целей:

  • Если я запрашиваю решение, в котором максимальный вес равен 10 (в моем текущем коде это будет indexTable knapsackTable 5 10, 5 средств включают пункты 1-5), то должен выполняться только минимальный необходимый объем работы. В идеале это означает, что O(i*j) не нужно работать, чтобы заставить позвоночник каждой строки таблицы достичь необходимой длины столбца. Вы можете сказать, что это не «истинный» DP, если вы считаете, что DP означает оценку всей таблицы.
  • Если я попрошу напечатать всю таблицу (что-то вроде printTable knapsackTable 5 10), значения каждой записи должны вычисляться один раз и только один раз. Значения данной ячейки должны зависеть от значений других ячеек (стиль DP: идея в том, чтобы никогда не пересчитывать одну и ту же подзадачу дважды)

Идеи:

Ответы, которые делают некоторые компромиссы с моими заявленными идеалами будут поддерживаться (как я, во всяком случае), пока они информативны. Ответ с наименьшим количеством компромиссов, вероятно, будет «принятым».

Ответы [ 5 ]

14 голосов
/ 08 марта 2011

Во-первых, ваш критерий для неупакованной структуры данных, вероятно, немного вводит в заблуждение.Распакованные значения должны быть строгими, и они не имеют ничего общего с неизменяемостью.Решение, которое я собираюсь предложить, является неизменным, ленивым и коробочным.Кроме того, я не уверен, каким образом вы хотите построить и запросить O (1).Структура, которую я предлагаю, лениво построена, но, поскольку она потенциально неограничена, ее полная конструкция займет бесконечное время.Для запроса структуры потребуется O (k) времени для любого конкретного ключа размера k, но, конечно, значение, которое вы ищете, может занять больше времени для вычисления.

Структура данных - это ленивый метод.Я использую библиотеку Conal Elliott MemoTrie в своем коде.Для универсальности он использует функции вместо списков для весов и значений.

knapsack :: (Enum a, Num w, Num v, Num a, Ord w, Ord v, HasTrie a, HasTrie w) =>
            (a -> w) -> (a -> v) -> a -> w -> v
knapsack weight value = knapsackMem
  where knapsackMem = memo2 knapsack'
        knapsack' 0 w = 0
        knapsack' i 0 = 0
        knapsack' i w
          | weight i > w = knapsackMem (pred i) w
          | otherwise = max (knapsackMem (pred i) w)
                        (knapsackMem (pred i) (w - weight i)) + value i

В основном, это реализовано как дерево с ленивым позвоночником и ленивыми значениями.Он ограничен только типом ключа.Поскольку все это лениво, его конструкция перед форсированием запросов O (1).Каждый запрос задает один путь вниз по дереву и его значение, поэтому O (1) для ограниченного размера ключа O (log n).Как я уже сказал, он неизменен, но не распакован.

Он будет делить всю работу в рекурсивных вызовах.На самом деле он не позволяет вам распечатать файл напрямую, но что-то вроде этого не должно выполнять лишнюю работу:

mapM_ (print . uncurry (knapsack ws vs)) $ range ((0,0), (i,w))
9 голосов
/ 07 марта 2011

Распакованный означает строгий и ограниченный. Все, что на 100% распаковано, не может быть ленивым или неограниченным. Обычный компромисс заключается в преобразовании [Word8] в Data.ByteString.Lazy, где есть распакованные фрагменты (строго ByteString), которые лениво связаны неограниченным образом.

Гораздо более эффективный генератор таблиц (улучшенный для отслеживания отдельных элементов) может быть создан с использованием "scanl", "zipWith" и моего "takeOnto". Это эффективно избегает использования (!!) при создании таблицы:

import Data.List(sort,genericTake)

type Table = [ [ Entry ] ]

data Entry = Entry { bestValue :: !Integer, pieces :: [[WV]] }
  deriving (Read,Show)

data WV = WV { weight, value :: !Integer }
  deriving (Read,Show,Eq,Ord)

instance Eq Entry where
  (==) a b = (==) (bestValue a) (bestValue b)

instance Ord Entry where
  compare a b = compare (bestValue a) (bestValue b)

solutions :: Entry -> Int
solutions = length . filter (not . null) . pieces

addItem :: Entry -> WV -> Entry
addItem e wv = Entry { bestValue = bestValue e + value wv, pieces = map (wv:) (pieces e) }

-- Utility function for improve
takeOnto :: ([a] -> [a]) -> Integer -> [a] -> [a]
takeOnto endF = go where
  go n rest | n <=0 = endF rest
            | otherwise = case rest of
                            (x:xs) -> x : go (pred n) xs
                            [] -> error "takeOnto: unexpected []"

improve oldList wv@(WV {weight=wi,value = vi}) = newList where
  newList | vi <=0 = oldList
          | otherwise = takeOnto (zipWith maxAB oldList) wi oldList
  -- Dual traversal of index (w-wi) and index w makes this a zipWith
  maxAB e2 e1 = let e2v = addItem e2 wv
                in case compare e1 e2v of
                     LT -> e2v
                     EQ -> Entry { bestValue = bestValue e1
                                 , pieces = pieces e1 ++ pieces e2v }
                     GT -> e1

-- Note that the returned table is finite
-- The dependence on only the previous row makes this a "scanl" operation
makeTable :: [Int] -> [Int] -> Table
makeTable ws vs =
  let wvs = zipWith WV (map toInteger ws) (map toInteger vs)
      nil = repeat (Entry { bestValue = 0, pieces = [[]] })
      totW = sum (map weight wvs)
  in map (genericTake (succ totW)) $ scanl improve nil wvs

-- Create specific table, note that weights (1+7) equal weight 8
ws, vs :: [Int]
ws  = [2,3, 5, 5, 6, 7] -- weights
vs  = [1,7,8,11,21,31] -- values

t = makeTable ws vs

-- Investigate table

seeTable = mapM_ seeBestValue t
  where seeBestValue row = mapM_ (\v -> putStr (' ':(show (bestValue v)))) row >> putChar '\n'

ways = mapM_ seeWays t
  where seeWays row = mapM_ (\v -> putStr (' ':(show (solutions v)))) row >> putChar '\n'

-- This has two ways of satisfying a bestValue of 8 for 3 items up to total weight 5
interesting = print (t !! 3 !! 5) 
4 голосов
/ 08 марта 2011

Чтобы запоминать функции, я рекомендую такую ​​библиотеку, как памятные комбинаторы Люка Палмера .Библиотека использует попытки, которые не ограничены и имеют поиск O (размер ключа).(В общем, вы не можете сделать лучше, чем поиск O (размер ключа), потому что вы всегда должны касаться каждого бита ключа.)

knapsack :: (Int,Int) -> Solution
knapsack = memo f
    where
    memo    = pair integral integral
    f (i,j) = ... knapsack (i-b,j) ...


Внутренне, вероятно, комбинатор integralсоздает бесконечную структуру данных

data IntTrie a = Branch IntTrie a IntTrie

integral f = \n -> lookup n table
     where
     table = Branch (\n -> f (2*n)) (f 0) (\n -> f (2*n+1))

Lookup работает следующим образом:

lookup 0 (Branch l a r) = a
lookup n (Branch l a r) = if even n then lookup n2 l else lookup n2 r
     where n2 = n `div` 2

Существуют и другие способы создания бесконечных попыток, но этот популярный.

4 голосов
/ 07 марта 2011

Ленивые хранимые векторы: http://hackage.haskell.org/package/storablevector

Неограниченное, ленивое, O (chunksize) время создания, O (n / chunksize) индексация, где chunksize может быть достаточно большим для любой данной цели. В основном это ленивый список с некоторыми значительными постоянными факторами.

2 голосов
/ 07 марта 2011

Почему вы не будете использовать Data.Map, помещая в него другой Data.Map?Насколько я знаю, это довольно быстро.Хотя это не будет лениво.

Более того, вы можете реализовать класс типов Ord для ваших данных

data Index = Index Int Int

и поместить двумерный индекс непосредственно в качестве ключа.Вы можете достичь лени, создав эту карту в виде списка, а затем просто используйте

fromList [(Index 0 0, value11), (Index 0 1, value12), ...] 
...