{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PureSAT.SparseMaxHeap (
SparseHeap,
Weight,
sizeofSparseHeap,
newSparseHeap,
cloneSparseHeap,
memberSparseHeap,
insertSparseHeap,
deleteSparseHeap,
popSparseHeap,
popSparseHeap_,
elemsSparseHeap,
clearSparseHeap,
extendSparseHeap,
drainSparseHeap,
modifyWeightSparseHeap,
scaleWeightsSparseHeap,
) where
import Data.Bits
import Data.Primitive.PrimVar
import PureSAT.Base
import PureSAT.Utils
import PureSAT.Prim
type Weight = Word
data SparseHeap s = SH
{ forall s. SparseHeap s -> PrimVar s Int
size :: {-# UNPACK #-} !(PrimVar s Int)
, forall s. SparseHeap s -> MutablePrimArray s Int
dense :: {-# UNPACK #-} !(MutablePrimArray s Int)
, forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: {-# UNPACK #-} !(MutablePrimArray s Int)
, forall s. SparseHeap s -> MutablePrimArray s Weight
weight :: {-# UNPACK #-} !(MutablePrimArray s Word)
}
le :: Int -> Weight -> Int -> Weight -> Bool
le :: Int -> Weight -> Int -> Weight -> Bool
le Int
_ !Weight
u Int
_y !Weight
v = Weight
u Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
>= Weight
v
checking :: String -> SparseHeap s -> ST s a -> ST s a
{-# INLINE checking #-}
#ifdef CHECK_INVARIANTS
#define CHECK(tag,heap) _invariant tag heap
checking tag heap m = do
_invariant (tag ++ " pre") heap
x <- m
_invariant (tag ++ " post") heap
return x
#else
#define CHECK(tag,heap)
checking :: forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
_tag SparseHeap s
_heap ST s a
m = ST s a
m
#endif
_invariant :: String -> SparseHeap s -> ST s ()
_invariant :: forall s. String -> SparseHeap s -> ST s ()
_invariant String
tag SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
Int
capacity <- MutablePrimArray (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dense
Int
capacity1 <- MutablePrimArray (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
sparse
Int
capacity2 <- MutablePrimArray (PrimState (ST s)) Weight -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Weight
MutablePrimArray (PrimState (ST s)) Weight
weight
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
capacity Bool -> Bool -> Bool
&& Int
capacity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
capacity1 Bool -> Bool -> Bool
&& Int
capacity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
capacity2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"capacities " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
n, Int
capacity, Int
capacity1, Int
capacity2)
Int -> Int -> Int -> ST s ()
checkStructure Int
capacity Int
n Int
0
Int -> Int -> ST s ()
checkHeaps Int
n Int
0
where
checkStructure :: Int -> Int -> Int -> ST s ()
checkStructure Int
capacity Int
n Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Int
x <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"x < capacity" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
x, Int
capacity)
Int
j <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
sparse Int
x
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"i == j" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
i, Int
j)
Int -> Int -> Int -> ST s ()
checkStructure Int
capacity Int
n (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
checkHeaps :: Int -> Int -> ST s ()
checkHeaps Int
n Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Int
x <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
Weight
u <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
x
Int -> Int -> Int -> Weight -> ST s ()
heap Int
n Int
i Int
x Weight
u
Int -> Int -> ST s ()
checkHeaps Int
n (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
heap :: Int -> Int -> Int -> Weight -> ST s ()
heap Int
n Int
i Int
x Weight
u = do
let !j :: Int
j = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
let !k :: Int
k = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Int
y <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
y
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Weight -> Int -> Weight -> Bool
le Int
x Weight
u Int
y Weight
v) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"heap 1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Weight, Int, Int, Weight) -> String
forall a. Show a => a -> String
show (Int
n, Int
i, Int
x, Weight
u, Int
j, Int
y, Weight
v)
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Int
z <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
k
Weight
w <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
z
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Weight -> Int -> Weight -> Bool
le Int
x Weight
u Int
z Weight
w) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"heap 2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Weight, Int, Int, Weight) -> String
forall a. Show a => a -> String
show (Int
n, Int
i, Int
x, Weight
u, Int
k, Int
z, Weight
w)
newSparseHeap
:: Int
-> ST s (SparseHeap s)
newSparseHeap :: forall s. Int -> ST s (SparseHeap s)
newSparseHeap !Int
capacity' = do
let !capacity :: Int
capacity = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1024 Int
capacity'
PrimVar s Int
size <- Int -> ST s (PrimVar (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
MutablePrimArray s Int
dense <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
capacity
MutablePrimArray s Int
sparse <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
capacity
MutablePrimArray s Weight
weight <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Weight)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
capacity
MutablePrimArray s Weight -> Int -> Int -> Weight -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> Int -> a -> ST s ()
setPrimArray MutablePrimArray s Weight
weight Int
0 Int
capacity Weight
0
SparseHeap s -> ST s (SparseHeap s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..}
cloneSparseHeap :: SparseHeap s -> ST s (SparseHeap s)
cloneSparseHeap :: forall s. SparseHeap s -> ST s (SparseHeap s)
cloneSparseHeap SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = do
Int
capacity <- MutablePrimArray (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dense
PrimVar s Int
size' <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size ST s Int -> (Int -> ST s (PrimVar s Int)) -> ST s (PrimVar s Int)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ST s (PrimVar s Int)
Int -> ST s (PrimVar (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar
MutablePrimArray s Int
dense' <- MutablePrimArray (PrimState (ST s)) Int
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dense Int
capacity
MutablePrimArray s Int
sparse' <- MutablePrimArray (PrimState (ST s)) Int
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
sparse Int
capacity
MutablePrimArray s Weight
weight' <- MutablePrimArray (PrimState (ST s)) Weight
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Weight)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Weight
MutablePrimArray (PrimState (ST s)) Weight
weight Int
capacity
MutablePrimArray s Int
-> Int -> MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a
-> Int -> MutablePrimArray s a -> Int -> Int -> ST s ()
copyMutablePrimArray MutablePrimArray s Int
dense' Int
0 MutablePrimArray s Int
dense Int
0 Int
capacity
MutablePrimArray s Int
-> Int -> MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a
-> Int -> MutablePrimArray s a -> Int -> Int -> ST s ()
copyMutablePrimArray MutablePrimArray s Int
sparse' Int
0 MutablePrimArray s Int
sparse Int
0 Int
capacity
MutablePrimArray s Weight
-> Int -> MutablePrimArray s Weight -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a
-> Int -> MutablePrimArray s a -> Int -> Int -> ST s ()
copyMutablePrimArray MutablePrimArray s Weight
weight' Int
0 MutablePrimArray s Weight
weight Int
0 Int
capacity
SparseHeap s -> ST s (SparseHeap s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return SH { size :: PrimVar s Int
size = PrimVar s Int
size', dense :: MutablePrimArray s Int
dense = MutablePrimArray s Int
dense', sparse :: MutablePrimArray s Int
sparse = MutablePrimArray s Int
sparse', weight :: MutablePrimArray s Weight
weight = MutablePrimArray s Weight
weight' }
sizeofSparseHeap :: SparseHeap s -> ST s Int
sizeofSparseHeap :: forall s. SparseHeap s -> ST s Int
sizeofSparseHeap SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
extendSparseHeap
:: Int
-> SparseHeap s
-> ST s (SparseHeap s)
extendSparseHeap :: forall s. Int -> SparseHeap s -> ST s (SparseHeap s)
extendSparseHeap Int
capacity1 heap :: SparseHeap s
heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = do
Int
capacity2 <- MutablePrimArray (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dense
let capacity :: Int
capacity = Int -> Int
nextPowerOf2 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
capacity2 Int
capacity1)
if Int
capacity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
capacity2
then SparseHeap s -> ST s (SparseHeap s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return SparseHeap s
heap
else do
MutablePrimArray s Int
dense' <- MutablePrimArray (PrimState (ST s)) Int
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dense Int
capacity
MutablePrimArray s Int
sparse' <- MutablePrimArray (PrimState (ST s)) Int
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
sparse Int
capacity
MutablePrimArray s Weight
weight' <- MutablePrimArray (PrimState (ST s)) Weight
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Weight)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Weight
MutablePrimArray (PrimState (ST s)) Weight
weight Int
capacity
MutablePrimArray s Weight -> Int -> Int -> Weight -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> Int -> a -> ST s ()
setPrimArray MutablePrimArray s Weight
weight' Int
capacity2 (Int
capacity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
capacity2) Weight
0
SparseHeap s -> ST s (SparseHeap s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return SH { PrimVar s Int
size :: PrimVar s Int
size :: PrimVar s Int
size, dense :: MutablePrimArray s Int
dense = MutablePrimArray s Int
dense', sparse :: MutablePrimArray s Int
sparse = MutablePrimArray s Int
sparse', weight :: MutablePrimArray s Weight
weight = MutablePrimArray s Weight
weight' }
memberSparseHeap :: SparseHeap s -> Int -> ST s Bool
memberSparseHeap :: forall s. SparseHeap s -> Int -> ST s Bool
memberSparseHeap heap :: SparseHeap s
heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} Int
x = String -> SparseHeap s -> ST s Bool -> ST s Bool
forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
"member" SparseHeap s
heap (ST s Bool -> ST s Bool) -> ST s Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
Int
i <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
sparse Int
x
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then do
Int
x' <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x)
else Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
insertSparseHeap :: SparseHeap s -> Int -> ST s ()
insertSparseHeap :: forall s. SparseHeap s -> Int -> ST s ()
insertSparseHeap heap :: SparseHeap s
heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} Int
x = String -> SparseHeap s -> ST s () -> ST s ()
forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
"insert" SparseHeap s
heap (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
Int
i <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
sparse Int
x
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then do
Int
x' <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x' then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return () else Int -> ST s ()
insert Int
n
else Int -> ST s ()
insert Int
n
where
{-# INLINE insert #-}
insert :: Int -> ST s ()
insert !Int
n = do
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
dense Int
n Int
x
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
sparse Int
x Int
n
PrimVar (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Weight
u <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
x
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
swim (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
n Int
x Weight
u
deleteSparseHeap :: SparseHeap s -> Int -> ST s ()
deleteSparseHeap :: forall s. SparseHeap s -> Int -> ST s ()
deleteSparseHeap heap :: SparseHeap s
heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} Int
x = String -> SparseHeap s -> ST s () -> ST s ()
forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
"delete" SparseHeap s
heap (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
Int
i <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
sparse Int
x
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then do
Int
x' <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x' then Int -> Int -> ST s ()
delete Int
i Int
n else () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
{-# INLINE delete #-}
delete :: Int -> Int -> ST s ()
delete !Int
i !Int
n = do
let !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
PrimVar (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size Int
n'
if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n'
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Int -> Int -> ST s ()
swimSink Int
n' Int
i
swimSink :: Int -> Int -> ST s ()
swimSink Int
n Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
= do
let !j :: Int
j = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1
Int
y <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
j Int
y
Int -> Int -> ST s ()
swimSink Int
n Int
j
| Bool
otherwise
= do
let j :: Int
j = Int
n
PrimVar (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size Int
j
Int
y <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
y
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
0 Int
x Int
j Int
y
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
j MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
0 Int
y Weight
v
{-# INLINE swap' #-}
swap' :: MutablePrimArray s Int -> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' :: forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' !MutablePrimArray s Int
dense !MutablePrimArray s Int
sparse !Int
i !Int
x !Int
j !Int
y = do
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
dense Int
j Int
x
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
dense Int
i Int
y
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
sparse Int
x Int
j
MutablePrimArray s Int -> Int -> Int -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Int
sparse Int
y Int
i
sink :: Int -> MutablePrimArray s Int -> MutablePrimArray s Int -> MutablePrimArray s Weight -> Int -> Int -> Weight -> ST s ()
sink :: forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink !Int
n !MutablePrimArray s Int
dense !MutablePrimArray s Int
sparse !MutablePrimArray s Weight
weight !Int
i !Int
x !Weight
u
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
= do
Int
l <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Int
r <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
k
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
l
Weight
w <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
r
if Int -> Weight -> Int -> Weight -> Bool
le Int
x Weight
u Int
l Weight
v
then do
if Int -> Weight -> Int -> Weight -> Bool
le Int
x Weight
u Int
r Weight
w
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
k Int
r
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
k Int
x Weight
u
else do
if Int -> Weight -> Int -> Weight -> Bool
le Int
l Weight
v Int
r Weight
w
then do
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
j Int
l
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
j Int
x Weight
u
else do
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
k Int
r
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
k Int
x Weight
u
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
= do
Int
l <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
l
if Int -> Weight -> Int -> Weight -> Bool
le Int
x Weight
u Int
l Weight
v
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
j Int
l
| Bool
otherwise
= () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
!j :: Int
j = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!k :: Int
k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
swim :: Int -> MutablePrimArray s Int -> MutablePrimArray s Int -> MutablePrimArray s Weight -> Int -> Int -> Weight -> ST s ()
swim :: forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
swim !Int
_n !MutablePrimArray s Int
dense !MutablePrimArray s Int
sparse !MutablePrimArray s Weight
weight !Int
i !Int
x !Weight
u
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
= () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do
let !j :: Int
j = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1
Int
y <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
y
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Weight -> Int -> Weight -> Bool
le Int
y Weight
v Int
x Weight
u) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
i Int
x Int
j Int
y
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
swim Int
_n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
j Int
x Weight
u
modifyWeightSparseHeap :: forall s. SparseHeap s -> Int -> (Weight -> Weight) -> ST s ()
modifyWeightSparseHeap :: forall s. SparseHeap s -> Int -> (Weight -> Weight) -> ST s ()
modifyWeightSparseHeap heap :: SparseHeap s
heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} !Int
x Weight -> Weight
f = String -> SparseHeap s -> ST s () -> ST s ()
forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
"modify" SparseHeap s
heap (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Weight
u' <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
x
let !u :: Weight
u = Weight -> Weight
f Weight
u'
MutablePrimArray s Weight -> Int -> Weight -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Weight
weight Int
x Weight
u
if Weight
u Weight -> Weight -> Bool
forall a. Eq a => a -> a -> Bool
== Weight
u'
then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
Int
i <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
sparse Int
x
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then do
Int
x' <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x' then Int -> Int -> Weight -> Weight -> ST s ()
balance Int
n Int
i Weight
u Weight
u' else () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
balance :: Int -> Int -> Weight -> Weight -> ST s ()
balance :: Int -> Int -> Weight -> Weight -> ST s ()
balance !Int
n !Int
i !Weight
u !Weight
u'
| Weight
u Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
>= Weight
u'
= Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
swim Int
n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
i Int
x Weight
u
| Bool
otherwise
= Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
n MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
i Int
x Weight
u
{-# INLINE modifyWeightSparseHeap #-}
scaleWeightsSparseHeap :: forall s. SparseHeap s -> (Weight -> Weight) -> ST s ()
scaleWeightsSparseHeap :: forall s. SparseHeap s -> (Weight -> Weight) -> ST s ()
scaleWeightsSparseHeap heap :: SparseHeap s
heap@SH{PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} Weight -> Weight
f = String -> SparseHeap s -> ST s () -> ST s ()
forall s a. String -> SparseHeap s -> ST s a -> ST s a
checking String
"scale" SparseHeap s
heap (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
!Int
capacity <- MutablePrimArray (PrimState (ST s)) Weight -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Weight
MutablePrimArray (PrimState (ST s)) Weight
weight
Int -> Int -> ST s ()
go Int
capacity Int
0
where
go :: Int -> Int -> ST s ()
go !Int
n !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Weight
u <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
i
MutablePrimArray s Weight -> Int -> Weight -> ST s ()
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> a -> ST s ()
writePrimArray MutablePrimArray s Weight
weight Int
i (Weight -> Weight
f Weight
u)
popSparseHeap :: SparseHeap s -> ST s (Maybe Int)
popSparseHeap :: forall s. SparseHeap s -> ST s (Maybe Int)
popSparseHeap SparseHeap s
heap = SparseHeap s
-> ST s (Maybe Int)
-> (Int -> ST s (Maybe Int))
-> ST s (Maybe Int)
forall s r. SparseHeap s -> ST s r -> (Int -> ST s r) -> ST s r
popSparseHeap_ SparseHeap s
heap (Maybe Int -> ST s (Maybe Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing) (Maybe Int -> ST s (Maybe Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ST s (Maybe Int))
-> (Int -> Maybe Int) -> Int -> ST s (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just)
{-# INLINE popSparseHeap_ #-}
popSparseHeap_ :: SparseHeap s -> ST s r -> (Int -> ST s r) -> ST s r
popSparseHeap_ :: forall s r. SparseHeap s -> ST s r -> (Int -> ST s r) -> ST s r
popSparseHeap_ _heap :: SparseHeap s
_heap@SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} ST s r
no Int -> ST s r
yes = do
CHECK("pop pre", _heap)
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then ST s r
no
else do
let !j :: Int
j = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
PrimVar (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size Int
j
Int
x <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
0
Int
y <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
j
Weight
v <- MutablePrimArray s Weight -> Int -> ST s Weight
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Weight
weight Int
y
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
forall s.
MutablePrimArray s Int
-> MutablePrimArray s Int -> Int -> Int -> Int -> Int -> ST s ()
swap' MutablePrimArray s Int
dense MutablePrimArray s Int
sparse Int
0 Int
x Int
j Int
y
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
forall s.
Int
-> MutablePrimArray s Int
-> MutablePrimArray s Int
-> MutablePrimArray s Weight
-> Int
-> Int
-> Weight
-> ST s ()
sink Int
j MutablePrimArray s Int
dense MutablePrimArray s Int
sparse MutablePrimArray s Weight
weight Int
0 Int
y Weight
v
CHECK("pop post", _heap)
Int -> ST s r
yes Int
x
clearSparseHeap :: SparseHeap s -> ST s ()
clearSparseHeap :: forall s. SparseHeap s -> ST s ()
clearSparseHeap SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = do
PrimVar (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size Int
0
elemsSparseHeap :: SparseHeap s -> ST s [Int]
elemsSparseHeap :: forall s. SparseHeap s -> ST s [Int]
elemsSparseHeap SH {PrimVar s Int
MutablePrimArray s Int
MutablePrimArray s Weight
size :: forall s. SparseHeap s -> PrimVar s Int
dense :: forall s. SparseHeap s -> MutablePrimArray s Int
sparse :: forall s. SparseHeap s -> MutablePrimArray s Int
weight :: forall s. SparseHeap s -> MutablePrimArray s Weight
size :: PrimVar s Int
dense :: MutablePrimArray s Int
sparse :: MutablePrimArray s Int
weight :: MutablePrimArray s Weight
..} = do
Int
n <- PrimVar (PrimState (ST s)) Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar s Int
PrimVar (PrimState (ST s)) Int
size
[Int] -> Int -> Int -> ST s [Int]
go [] Int
0 Int
n
where
go :: [Int] -> Int -> Int -> ST s [Int]
go ![Int]
acc !Int
i !Int
n
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
= do
Int
x <- MutablePrimArray s Int -> Int -> ST s Int
forall a s.
(HasCallStack, Prim a) =>
MutablePrimArray s a -> Int -> ST s a
readPrimArray MutablePrimArray s Int
dense Int
i
[Int] -> Int -> Int -> ST s [Int]
go (Int
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
n
| Bool
otherwise
= [Int] -> ST s [Int]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
acc)
drainSparseHeap :: SparseHeap s -> ST s [Int]
drainSparseHeap :: forall s. SparseHeap s -> ST s [Int]
drainSparseHeap SparseHeap s
heap = ([Int] -> [Int]) -> ST s [Int]
go [Int] -> [Int]
forall a. a -> a
id where
go :: ([Int] -> [Int]) -> ST s [Int]
go [Int] -> [Int]
acc = SparseHeap s -> ST s [Int] -> (Int -> ST s [Int]) -> ST s [Int]
forall s r. SparseHeap s -> ST s r -> (Int -> ST s r) -> ST s r
popSparseHeap_ SparseHeap s
heap
([Int] -> ST s [Int]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> [Int]
acc []))
(\Int
x -> ([Int] -> [Int]) -> ST s [Int]
go ([Int] -> [Int]
acc ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)))