diff --git a/HFrequencyQueue.cabal b/HFrequencyQueue.cabal --- a/HFrequencyQueue.cabal +++ b/HFrequencyQueue.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: A Queue with a random (weighted) pick function @@ -53,7 +53,7 @@ library -- Modules exported by the library. - exposed-modules: Data.FrequencyQueue.IO + exposed-modules: FrequencyQueue FrequencyQueue.IO -- Modules included in this library but not exported. -- other-modules: diff --git a/cbits/hfrequencyqueue_backend.cpp b/cbits/hfrequencyqueue_backend.cpp --- a/cbits/hfrequencyqueue_backend.cpp +++ b/cbits/hfrequencyqueue_backend.cpp @@ -1,6 +1,6 @@ #include -#include "Data/FrequencyQueue/IO_stub.h" +#include "FrequencyQueue/IO_stub.h" #include "hfrequencyqueue_backend.h" @@ -12,7 +12,6 @@ return (a.probability > b.probability); }; - FrequencyQueue::FrequencyQueue(unsigned int seed){ cumulative_probability = 0; @@ -22,20 +21,16 @@ FrequencyQueue::FrequencyQueue(const FrequencyQueue& other){ - minstd_rand0 tmp_gen = other.generator; - unsigned int seed = tmp_gen(); - generator = minstd_rand0(seed); + generator = other.generator; cumulative_probability = other.cumulative_probability; internal_vector = other.internal_vector; new_stable_ref_all(); } FrequencyQueue& FrequencyQueue::operator= (FrequencyQueue& other){ + free_all_pointers(); - - minstd_rand0 tmp_gen = other.generator; - unsigned int seed = tmp_gen(); - generator = minstd_rand0(seed); + generator = other.generator; cumulative_probability = other.cumulative_probability; internal_vector = other.internal_vector; new_stable_ref_all(); @@ -104,7 +99,8 @@ unsigned int FrequencyQueue::get_random_number(){ - return generator(); + minstd_rand0 tmp_generator = generator; + return tmp_generator(); } FrequencyQueue::~FrequencyQueue(){ diff --git a/src/Data/FrequencyQueue/IO.hs b/src/Data/FrequencyQueue/IO.hs deleted file mode 100644 --- a/src/Data/FrequencyQueue/IO.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# CFILES cbits/hfrequencyqueue_backend.cpp #-} -{-| -Module : Data.FrequencyQueue.IO -Description : Provide the IO interface for FrequencyQueue -Copyright : (c) Andrea Bellandi 2014 -License : GPL-3 -Maintainer : bellaz89@gmai.com -Stability : experimental -Portability : POSIX - -This module export the IO interface of FrequencyQueue. --} -module Data.FrequencyQueue.IO( - -- *Types - FrequencyQueue(), - -- *Functions - -- **Creation functions - newFrequencyQueue, cloneFrequencyQueue, - -- **Basic properties - length, probabilityUnit, - -- **Pop-push functions - pushBack, popBack, popBackMax, popBackMin, getRandom, getRandomPop, - -- **Iterative functions - mapWprobability, foldWprobability, - -- **Unsafe interface - popBackUnsafe, popBackMaxUnsafe, popBackMinUnsafe, getRandomUnsafe, getRandomPopUnsafe) where - -import Prelude hiding (length) -import GHC.Generics - -import Control.Monad(replicateM) -import Foreign.Concurrent(newForeignPtr) -import Foreign.Marshal.Utils(new) -import Foreign.Marshal.Alloc(free) -import Foreign.CStorable(CStorable, cAlignment, cSizeOf, cPoke, cPeek) -import Foreign.Storable(Storable, alignment, sizeOf, poke, peek) -import Foreign.ForeignPtr(ForeignPtr, withForeignPtr) -import Foreign.StablePtr(StablePtr, deRefStablePtr, freeStablePtr, newStablePtr) -import Foreign.Ptr(Ptr) -import Foreign.C.Types - -type FrequencyQueue_ a = Ptr a - --- | FrequencyQueue the basic type of the Library -data FrequencyQueue a = FrequencyQueue{ queue :: ForeignPtr a} - -data RandomElement a = RandomElement{ probability :: CUInt, - element :: StablePtr a} - deriving(Generic) - - -instance CStorable (StablePtr a) where - cAlignment = alignment - cSizeOf = sizeOf - cPoke = poke - cPeek = peek - -instance CStorable (RandomElement a) - -instance Storable (RandomElement a) where - alignment = cAlignment - sizeOf = cSizeOf - poke = cPoke - peek = cPeek - --- the foreign import shouldn't call functions that call-back the GHC runtime (clone_FrequencyQueue_priv_ and free_FrequencyQueue_priv_) --- unsafely. Functions that are called unsafely should have constant or constant amortized time to not block the caller OS too much. -foreign import ccall unsafe new_FrequencyQueue_priv_ :: CUInt -> IO (FrequencyQueue_ a) -foreign import ccall clone_FrequencyQueue_priv_ :: (FrequencyQueue_ a) -> IO (FrequencyQueue_ a) -foreign import ccall unsafe length_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) -foreign import ccall unsafe probability_unit_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) -foreign import ccall unsafe push_back_priv_ :: (FrequencyQueue_ a) -> (Ptr (RandomElement a)) -> IO () -foreign import ccall unsafe pop_back_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall pop_back_max_prob_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall pop_back_min_prob_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall get_random_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall get_random_pop_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall unsafe reset_iterator_priv_ :: (FrequencyQueue_ a) -> IO () -foreign import ccall unsafe get_next_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) -foreign import ccall unsafe get_random_number_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) -foreign import ccall free_FrequencyQueue_priv_ :: FrequencyQueue_ a -> IO () -foreign import ccall unsafe free_RandomElement_priv_ :: (Ptr (RandomElement a)) -> IO () -foreign export ccall freeStablePtr :: StablePtr a -> IO () -foreign export ccall makeNewStableRef :: StablePtr a -> IO (StablePtr a) - -makeNewStableRef :: StablePtr a -> IO (StablePtr a) -makeNewStableRef ptr = deRefStablePtr ptr >>= newStablePtr - --- |Create a new FrequencyQueue with a seed -newFrequencyQueue :: Int -> IO (FrequencyQueue a) -newFrequencyQueue seed = do rawqueue <- new_FrequencyQueue_priv_ (fromIntegral seed) - queue_ <- newForeignPtr rawqueue (free_FrequencyQueue_priv_ rawqueue) - return (FrequencyQueue queue_) - --- |Make a clone of the FrequencyQueue Passed -cloneFrequencyQueue :: FrequencyQueue a -> IO (FrequencyQueue a) -cloneFrequencyQueue oldqueue = do rawqueue <- withForeignPtr (queue oldqueue) clone_FrequencyQueue_priv_ - queue_ <- newForeignPtr rawqueue (free_FrequencyQueue_priv_ rawqueue) - return (FrequencyQueue queue_) - --- |Return the number of elements in the queue -length :: FrequencyQueue a -> IO Int -length queue_ = withForeignPtr (queue queue_) length_priv_ >>= (return . fromIntegral) - --- |Return the sum of all elements' probabilities passed to the queue -probabilityUnit :: FrequencyQueue a -> IO Int -probabilityUnit queue_ = withForeignPtr (queue queue_) probability_unit_priv_ >>= (return . fromIntegral) - --- |Push an element a in the queue with a corresponding relative probability -pushBack :: FrequencyQueue a -> a -> Int -> IO() -pushBack queue_ element_ probability_ = do stableElement_ <- newStablePtr element_ - let cUIntProbability = (fromIntegral probability_) - let randomElement_ = RandomElement cUIntProbability stableElement_ - allocatedElement_ <- new randomElement_ - withForeignPtr (queue queue_) (\x -> push_back_priv_ x allocatedElement_) - free allocatedElement_ - --- |Pop an element of the queue. Return Nothing if the queue is empty -popBack :: FrequencyQueue a -> IO (Maybe (a,Int)) -popBack queue_ = makeSafePop queue_ popBackUnsafe - --- |Pop the element of the queue that have the biggest relative probability. --- Return Nothing if the queue is empty -popBackMax :: FrequencyQueue a -> IO (Maybe (a,Int)) -popBackMax queue_ = makeSafePop queue_ popBackMaxUnsafe - --- |Pop the element of the queue that have the smallest relative probability. --- Return Nothing if the queue is empty -popBackMin :: FrequencyQueue a -> IO (Maybe (a,Int)) -popBackMin queue_ = makeSafePop queue_ popBackMinUnsafe - --- |Return a random element from the queue using its relative probability. --- Return Nothing if the queue is empty -getRandom :: FrequencyQueue a -> IO (Maybe (a,Int)) -getRandom queue_ = makeSafePop queue_ getRandomUnsafe - --- |Pop a random element from the queue using its relative probability. --- Return Nothing if the queue is empty -getRandomPop :: FrequencyQueue a -> IO (Maybe (a,Int)) -getRandomPop queue_ = makeSafePop queue_ getRandomPopUnsafe - --- |Return a new queue with the elements and relative probability mapped --- by the function provided -mapWprobability :: ((a, Int) -> (b, Int)) -> FrequencyQueue a -> IO (FrequencyQueue b) -mapWprobability fun queue_ = do rnd_number <- withForeignPtr (queue queue_) get_random_number_priv_ - queue_length <- length queue_ - newqueue_ <- newFrequencyQueue (fromIntegral rnd_number) - withForeignPtr (queue queue_) reset_iterator_priv_ - replicateM (queue_length) (trasformCopyQueue queue_ newqueue_) - return newqueue_ - where - trasformCopyQueue q1 q2 = do ptr_rawelement <- withForeignPtr (queue q1) get_next_priv_ - result <- peek ptr_rawelement - let probability_ = probability result - let elementStable_ = element result - element_ <- deRefStablePtr elementStable_ - let transformed_element_ = fun (element_, fromIntegral probability_) - pushBack q2 (fst transformed_element_) (snd transformed_element_) - --- |Return a folded value made by an initial value b and a folding function --- evaluated on the entire queue. -foldWprobability :: (b -> (a, Int) -> b) -> b -> FrequencyQueue a -> IO b -foldWprobability fold_fun b0 queue_ = do withForeignPtr (queue queue_) reset_iterator_priv_ - queue_length <- length queue_ - iterateOverFrequencyQueue queue_length b0 - where - iterateOverFrequencyQueue 0 acc = return acc - iterateOverFrequencyQueue nitem acc = do ptr_rawelement <- withForeignPtr (queue queue_) get_next_priv_ - result <- peek ptr_rawelement - let probability_ = probability result - let elementStable_ = element result - element_ <- deRefStablePtr elementStable_ - let next_acc = fold_fun acc (element_, fromIntegral probability_) - iterateOverFrequencyQueue (nitem-1) next_acc - --- |Pop an element of the queue. Fail if empty -popBackUnsafe :: FrequencyQueue a -> IO (a, Int) -popBackUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_priv_ - deRefRawElementPtr ptr_rawelement - --- |Pop the element of the queue that have the biggest relative probability. --- Fail if empty -popBackMaxUnsafe :: FrequencyQueue a -> IO (a, Int) -popBackMaxUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_max_prob_priv_ - deRefRawElementPtr ptr_rawelement - --- |Pop the element of the queue that have the smallest relative probability. --- Fail if empty -popBackMinUnsafe :: FrequencyQueue a -> IO (a, Int) -popBackMinUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_min_prob_priv_ - deRefRawElementPtr ptr_rawelement - --- |Pop the element of the queue that have the smallest relative probability. --- Fail if empty -getRandomUnsafe :: FrequencyQueue a -> IO (a, Int) -getRandomUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) get_random_priv_ - result <- peek ptr_rawelement - let probability_ = probability result - let elementStable_ = element result - element_ <- deRefStablePtr elementStable_ - return (element_, fromIntegral probability_) - --- |Pop a random element from the queue using its relative probability. --- Fail if empty -getRandomPopUnsafe :: FrequencyQueue a -> IO (a, Int) -getRandomPopUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) get_random_pop_priv_ - deRefRawElementPtr ptr_rawelement - -deRefRawElementPtr :: Ptr (RandomElement a) -> IO (a, Int) -deRefRawElementPtr ptr_rawelement = do result <- peek ptr_rawelement - free_RandomElement_priv_ ptr_rawelement - let probability_ = probability result - let elementStable_ = element result - element_ <- deRefStablePtr elementStable_ - freeStablePtr elementStable_ - return (element_, fromIntegral probability_) - -makeSafePop :: FrequencyQueue a -> (FrequencyQueue a -> IO (a, Int)) -> IO (Maybe (a,Int)) -makeSafePop queue_ unsafefun = do qlength <- length queue_ - if qlength == 0 - then return Nothing - else (unsafefun queue_) >>= (\x -> return (Just x)) diff --git a/src/FrequencyQueue.hs b/src/FrequencyQueue.hs new file mode 100644 --- /dev/null +++ b/src/FrequencyQueue.hs @@ -0,0 +1,136 @@ +{-| +Module : FrequencyQueue +Description : Main module for FrequencyQueue +Copyright : (c) Andrea Bellandi 2014 +License : GPL-3 +Maintainer : bellaz89@gmai.com +Stability : experimental +Portability : POSIX + +This module export the interface of FrequencyQueue. +-} +module FrequencyQueue( + -- *Types + FrequencyQueue(), + -- *Functions + -- **Creation functions + newFrequencyQueue, + -- **Basic properties + length, probabilityUnit, + -- **Pop-push functions + pushBack, popBack, popBackMax, popBackMin, getRandom, getRandomPop, + -- **Iterative functions + mapWprobability, foldWprobability, + -- **Unsafe interface + popBackUnsafe, popBackMaxUnsafe, popBackMinUnsafe, getRandomUnsafe, getRandomPopUnsafe) where + +import Prelude hiding (length) +import System.IO.Unsafe(unsafePerformIO) +import FrequencyQueue.IO(FrequencyQueue) +import qualified FrequencyQueue.IO as FQIO +import Control.Monad(Functor(..)) +import Data.Foldable(Foldable(..)) + +instance Functor FrequencyQueue where + fmap fun queue_ = mapWprobability (\(el,prob) -> (fun(el),prob)) queue_ + +instance Foldable FrequencyQueue where + foldr fun b0 queue_ = foldWprobability (\b (el,_) -> fun el b ) b0 queue_ + + +-- |Create a new FrequencyQueue with a seed +newFrequencyQueue :: Int -> FrequencyQueue a +newFrequencyQueue seed = (unsafePerformIO . FQIO.newFrequencyQueue) seed + +-- |Return the number of elements in the queue +length :: FrequencyQueue a -> Int +length queue_ = (unsafePerformIO . FQIO.length) queue_ + +-- |Return the sum of all elements' probabilities passed to the queue +probabilityUnit :: FrequencyQueue a -> Int +probabilityUnit queue_ = (unsafePerformIO . FQIO.probabilityUnit) queue_ + +-- |Push an element a in the queue with a corresponding relative probability +pushBack :: FrequencyQueue a -> a -> Int -> FrequencyQueue a +pushBack queue_ element_ probability_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + FQIO.pushBack newqueue_ element_ probability_ + return newqueue_ + +-- |Pop an element of the queue. Return Nothing if the queue is empty +popBack :: FrequencyQueue a -> Maybe ((a, Int), FrequencyQueue a) +popBack queue_ = if (length queue_) == 0 + then Nothing + else Just (popBackUnsafe queue_) + +-- |Pop the element of the queue that have the biggest relative probability. +-- Return Nothing if the queue is empty +popBackMax :: FrequencyQueue a -> Maybe ((a, Int), FrequencyQueue a) +popBackMax queue_ = if (length queue_) == 0 + then Nothing + else Just (popBackMaxUnsafe queue_) + +-- |Pop the element of the queue that have the smallest relative probability. +-- Return Nothing if the queue is empty +popBackMin :: FrequencyQueue a -> Maybe ((a, Int), FrequencyQueue a) +popBackMin queue_ = if (length queue_) == 0 + then Nothing + else Just (popBackMinUnsafe queue_) + +-- |Return a random element from the queue using its relative probability. +-- Return Nothing if the queue is empty +getRandom :: FrequencyQueue a -> Maybe ((a, Int), FrequencyQueue a) +getRandom queue_ = if (length queue_) == 0 + then Nothing + else Just (getRandomUnsafe queue_) + +-- |Pop a random element from the queue using its relative probability. +-- Return Nothing if the queue is empty +getRandomPop :: FrequencyQueue a -> Maybe ((a, Int), FrequencyQueue a) +getRandomPop queue_ = if (length queue_) == 0 + then Nothing + else Just (getRandomPopUnsafe queue_) + +-- |Return a new queue with the elements and relative probability mapped +-- by the function provided +mapWprobability :: ((a, Int) -> (b, Int)) -> FrequencyQueue a -> FrequencyQueue b +mapWprobability fun queue_ = unsafePerformIO $ FQIO.mapWprobability fun queue_ + +-- |Return a folded value made by an initial value b and a folding function +-- evaluated on the entire queue. +foldWprobability :: (b -> (a, Int) -> b) -> b -> FrequencyQueue a -> b +foldWprobability fold_fun b0 queue_ = unsafePerformIO $ FQIO.foldWprobability fold_fun b0 queue_ + +-- |Pop an element of the queue. Fail if empty +popBackUnsafe :: FrequencyQueue a -> ((a, Int), FrequencyQueue a) +popBackUnsafe queue_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + result <- FQIO.popBackUnsafe newqueue_ + return (result, newqueue_) + +-- |Pop the element of the queue that have the biggest relative probability. +-- Fail if empty +popBackMaxUnsafe :: FrequencyQueue a -> ((a, Int), FrequencyQueue a) +popBackMaxUnsafe queue_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + result <- FQIO.popBackMaxUnsafe newqueue_ + return (result, newqueue_) + +-- |Pop the element of the queue that have the smallest relative probability. +-- Fail if empty +popBackMinUnsafe :: FrequencyQueue a -> ((a, Int), FrequencyQueue a) +popBackMinUnsafe queue_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + result <- FQIO.popBackMinUnsafe newqueue_ + return (result, newqueue_) + +-- |Pop the element of the queue that have the smallest relative probability. +-- Fail if empty +getRandomUnsafe :: FrequencyQueue a -> ((a, Int), FrequencyQueue a) +getRandomUnsafe queue_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + result <- FQIO.getRandomUnsafe newqueue_ + return (result, newqueue_) + +-- |Pop a random element from the queue using its relative probability. +-- Fail if empty +getRandomPopUnsafe :: FrequencyQueue a -> ((a, Int), FrequencyQueue a) +getRandomPopUnsafe queue_ = unsafePerformIO $ do newqueue_ <- FQIO.cloneFrequencyQueue queue_ + result <- FQIO.getRandomPopUnsafe newqueue_ + return (result, newqueue_) + diff --git a/src/FrequencyQueue/IO.hs b/src/FrequencyQueue/IO.hs new file mode 100644 --- /dev/null +++ b/src/FrequencyQueue/IO.hs @@ -0,0 +1,223 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# CFILES cbits/hfrequencyqueue_backend.cpp #-} +{-| +Module : FrequencyQueue.IO +Description : Provide the IO interface for FrequencyQueue +Copyright : (c) Andrea Bellandi 2014 +License : GPL-3 +Maintainer : bellaz89@gmai.com +Stability : experimental +Portability : POSIX + +This module export the IO interface of FrequencyQueue. +-} +module FrequencyQueue.IO( + -- *Types + FrequencyQueue(), + -- *Functions + -- **Creation functions + newFrequencyQueue, cloneFrequencyQueue, + -- **Basic properties + length, probabilityUnit, + -- **Pop-push functions + pushBack, popBack, popBackMax, popBackMin, getRandom, getRandomPop, + -- **Iterative functions + mapWprobability, foldWprobability, + -- **Unsafe interface + popBackUnsafe, popBackMaxUnsafe, popBackMinUnsafe, getRandomUnsafe, getRandomPopUnsafe) where + +import Prelude hiding (length) +import GHC.Generics + +import Control.Monad(replicateM) +import Foreign.Concurrent(newForeignPtr) +import Foreign.Marshal.Utils(new) +import Foreign.Marshal.Alloc(free) +import Foreign.CStorable(CStorable, cAlignment, cSizeOf, cPoke, cPeek) +import Foreign.Storable(Storable, alignment, sizeOf, poke, peek) +import Foreign.ForeignPtr(ForeignPtr, withForeignPtr) +import Foreign.StablePtr(StablePtr, deRefStablePtr, freeStablePtr, newStablePtr) +import Foreign.Ptr(Ptr) +import Foreign.C.Types + +type FrequencyQueue_ a = Ptr a + +-- | FrequencyQueue the basic type of the Library +data FrequencyQueue a = FrequencyQueue{ queue :: ForeignPtr a} + +data RandomElement a = RandomElement{ probability :: CUInt, + element :: StablePtr a} + deriving(Generic) + + +instance CStorable (StablePtr a) where + cAlignment = alignment + cSizeOf = sizeOf + cPoke = poke + cPeek = peek + +instance CStorable (RandomElement a) + +instance Storable (RandomElement a) where + alignment = cAlignment + sizeOf = cSizeOf + poke = cPoke + peek = cPeek + +-- the foreign import shouldn't call functions that call-back the GHC runtime (clone_FrequencyQueue_priv_ and free_FrequencyQueue_priv_) +-- unsafely. Functions that are called unsafely should have constant or constant amortized time to not block the caller OS too much. +foreign import ccall unsafe new_FrequencyQueue_priv_ :: CUInt -> IO (FrequencyQueue_ a) +foreign import ccall clone_FrequencyQueue_priv_ :: (FrequencyQueue_ a) -> IO (FrequencyQueue_ a) +foreign import ccall unsafe length_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) +foreign import ccall unsafe probability_unit_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) +foreign import ccall unsafe push_back_priv_ :: (FrequencyQueue_ a) -> (Ptr (RandomElement a)) -> IO () +foreign import ccall unsafe pop_back_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall pop_back_max_prob_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall pop_back_min_prob_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall get_random_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall get_random_pop_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall unsafe reset_iterator_priv_ :: (FrequencyQueue_ a) -> IO () +foreign import ccall unsafe get_next_priv_ :: (FrequencyQueue_ a) -> IO (Ptr (RandomElement a)) +foreign import ccall unsafe get_random_number_priv_ :: (FrequencyQueue_ a) -> IO (CUInt) +foreign import ccall free_FrequencyQueue_priv_ :: FrequencyQueue_ a -> IO () +foreign import ccall unsafe free_RandomElement_priv_ :: (Ptr (RandomElement a)) -> IO () +foreign export ccall freeStablePtr :: StablePtr a -> IO () +foreign export ccall makeNewStableRef :: StablePtr a -> IO (StablePtr a) + +makeNewStableRef :: StablePtr a -> IO (StablePtr a) +makeNewStableRef ptr = deRefStablePtr ptr >>= newStablePtr + +-- |Create a new FrequencyQueue with a seed +newFrequencyQueue :: Int -> IO (FrequencyQueue a) +newFrequencyQueue seed = do rawqueue <- new_FrequencyQueue_priv_ (fromIntegral seed) + queue_ <- newForeignPtr rawqueue (free_FrequencyQueue_priv_ rawqueue) + return (FrequencyQueue queue_) + +-- |Make a clone of the FrequencyQueue Passed +cloneFrequencyQueue :: FrequencyQueue a -> IO (FrequencyQueue a) +cloneFrequencyQueue oldqueue = do rawqueue <- withForeignPtr (queue oldqueue) clone_FrequencyQueue_priv_ + queue_ <- newForeignPtr rawqueue (free_FrequencyQueue_priv_ rawqueue) + return (FrequencyQueue queue_) + +-- |Return the number of elements in the queue +length :: FrequencyQueue a -> IO Int +length queue_ = withForeignPtr (queue queue_) length_priv_ >>= (return . fromIntegral) + +-- |Return the sum of all elements' probabilities passed to the queue +probabilityUnit :: FrequencyQueue a -> IO Int +probabilityUnit queue_ = withForeignPtr (queue queue_) probability_unit_priv_ >>= (return . fromIntegral) + +-- |Push an element a in the queue with a corresponding relative probability +pushBack :: FrequencyQueue a -> a -> Int -> IO() +pushBack queue_ element_ probability_ = do stableElement_ <- newStablePtr element_ + let cUIntProbability = (fromIntegral probability_) + let randomElement_ = RandomElement cUIntProbability stableElement_ + allocatedElement_ <- new randomElement_ + withForeignPtr (queue queue_) (\x -> push_back_priv_ x allocatedElement_) + free allocatedElement_ + +-- |Pop an element of the queue. Return Nothing if the queue is empty +popBack :: FrequencyQueue a -> IO (Maybe (a,Int)) +popBack queue_ = makeSafePop queue_ popBackUnsafe + +-- |Pop the element of the queue that have the biggest relative probability. +-- Return Nothing if the queue is empty +popBackMax :: FrequencyQueue a -> IO (Maybe (a,Int)) +popBackMax queue_ = makeSafePop queue_ popBackMaxUnsafe + +-- |Pop the element of the queue that have the smallest relative probability. +-- Return Nothing if the queue is empty +popBackMin :: FrequencyQueue a -> IO (Maybe (a,Int)) +popBackMin queue_ = makeSafePop queue_ popBackMinUnsafe + +-- |Return a random element from the queue using its relative probability. +-- Return Nothing if the queue is empty +getRandom :: FrequencyQueue a -> IO (Maybe (a,Int)) +getRandom queue_ = makeSafePop queue_ getRandomUnsafe + +-- |Pop a random element from the queue using its relative probability. +-- Return Nothing if the queue is empty +getRandomPop :: FrequencyQueue a -> IO (Maybe (a,Int)) +getRandomPop queue_ = makeSafePop queue_ getRandomPopUnsafe + +-- |Return a new queue with the elements and relative probability mapped +-- by the function provided +mapWprobability :: ((a, Int) -> (b, Int)) -> FrequencyQueue a -> IO (FrequencyQueue b) +mapWprobability fun queue_ = do rnd_number <- withForeignPtr (queue queue_) get_random_number_priv_ + queue_length <- length queue_ + newqueue_ <- newFrequencyQueue (fromIntegral rnd_number) + withForeignPtr (queue queue_) reset_iterator_priv_ + replicateM (queue_length) (trasformCopyQueue queue_ newqueue_) + return newqueue_ + where + trasformCopyQueue q1 q2 = do ptr_rawelement <- withForeignPtr (queue q1) get_next_priv_ + result <- peek ptr_rawelement + let probability_ = probability result + let elementStable_ = element result + element_ <- deRefStablePtr elementStable_ + let transformed_element_ = fun (element_, fromIntegral probability_) + pushBack q2 (fst transformed_element_) (snd transformed_element_) + +-- |Return a folded value made by an initial value b and a folding function +-- evaluated on the entire queue. +foldWprobability :: (b -> (a, Int) -> b) -> b -> FrequencyQueue a -> IO b +foldWprobability fold_fun b0 queue_ = do withForeignPtr (queue queue_) reset_iterator_priv_ + queue_length <- length queue_ + iterateOverFrequencyQueue queue_length b0 + where + iterateOverFrequencyQueue 0 acc = return acc + iterateOverFrequencyQueue nitem acc = do ptr_rawelement <- withForeignPtr (queue queue_) get_next_priv_ + result <- peek ptr_rawelement + let probability_ = probability result + let elementStable_ = element result + element_ <- deRefStablePtr elementStable_ + let next_acc = fold_fun acc (element_, fromIntegral probability_) + iterateOverFrequencyQueue (nitem-1) next_acc + +-- |Pop an element of the queue. Fail if empty +popBackUnsafe :: FrequencyQueue a -> IO (a, Int) +popBackUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_priv_ + deRefRawElementPtr ptr_rawelement + +-- |Pop the element of the queue that have the biggest relative probability. +-- Fail if empty +popBackMaxUnsafe :: FrequencyQueue a -> IO (a, Int) +popBackMaxUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_max_prob_priv_ + deRefRawElementPtr ptr_rawelement + +-- |Pop the element of the queue that have the smallest relative probability. +-- Fail if empty +popBackMinUnsafe :: FrequencyQueue a -> IO (a, Int) +popBackMinUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) pop_back_min_prob_priv_ + deRefRawElementPtr ptr_rawelement + +-- |Pop the element of the queue that have the smallest relative probability. +-- Fail if empty +getRandomUnsafe :: FrequencyQueue a -> IO (a, Int) +getRandomUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) get_random_priv_ + result <- peek ptr_rawelement + let probability_ = probability result + let elementStable_ = element result + element_ <- deRefStablePtr elementStable_ + return (element_, fromIntegral probability_) + +-- |Pop a random element from the queue using its relative probability. +-- Fail if empty +getRandomPopUnsafe :: FrequencyQueue a -> IO (a, Int) +getRandomPopUnsafe queue_ = do ptr_rawelement <- withForeignPtr (queue queue_) get_random_pop_priv_ + deRefRawElementPtr ptr_rawelement + +deRefRawElementPtr :: Ptr (RandomElement a) -> IO (a, Int) +deRefRawElementPtr ptr_rawelement = do result <- peek ptr_rawelement + free_RandomElement_priv_ ptr_rawelement + let probability_ = probability result + let elementStable_ = element result + element_ <- deRefStablePtr elementStable_ + freeStablePtr elementStable_ + return (element_, fromIntegral probability_) + +makeSafePop :: FrequencyQueue a -> (FrequencyQueue a -> IO (a, Int)) -> IO (Maybe (a,Int)) +makeSafePop queue_ unsafefun = do qlength <- length queue_ + if qlength == 0 + then return Nothing + else (unsafefun queue_) >>= (\x -> return (Just x))