Create a gist now

Instantly share code, notes, and snippets.

Embed
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