Эффективная таблица для динамического программирования в Haskell

Я закодировал 0-1 проблему Knapsack в 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

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

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

  • Unboxed (immutable) [edit] не обращайте на это внимания
  • Ленивый
  • Неограниченные
  • 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: идея бытия, никогда не повторять одну и ту же подзадачу дважды)

Идеи:

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

Ответы

Ответ 1

Во-первых, ваш критерий для несанкционированной структуры данных, вероятно, немного вводит в заблуждение. Unboxed значения должны быть строгими, и они не имеют ничего общего с неизменяемостью. Решение, которое я собираюсь предложить, является неизменным, ленивым и коробочным. Кроме того, я не уверен, каким образом вы хотите, чтобы конструкция и запрос были 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). Каждый запрос заставляет единственный путь вниз по trie и его значение, поэтому он O (1) для ограниченного размера ключа O (log n). Как я уже сказал, он неизменен, но не распакован.

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

mapM_ (print . uncurry (knapsack ws vs)) $ range ((0,0), (i,w))

Ответ 2

Unboxed подразумевает строгую и ограниченную. Все 100% Unboxed не могут быть Lazy или Unbounded. Обычный компромисс воплощен в преобразовании [Word8] в Data.ByteString.Lazy, где есть unboxed chunks (строгий 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 [email protected](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) 

Ответ 3

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

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

Ответ 4

Для memoize функций я рекомендую библиотеку, такую ​​как Luke Palmer блокноты заметок. В библиотеке используются попытки, которые являются неограниченными и имеют 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 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

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

Ответ 5

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

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

data Index = Index Int Int

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

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