Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Decomposable Dequeue
module DecomposableDequeue (DecomposableDequeue, emptyDecomposableDequeue, pushFront, pushBack, popFront, popBack, measure) where
import qualified Data.Dequeue as D
emptyDecomposableDequeue :: (x->f->f)->f->(b->x->b)->b->(f->b->y)->DecomposableDequeue x f b y
emptyDecomposableDequeue fpush fid bpush bid comb = DecomposableDequeue comb (flip fpush) bpush fid bid D.empty [] []
measure :: DecomposableDequeue x f b y -> y
measure deq = combine deq (peek (idf deq) (frontStack deq)) (peek (idb deq) (backStack deq))
where peek a b
| null b = a
| otherwise = head b
data DecomposableDequeue x f b y = DecomposableDequeue {
combine :: f->b->y,
pushf :: f->x->f,
pushb :: b->x->b,
idf :: f,
idb :: b,
list :: D.BankersDequeue x,
backStack :: [b],
frontStack :: [f]
}
push :: (f->x->f)->f->[f]->x->[f]
push f fi xs a
| null xs = f fi a:xs
| otherwise = f (head xs) a:xs
empty :: DecomposableDequeue x f b y -> Bool
empty (DecomposableDequeue _ _ _ _ _ _ x y) = null x && null y
pushFront :: DecomposableDequeue x f b y -> x -> DecomposableDequeue x f b y
pushFront deq a = deq {list = D.pushFront (list deq) a,
frontStack = push (pushf deq) (idf deq) (frontStack deq) a}
pushBack :: DecomposableDequeue x f b y -> x -> DecomposableDequeue x f b y
pushBack deq a = deq {list = D.pushBack (list deq) a,
backStack = push (pushb deq) (idb deq) (backStack deq) a}
popFront :: DecomposableDequeue a l r b -> (Maybe a, DecomposableDequeue a l r b)
popFront deq
| empty deq = (Nothing, deq)
| null (frontStack deq) = popFront (rebuild 1 deq)
| otherwise = (fst firstElem, deq {list = snd firstElem,
frontStack = tail (frontStack deq)})
where firstElem = D.popFront (list deq)
popBack :: DecomposableDequeue a l r b -> (Maybe a, DecomposableDequeue a l r b)
popBack deq
| empty deq = (Nothing, deq)
| null (backStack deq) = popBack (rebuild 0 deq)
| otherwise = (fst lastElem, deq {list = snd lastElem,
backStack = tail (backStack deq)})
where lastElem = D.popBack (list deq)
rebuild :: Int -> DecomposableDequeue a l r b -> DecomposableDequeue a l r b
rebuild offset deq = foldl pushFront (foldl pushBack newDD bk) fr
where n = m `div` 2 + offset
m = D.length s
(fr,bk) = (reverse (D.takeFront n s), reverse (D.takeBack (m - n) s))
s = list deq
newDD = deq {list = D.empty, backStack = [], frontStack = []}
import DecomposableDequeue
import Data.Array
data Object = Object {val :: Int,
cost :: Int}
data Table = Table {bound :: Int,
value :: Int -> Int}
knapsackEmptyTable :: Int -> Table
knapsackEmptyTable n = Table n (buildTable (replicate (n+1) 0))
buildTable :: [Int] -> Int -> Int
buildTable xs i
| i < 0 = minBound
| otherwise = cache!i
where cache = listArray (0, length xs) xs
knapsackPush :: Table -> Object -> Table
knapsackPush t o = Table (bound t) (buildTable [max (value t x) (value t (x- cost o) + val o) | x <- [0..bound t]])
knapsackCombine :: Table -> Table -> Int
knapsackCombine t1 t2 = maximum [value t1 x + value t2 (n-x)|x<-[0..n]]
where n = bound t1
knapsackDeque :: Int -> DecomposableDequeue Object Table Table Int
knapsackDeque n = emptyDecomposableDequeue (flip knapsackPush) (knapsackEmptyTable n) knapsackPush (knapsackEmptyTable n) knapsackCombine
import DecomposableDequeue
--(best sum so far starting from beginning, sum from beginning, best sum end at current position, best sum so far)
maxSubarrayEmpty :: (Num a, Ord a) => (a, a, a, a)
maxSubarrayEmpty = (0,0,0,0)
maxSubarrayPush :: (Num a, Ord a) => (a, a, a, a) -> a -> (a, a, a, a)
maxSubarrayPush (a,b,c,d) x = (max a (b+x), b+x, max 0 (c+x), max d c+x)
maxSubarrayCombine :: (Num a, Ord a) => (a, a, a, a) -> (a, a, a, a) -> a
maxSubarrayCombine (a,_,_,d) (a',_,_,d') = maximum [a+a',d,d']
maxSubarrayDeque :: (Num a, Ord a) => DecomposableDequeue a (a,a,a,a) (a,a,a,a) a
maxSubarrayDeque = emptyDecomposableDequeue (flip maxSubarrayPush) maxSubarrayEmpty maxSubarrayPush maxSubarrayEmpty maxSubarrayCombine
import DecomposableDequeue
import Data.Monoid
monoidDequeue :: (Monoid a) => DecomposableDequeue a a a a
monoidDequeue = emptyDecomposableDequeue mappend mempty mappend mempty mappend
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment