diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Antal Spector-Zabusky + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# urn-random +A Haskell package for updatable discrete distributions diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Urn.hs b/src/Data/Urn.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TupleSections #-} + +module Data.Urn ( + -- * Types + Urn, + Weight, + MonadSample, + -- * Construction + singleton, fromList, fromNonEmpty, + -- * Sampling + sample, sampleM, + remove, removeM, + -- * Updating + insert, + update, replace, + -- * Other functions + frequency, + addToUrn, + -- * 'Urn' properties + size, totalWeight +) where + +import Data.Urn.Common +import Data.Urn.Index (randomIndex) +import qualified Data.Urn.Index as Index + +sample :: MonadSample m => Urn a -> m a +sample u = Index.sample u <$> randomIndex u + +sampleM :: MonadSample m => Urn (m a) -> m a +sampleM u = Index.sample u =<< randomIndex u + +remove :: MonadSample m => Urn a -> m (Weight, a, Maybe (Urn a)) +remove u = Index.remove u <$> randomIndex u + +removeM :: MonadSample m => Urn (m a) -> m (Weight, a, Maybe (Urn (m a))) +removeM u = do (w,ma,mu) <- remove u + (w, ,mu) <$> ma + +update :: MonadSample m + => (Weight -> a -> (Weight, a)) + -> Urn a + -> m (Weight, a, Weight, a, Urn a) +update upd u = Index.update upd u <$> randomIndex u + +replace :: MonadSample m => Weight -> a -> Urn a -> m (Weight, a, Urn a) +replace w a u = Index.replace w a u <$> randomIndex u + +frequency :: MonadSample m => [(Weight, m a)] -> m a +frequency = maybe (error "Data.Urn.frequency used with empty list") sampleM . fromList diff --git a/src/Data/Urn/Common.hs b/src/Data/Urn/Common.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/Common.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_HADDOCK not-home #-} + +module Data.Urn.Common ( + -- * Types + Urn(), Weight, MonadSample(), + -- * 'Urn' properties + size, totalWeight, + -- * Constructing 'Urn's + singleton, + fromList, fromNonEmpty, + -- * Inserting into 'Urn's + insert, addToUrn +) where + +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) +import Data.Foldable +import Data.Coerce + +import Data.Urn.MonadSample +import Data.Urn.Internal hiding (size) +import qualified Data.Urn.Internal as Internal + +size :: Urn a -> Word +size = (coerce :: (Urn a -> Size) -> (Urn a -> Word)) Internal.size +{-# INLINABLE size #-} + +totalWeight :: Urn a -> Weight +totalWeight = weight . wtree +{-# INLINABLE totalWeight #-} + +singleton :: Weight -> a -> Urn a +singleton w a = Urn { Internal.size = 1, wtree = WLeaf w a } +{-# INLINABLE singleton #-} + +addToUrn :: Foldable t => Urn a -> t (Weight, a) -> Urn a +addToUrn = foldl' (flip $ uncurry insert) +{-# INLINABLE addToUrn #-} + +fromList :: [(Weight,a)] -> Maybe (Urn a) +fromList = fmap fromNonEmpty . nonEmpty +{-# INLINABLE fromList #-} + +fromNonEmpty :: NonEmpty (Weight,a) -> Urn a +-- fromNonEmpty ((w,t):|wts) = addToUrn (singleton w t) wts +fromNonEmpty = Internal.construct -- this is O(n) now +{-# INLINABLE fromNonEmpty #-} diff --git a/src/Data/Urn/Index.hs b/src/Data/Urn/Index.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/Index.hs @@ -0,0 +1,53 @@ +{-# OPTIONS_HADDOCK not-home #-} + +module Data.Urn.Index ( + -- * Types + Urn(), Index(), Weight(), MonadSample(), + -- * Constructing 'Urn's + singleton, fromList, fromNonEmpty, + -- * Constructing indices + randomIndex, + -- * Sampling + sample, + remove, + -- * Updating + insert, + update, replace, + -- * Other functions + addToUrn, + -- * 'Urn' properties + size, totalWeight +) where + +import Data.Urn.Common + +import Data.Urn.MonadSample +import qualified Data.Urn.Internal as Internal +import Data.Urn.Internal (Urn(Urn), Index(..)) + +randomIndex :: MonadSample m => Urn a -> m Index +randomIndex = Internal.randomIndexWith randomWord +{-# INLINABLE randomIndex #-} + +sample :: Urn a -> Index -> a +sample = Internal.sample . Internal.wtree + +remove :: Urn a -> Index -> (Weight, a, Maybe (Urn a)) +remove u (Index i) = + case Internal.uninsert u of + (w', a', lb, Just u') + | i < lb -> addJust $ replace w' a' u' (Index i) + | i < lb + w' -> (w', a', Just u') + | otherwise -> addJust $ replace w' a' u' (Index $ i - w') + (w', a', _lb, Nothing) -> (w', a', Nothing) + where addJust (w'',a'',u'') = (w'', a'', Just u'') + {-# INLINE addJust #-} + +update :: (Weight -> a -> (Weight, a)) -> Urn a -> Index -> (Weight, a, Weight, a, Urn a) +update upd (Urn size wt) i = + case Internal.update upd wt i of + (wOld, aOld, wNew, aNew, wt') -> (wOld, aOld, wNew, aNew, Urn size wt') + +replace :: Weight -> a -> Urn a -> Index -> (Weight, a, Urn a) +replace wNew aNew (Urn size wt) i = case Internal.replace wNew aNew wt i of + (w', a', wt') -> (w', a', Urn size wt') diff --git a/src/Data/Urn/Internal.hs b/src/Data/Urn/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/Internal.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, PatternSynonyms #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_HADDOCK not-home #-} + +module Data.Urn.Internal ( + -- * Types + -- ** Parameters of the trees + Weight, Index(..), Size(..), + -- ** Tree types (and constructors) + BTree(..), WTree(..), pattern WLeaf, pattern WNode, Urn(..), + -- * Sampling/lookup ('WTree's and 'BTree's) + sample, bsample, + -- * Insertion ('Urn's) + insert, uninsert, + -- * Update and construct ('WTree's) + update, replace, construct, + -- * General weight-based 'WTree' traversal + foldWTree, + -- * Raw random index generation + randomIndexWith, + -- * Debugging + showUrnTreeStructureWith, + showUrnTreeStructure +) where + +import Data.Bits +import Data.Urn.Internal.AlmostPerfect +import Data.List.NonEmpty (NonEmpty(..)) + +-- For 'NFData' instances +import Control.DeepSeq + +-- For the 'Show' instance +import qualified Data.Ord as Ord +import qualified Data.List as List + +---------------------------------------- + +type Weight = Word + +newtype Index = Index { getIndex :: Word } deriving (Eq, Ord, NFData) +-- This type is opaque, so there's no 'Show' instance. + +newtype Size = Size { getSize :: Word } + deriving ( Eq, Ord, Show, Bounded, Enum + , Num, Real, Integral + , Bits, FiniteBits + , NFData ) + +data BTree a = BLeaf a + | BNode !(WTree a) !(WTree a) + deriving (Eq, Ord, Show) + +data WTree a = WTree { weight :: !Weight + , btree :: !(BTree a) } + deriving (Eq, Ord, Show) + +pattern WLeaf :: Weight -> a -> WTree a +pattern WNode :: Weight -> WTree a -> WTree a -> WTree a +pattern WLeaf w a = WTree { weight = w, btree = BLeaf a } +pattern WNode w l r = WTree { weight = w, btree = BNode l r } + +data Urn a = Urn { size :: !Size + , wtree :: !(WTree a) } +-- TODO: 'Eq' and 'Ord' instances? We can provide an O(n²) 'Eq' instance, and +-- an O(n log n) 'Ord' instance; the 'Eq' instance goes down to O(n log n) if +-- we're willing to require an 'Ord' constraint. + +instance NFData a => NFData (BTree a) where + rnf (BLeaf a) = rnf a + rnf (BNode l r) = rnf l `seq` rnf r + +instance NFData a => NFData (WTree a) where + rnf (WTree w t) = rnf w `seq` rnf t + +instance NFData a => NFData (Urn a) where + rnf (Urn size wt) = rnf size `seq` rnf wt + +-- |This 'Show' instance prints out the elements from most-weighted to +-- least-weighted; however, do not rely on the order of equally-weighted +-- elements, as this may depend on details of the implementation. +instance Show a => Show (Urn a) where + showsPrec p u = showParen (p > 10) $ + showString "fromList " . shows (toList [] $ wtree u) where + toList acc (WLeaf w a) = List.insertBy (flip $ Ord.comparing fst) (w,a) acc + toList acc (WNode _ l r) = toList (toList acc l) r + +showUrnTreeStructureWith :: (a -> String) -> Urn a -> String +showUrnTreeStructureWith disp (Urn (Size size) wtree) = + unlines $ ("Urn, size " ++ show size ++ ":") : strings wtree + where + strings (WLeaf w a) = ["(" ++ show w ++ ": " ++ disp a ++ ")"] + strings (WNode w l r) = ("[" ++ show w ++ "]") : + " |" : + nest '+' '|' (strings l) ++ + " |" : + nest '`' ' ' (strings r) + + nest cc gc (child:grandchildren) = + ([' ',cc,'-'] ++ child) : map ([' ', gc, ' '] ++) grandchildren + nest _ _ [] = [] + +showUrnTreeStructure :: Show a => Urn a -> String +showUrnTreeStructure = showUrnTreeStructureWith show + +---------------------------------------- + +randomIndexWith :: Functor f => ((Word,Word) -> f Word) -> Urn a -> f Index +randomIndexWith rand u = Index <$> rand (0, weight (wtree u) - 1) +{-# INLINABLE randomIndexWith #-} + +---------------------------------------- + +bsample :: BTree a -> Index -> a +bsample (BLeaf a) _ = + a +bsample (BNode (WTree wl l) (WTree _ r)) (Index i) + | i < wl = bsample l (Index i) + | otherwise = bsample r (Index $ i - wl) + +sample :: WTree a -> Index -> a +sample = bsample . btree +{-# INLINABLE sample #-} + +foldWTree :: (Weight -> a -> b) + -> (Weight -> b -> WTree a -> b) + -> (Weight -> WTree a -> b -> b) + -> Size -> WTree a + -> b +foldWTree fLeaf fLeft fRight = go where + go _ (WLeaf w a) = fLeaf w a + go path (WNode w l r) | path `testBit` 0 = fRight w l (go path' r) + | otherwise = fLeft w (go path' l) r + where path' = path `shiftR` 1 +{-# INLINABLE foldWTree #-} + +insert :: Weight -> a -> Urn a -> Urn a +insert w' a' (Urn size wt) = + Urn (size+1) $ foldWTree (\w a -> WNode (w+w') (WLeaf w a) (WLeaf w' a')) + (\w -> WNode (w+w')) + (\w -> WNode (w+w')) + size wt +{-# INLINABLE insert #-} + +uninsert :: Urn a -> (Weight, a, Weight, Maybe (Urn a)) +uninsert (Urn size wt) = + case foldWTree (\w a -> (w, a, 0, Nothing)) + (\w ul' r -> case ul' of + (w', a', lb, Just l') -> (w', a', lb, Just $ WNode (w-w') l' r) + (w', a', lb, Nothing) -> (w', a', lb, Just r)) + (\w l ur' -> case ur' of + (w', a', lb, Just r') -> (w', a', lb + weight l, Just $ WNode (w-w') l r') + (w', a', lb, Nothing) -> (w', a', lb + weight l, Just l)) + (size-1) wt of + (w', a', lb, mt) -> (w', a', lb, Urn (size-1) <$> mt) +{-# INLINABLE uninsert #-} + +update :: (Weight -> a -> (Weight, a)) -> WTree a -> Index -> (Weight, a, Weight, a, WTree a) +update upd = go where + go (WLeaf w a) _ = + let (wNew, aNew) = upd w a + in (w, a, wNew, aNew, WLeaf wNew aNew) + go (WNode w l@(WTree wl _) r) (Index i) + | i < wl = case go l (Index i) of + (wOld, aOld, wNew, aNew, l') -> (wOld, aOld, wNew, aNew, WNode (w-wOld+wNew) l' r) + | otherwise = case go r (Index $ i-wl) of + (wOld, aOld, wNew, aNew, r') -> (wOld, aOld, wNew, aNew, WNode (w-wOld+wNew) l r') + +replace :: Weight -> a -> WTree a -> Index -> (Weight, a, WTree a) +replace wNew aNew = go where + go (WLeaf w a) _ = + (w, a, WLeaf wNew aNew) + go (WNode w l@(WTree wl _) r) (Index i) + | i < wl = case go l (Index i) of + (w', a', l') -> (w', a', WNode (w-w'+wNew) l' r) + | otherwise = case go r (Index $ i-wl) of + (w', a', r') -> (w', a', WNode (w-w'+wNew) l r') + +construct :: NonEmpty (Weight, a) -> Urn a +construct list = Urn (Size size) tree + where + size = fromIntegral $ length list + tree = almostPerfect (\l r -> WNode (weight l + weight r) l r) + (uncurry WLeaf) + size + list diff --git a/src/Data/Urn/Internal/AlmostPerfect.hs b/src/Data/Urn/Internal/AlmostPerfect.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/Internal/AlmostPerfect.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +module Data.Urn.Internal.AlmostPerfect (almostPerfect, reverseBits#) where + +import Data.List.NonEmpty (NonEmpty(..)) +import GHC.Integer.Logarithms +import GHC.Exts + +-- TODO: Consider moving back to boxed Words, adding a wordLog2 function + +-- | Create an "almost perfect" tree from a given list of a specified size. +-- Invariants: specified size must match the actual length of the list, +-- and list must be non-empty. +almostPerfect :: (b -> b -> b) -> (a -> b) -> Word -> NonEmpty a -> b +almostPerfect node leaf (W# size) (e0:|elements0) = + case go perfectDepth 0## (e0:elements0) of (# tree, _, _ #) -> tree + where + perfectDepthInt = wordLog2# size + perfectDepth = int2Word# perfectDepthInt + remainder = size -.# (1## <<.# perfectDepthInt) + + go 0## index elements + | reverseBits# perfectDepth index <.# remainder + , l:r:elements' <- elements + = (# leaf l `node` leaf r, elements', succ# index #) + + | x:elements' <- elements + = (# leaf x, elements', succ# index #) + + | otherwise + = error $ "almostPerfect: size mismatch: got input of length " ++ + show (length (e0:|elements0)) ++ + ", but expected size " ++ show (W# size) + + go depth index elements = + let (# l, elements', index' #) = go (pred# depth) index elements + (# r, elements'', index'' #) = go (pred# depth) index' elements' + in (# l `node` r, elements'', index'' #) + +-- | Returns the number formed by snipping out the first @n@ bits of the input +-- and reversing them +-- TODO: Make this more efficient +reverseBits# :: Word# -> Word# -> Word# +reverseBits# = go 0## + where go r 0## _ = r + go r n x = + go ((r <<.# 1#) `or#` (x `and#` 1##)) + (pred# n) + (x >>.# 1#) + +-------------------------------------------------------------------------------- +-- Functions on 'Word#' – used just to make 'almostPerfect' read nicely + +succ# :: Word# -> Word# +succ# x = x `plusWord#` 1## +{-# INLINE succ# #-} + +pred# :: Word# -> Word# +pred# x = x -.# 1## +{-# INLINE pred# #-} + +(-.#) :: Word# -> Word# -> Word# +(-.#) = minusWord# +{-# INLINE (-.#) #-} + +(<<.#) :: Word# -> Int# -> Word# +(<<.#) = uncheckedShiftL# +{-# INLINE (<<.#) #-} + +(>>.#) :: Word# -> Int# -> Word# +(>>.#) = uncheckedShiftRL# +{-# INLINE (>>.#) #-} + +(<.#) :: Word# -> Word# -> Bool +m <.# n = case m `ltWord#` n of + 0# -> False + _ -> True +{-# INLINE (<.#) #-} +-- NB: There's an `isTrue#` function, but we may not want to use it; using the +-- direct case generates more efficient core, but if we branch on the result, +-- "the code generator will generate very bad Cmm if [the results of the +-- conditional branch] do allocation." See Note [Optimizing isTrue#] in +-- "GHC.Types". And no, we'll never actually be able to see the speed +-- difference, this is purely about doing the Right Thing™ :-) diff --git a/src/Data/Urn/MonadSample.hs b/src/Data/Urn/MonadSample.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/MonadSample.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DefaultSignatures #-} + +module Data.Urn.MonadSample (MonadSample(..)) where + +import Control.Monad.Random +import Test.QuickCheck + +-- Transformers +import Control.Monad.Trans.Class +import Control.Monad.Trans.Identity +import Control.Monad.Trans.Reader +import qualified Control.Monad.Trans.Writer.Strict as Strict +import qualified Control.Monad.Trans.Writer.Lazy as Lazy +import qualified Control.Monad.Trans.State.Strict as Strict +import qualified Control.Monad.Trans.State.Lazy as Lazy +import qualified Control.Monad.Trans.RWS.Strict as Strict +import qualified Control.Monad.Trans.RWS.Lazy as Lazy +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Cont + +---------------------------------------- + +class Monad m => MonadSample m where + randomWord :: (Word,Word) -> m Word + default randomWord :: MonadRandom m => (Word,Word) -> m Word + randomWord = getRandomR + +instance MonadSample IO +instance (Monad m, RandomGen g) => MonadSample (RandT g m) + +instance MonadSample Gen where + randomWord = choose + +-- Transformer instances + +instance MonadSample m => MonadSample (IdentityT m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (ReaderT r m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (Strict.StateT s m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (Lazy.StateT s m) where randomWord = lift . randomWord +instance (MonadSample m, Monoid w) => MonadSample (Strict.WriterT w m) where randomWord = lift . randomWord +instance (MonadSample m, Monoid w) => MonadSample (Lazy.WriterT w m) where randomWord = lift . randomWord +instance (MonadSample m, Monoid w) => MonadSample (Strict.RWST r w s m) where randomWord = lift . randomWord +instance (MonadSample m, Monoid w) => MonadSample (Lazy.RWST r w s m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (ExceptT e m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (MaybeT m) where randomWord = lift . randomWord +instance MonadSample m => MonadSample (ContT r m) where randomWord = lift . randomWord diff --git a/src/Data/Urn/QQ.hs b/src/Data/Urn/QQ.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/QQ.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE LambdaCase, TemplateHaskell #-} + +module Data.Urn.QQ (urn) where + +import Language.Haskell.TH.Quote +import Data.Urn.QQ.ParseExp + +urn :: QuasiQuoter +urn = QuasiQuoter { quoteExp = either fail (pure . urnExp) . parseUrn + , quotePat = unsupported "patterns" + , quoteType = unsupported "types" + , quoteDec = unsupported "declarations" } + where unsupported what = + fail $ "Literal urns are only supported in expressions, not " ++ what diff --git a/src/Data/Urn/QQ/ParseExp.hs b/src/Data/Urn/QQ/ParseExp.hs new file mode 100644 --- /dev/null +++ b/src/Data/Urn/QQ/ParseExp.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE LambdaCase, TemplateHaskellQuotes #-} + +module Data.Urn.QQ.ParseExp ( + -- * Parse a literal 'Urn' + parseUrnList, parseUrn, + -- * Lift components of 'Urn's straight to 'Exp's (without 'Q') + wordExp, weightExp, sizeExp, + btreeExp, wtreeExp, + urnExp +) where + +import Data.Traversable + +import Language.Haskell.TH +import Language.Haskell.Meta.Parse + +import Data.Urn.Internal +import Data.Urn.Common (fromList) + +-- We don't handle extensions +parseUrnList :: String -> Either String [(Word, Exp)] +parseUrnList str = + case parseExp $ "[" ++ str ++ "]" of + Left _ -> + Left "Parse error in urn" + Right (ListE tups) -> + for tups $ \case + TupE [LitE (IntegerL w), e] | toInteger (minBound :: Word) <= w + , w <= toInteger (maxBound :: Word) -> + Right (fromInteger w :: Word, e) + TupE [_, _] -> + Left $ "A weighted pair in this urn lacked a valid literal weight" + _ -> + Left $ "This urn contained a non-pair element" + Right _ -> + Left "This urn does not contain a list of pairs" + +parseUrn :: String -> Either String (Urn Exp) +parseUrn str = (fromList <$> parseUrnList str) >>= \case + Just urn -> Right urn + Nothing -> Left "Empty urn" + +wordExp :: Word -> Exp +wordExp = LitE . IntegerL . toInteger + +weightExp :: Weight -> Exp +weightExp = wordExp + +sizeExp :: Size -> Exp +sizeExp (Size s) = ConE 'Size `AppE` wordExp s + +btreeExp :: BTree Exp -> Exp +btreeExp (BLeaf a) = ConE 'BLeaf `AppE` a +btreeExp (BNode l r) = ConE 'BNode `AppE` wtreeExp l `AppE` wtreeExp r + +wtreeExp :: WTree Exp -> Exp +wtreeExp wt = RecConE 'WTree [ ('weight, weightExp $ weight wt) + , ('btree, btreeExp $ btree wt) ] + +urnExp :: Urn Exp -> Exp +urnExp u = RecConE 'Urn [ ('size, sizeExp $ size u) + , ('wtree, wtreeExp $ wtree u) ] diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-7.19 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.2" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/urn-random.cabal b/urn-random.cabal new file mode 100644 --- /dev/null +++ b/urn-random.cabal @@ -0,0 +1,64 @@ +-- Initial urn-random.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: urn-random +version: 0.1.0.0 +synopsis: A package for updatable discrete distributions +homepage: https://github.com/antalsz/urn-random +license: MIT +license-file: LICENSE +author: Leonidas Lampropoulos, Antal Spector-Zabusky, Kenneth Foner +maintainer: Antal Spector-Zabusky +copyright: Copyright © 2016–2017 Leonidas Lampropoulos, Antal Spector-Zabusky, and Kenneth Foner +category: Data +build-type: Simple +extra-source-files: README.md, stack.yaml +cabal-version: >=1.10 + +description: + This package implements /urns/, which are a simple tree-based data structure + that supports sampling from and updating discrete probability distributions in + logarithmic time. The details are presented in the paper “Ode on a Random Urn + (Functional Pearl)”, by Leonidas Lampropoulos, Antal Spector-Zabusky, and + Kenneth Foner, published in Haskell Symposium ’17. + +source-repository head + type: git + location: https://github.com/antalsz/urn-random.git + +library + exposed-modules: Data.Urn + , Data.Urn.Index + , Data.Urn.Common + , Data.Urn.QQ + -- Internal details + , Data.Urn.MonadSample + , Data.Urn.QQ.ParseExp + , Data.Urn.Internal + , Data.Urn.Internal.AlmostPerfect + + hs-source-dirs: src + + build-depends: base ==4.9.* + -- 'NFData' instances + , deepseq ==1.4.* + -- For the quasi-quoter + , template-haskell ==2.11.* + , haskell-src-meta ==0.6.* + -- For 'MonadSample' instances + , MonadRandom ==0.4.* + , QuickCheck ==2.8.* + , transformers ==0.5.* + -- For 'intLog2#' + , integer-gmp ==1.0.0.* + + default-language: Haskell2010 + + other-extensions: LambdaCase + , DefaultSignatures, GeneralizedNewtypeDeriving + , PatternSynonyms + , MagicHash, UnboxedTuples + , TemplateHaskellQuotes + + ghc-options: -Wall -fno-warn-name-shadowing + -O2 -funbox-strict-fields