Weighted random sampling without replacement in F#. Related Project: RecycleBin.Random https://github.com/kos59125/RecycleBin.Random

BinarySearchTree.fs

module BinarySearchTree

type Tree<'a> =
   | Empty
   | Node of 'a * Tree<'a> * Tree<'a>

let empty<'a> = Tree<'a>.Empty

let singleton key value = Tree.Node ((key, value), empty, empty)

let rec insert key value = function
   | Node ((key', _) as y, left, right) when key < key' -> Node (y, insert key value left, right)
   | Node (y, left, right) -> Node (y, left, insert key value right)
   | Empty -> singleton key value

let rec keyOfMinimum = function
   | Node (x, Empty, _) -> fst x
   | Node (_, left, _) -> keyOfMinimum left
   | Empty -> failwith "Empty."

let rec removeMinimum = function
   | Node (_, Empty, right) -> right
   | Node (x, left, right) -> Node (x, removeMinimum left, right)
   | Empty -> Empty

let rec toSeq = function
   | Node (x, left, right) ->
      seq {
         yield! toSeq left
         yield x
         yield! toSeq right
      }
   | Empty -> Seq.empty

let values<'key, 'value> : Tree<'key * 'value> -> seq<'value> = toSeq >> Seq.map snd

WeightedRandomSampling.fs

module WeightedRandomSampling

open System

module BST = BinarySearchTree

let flip f x y = f y x
let keyOf, valueOf = snd, fst
let insert x = BST.insert (keyOf x) (valueOf x)

let sample count weight (random:Random) source =
   use enumerator =
      Seq.map (fun w -> random.NextDouble () ** (1.0 / w)) weight
      |> Seq.zip source
      |> fun s -> s.GetEnumerator ()
   let buffer =
      seq { while enumerator.MoveNext () do yield enumerator.Current }
      |> Seq.take count
      |> Seq.fold (flip insert) BST.empty 
      |> ref
   while enumerator.MoveNext () do
      let current = enumerator.Current
      if BST.keyOfMinimum !buffer < keyOf current
      then
         buffer := !buffer |> BST.removeMinimum |> insert current
   BST.values !buffer