choose (empty) → 0.1.0.0

raw patch · 6 files changed

+255/−0 lines, 6 filesdep +MonadRandomdep +basesetup-changed

Dependencies added: MonadRandom, base

Files

Data/Random/Choose.hs +36/−0
Data/Random/Choose/IO.hs +59/−0
Data/Random/Choose/Tree.hs +115/−0
Setup.hs +2/−0
choose.cabal +30/−0
license.txt +13/−0

+ Data/Random/Choose.hs view

@@ -0,0 +1,36 @@+{- |++"Data.Random.Choose" provides an efficient mechanism to select /n/ items+uniformly at random from an input stream, for some fixed /n/.++* "Data.Random.Choose.Tree" contains the implementation details.+* "Data.Random.Choose.IO" puts everything together as a single function+  (using IO).++-}++module Data.Random.Choose+    ( -- * Algorithm outline+      -- $outline+    ) where++import Data.Random.Choose.IO+import Data.Random.Choose.Tree++{- $outline++We store items on a binary tree ('Tree'), moving them down the left or right+branch according to a coin flip. At the end, the rightmost /n/ items on the tree+are selected. Each time we 'insert' into a tree having /n/ items, we prune its+leftmost item ('applyLimit' and 'evict').++It may be helpful to think of this as lazily assigning each item a /d/-bit+score, where /d/ is the maximum depth of the tree. Moving an item to the left+or right corresponds to appending a 0 or 1 to its score. Note that the laziness+is necessary, because /d/ is not known a priori.++The process of moving items futher down the tree is referred to as+disambiguation ('disambiguate') because its purpose is to resolve ties in the+score.++-}

+ Data/Random/Choose/IO.hs view

@@ -0,0 +1,59 @@+{- |++'IO'-specific functionality around the random selection algorithm described in+"Data.Random.Choose".++-}++{-# LANGUAGE ScopedTypeVariables #-}++module Data.Random.Choose.IO ( getSelectionsIO ) where++--------------------------------------------------------------------------------++import qualified Data.Random.Choose.Tree as Tree++import Data.Random.Choose.Tree (Tree)++import Control.Monad.Random   (evalRandIO)++import qualified Data.Foldable as Foldable++import Data.Function ((&))+import Data.List     (sort)++--------------------------------------------------------------------------------++getSelectionsIO :: forall a. (Ord a)+    => IO (Maybe a) -- ^ Producer of items to choose from; produces 'Nothing'+                    --   when there are no more items)+    -> Int          -- ^ /n/: Number of items to choose+    -> IO [a]       -- ^ /n/ of the items (or all of the items if fewer than+                    --   /n/ are produced)++-- ^ Selects /n/ items uniformly at random from an input stream.++--------------------------------------------------------------------------------++getSelectionsIO getItem limit = f 0 Tree.empty+  where++    -- We store each line of text along with its index (i) so that when we're+    -- done, we can sort by the index, thus outputting the selected items in+    -- the same order in which they were read.+    f :: Int -> Tree (Int, a) -> IO [a]+    f i tree = do+        lineMaybe <- getItem+        case lineMaybe of++            -- We read a line; insert it into the tree and recurse.+            Just line -> do+                tree' <- evalRandIO ( tree+                                    & Tree.insert (i, line)+                                    & Tree.applyLimit limit+                                    )+                f (i + 1) tree'++            -- We've reached the end of the input. Convert the tree to a list,+            -- sort it, and strip out the indices to return just the text.+            Nothing -> return $ snd <$> sort (Foldable.toList tree)

+ Data/Random/Choose/Tree.hs view

@@ -0,0 +1,115 @@+{- |++Defines the 'Tree' data structure and operations on it to implement the random+selection algorithm described in "Data.Random.Choose".++-}++module Data.Random.Choose.Tree+    ( Tree(..), empty, insert, applyLimit, evict, disambiguate ) where++--------------------------------------------------------------------------------++import Control.Monad.Random (Rand, RandomGen, getRandom)++--------------------------------------------------------------------------------++data Tree a = Nil | Tree+    { treeSize   :: Int    -- ^ Total number of items at this node and below+    , treeValues :: [a]    -- ^ Items at this node+    , treeLeft   :: Tree a -- ^ Left subtree (less likely for inclusion)+    , treeRight  :: Tree a -- ^ Right subtree (more likely for inclusion)+    }+-- ^ A binary tree with arbitrarily many values at each node.++instance Foldable Tree where++    foldr _ z Nil = z+    foldr f z (Tree size (x:xs) left right) =+        foldr f (f x z) (Tree (size - 1) xs left right)+    foldr f z (Tree size [] left right) =+        (\z -> foldr f z left) . (\z -> foldr f z right) $ z++    length Nil      = 0+    length t@Tree{} = treeSize t++    null Nil      = True+    null t@Tree{} = treeSize t == 0++empty :: Tree a+-- ^ A tree with no elements.++insert :: a -> Tree a -> Tree a+-- ^ Trivial insertion into the root of a tree, increasing its size by 1+--   and leaving its children unmodified.++applyLimit :: (RandomGen g)+    => Int -- ^ @limit@+    -> Tree a+    -> Rand g (Tree a)+-- ^ Remove items from the tree until its size is at most @limit@.+--   This may involve disambiguation if eviction takes place.++evict :: (RandomGen g) => Tree a -> Rand g (Tree a)+-- ^ Remove one item from the tree (or leave the tree unmodified if it is+--   already empty). This may involve disambiguation if there is not already+--   a clear leftmost item.++disambiguate :: (RandomGen g) => Tree a -> Rand g (Tree a)+-- ^ Perform disambiguation at the root level only, pushing items from+--   the root down into subtrees as necessary.++--------------------------------------------------------------------------------++empty = Nil++insert x Nil = Tree 1 [x] Nil Nil++insert x (Tree size xs left right) = Tree (size + 1) (x:xs) left right++applyLimit limit _ | limit <= 0 = pure Nil++applyLimit limit tree++    -- If the tree is small enough: We don't need to do anything.+    | length tree <= limit = pure tree++    -- If the tree is oversized: Remove an item from it, and recurse.+    | otherwise = applyLimit limit =<< evict tree++evict tree | length tree <= 1 = pure Nil++evict tree = do+    (Tree _ _ left right) <- disambiguate tree++    -- Evict from one of the subtrees, preferring to evict from the left.+    (left', right') <- if not . null $ left+                       then (\x -> (x, right)) <$> evict left+                       else (\x -> (left, x))  <$> evict right++    return $ Tree (length left' + length right') [] left' right'++-- For a tree with no items at the root, no disambiguation is possible+-- (remember that disambiguate operates at the root only).+disambiguate tree@(Tree _ [] _ _) = pure tree++-- For a tree which contains a single item and no children, no+-- disambiguation is required.+disambiguate tree@(Tree _ [_] Nil Nil) = pure tree++-- There is at least one item at the root that needs to be pushed down, to+-- disambiguate it (either from items in subtrees, or from other items at+-- the root).+disambiguate (Tree size (x:xs) left right) = do++    -- Randomly decide whether to push x into the left or right subtree.+    b <- getRandom+    let (left', right') = if b+                          then (insert x left, right)+                          else (left, insert x right)++    -- In tree', a single item from the original tree has been pushed down.+    let tree' = Tree size xs left' right'++    -- There still may be other items at the root, so recurse.+    disambiguate tree'

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ choose.cabal view

@@ -0,0 +1,30 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           choose+version:        0.1.0.0+synopsis:       Choose random elements from a stream.+description:    Provides an efficient mechanism to select /n/ items uniformly at random from an input stream, for some fixed /n/.+category:       Random+author:         Chris Martin <ch.martin@gmail.com>+maintainer:     Chris Martin <ch.martin@gmail.com>+license:        Apache-2.0+license-file:   license.txt+build-type:     Simple+cabal-version:  >= 1.10++library+  hs-source-dirs:+      .+  ghc-options: -Wall -fwarn-unused-imports+  build-depends:+      base >= 4.7 && < 5+    , MonadRandom+  exposed-modules:+      Data.Random.Choose+      Data.Random.Choose.Tree+      Data.Random.Choose.IO+  other-modules:+      Paths_choose+  default-language: Haskell2010

+ license.txt view

@@ -0,0 +1,13 @@+Copyright 2016 Chris Martin++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.