projects.mako.cc - s290-pingpong/blob - ping_pong_ball_jar.R

   1 # S-290 PingPong Ball
   2 #
   3 # The following R program was designed for use in cold calling in a
   4 # class room environment. It takes a list of options, selects one at
   5 # random and returns it, and then adjusts the weights so that the
   6 # selected option is relatively less likely to be selected in the next
   7 # draw.
   8 #
   9 # The software was written by Benjamin Mako Hill <mako@atdot.cc> and
  10 # is released into the public domain.
  11
  12 # replace this line with a list of the names from which we want to sample
  13 member.names <- c("Alonso", "Alejandro", "Andres", "Becky",
  14                   "Deborah", "Lauren", "Mako", "Nikhit", "North",
  15                   "Steve")
  16
  17 # set the default weight: after being selected the likelihood of the
  18 # selected value being chosen will be reduced to 1 over this value
  19 pp.weight <- 2
  20
  21 # create a variable which we'll use to keep track of who has been selected
  22 reset.weights <- function () {
  23   w <- rep(1, length(member.names))
  24   names(w) <- member.names
  25   assign("w", w, envir=.GlobalEnv)
  26 }
  27
  28 # only run this if you want to create new we
  29 if (!exists("w")) reset.weights()
  30
  31 get.ping.pong.ball <- function () {
  32   # create the "jar" according to the weights
  33   weighted.names <- c(sapply(member.names,
  34                              function (x) {rep(x, w[x])}), recursive=TRUE)
  35   # select something out of it
  36   selected <- sample(weighted.names, 1)
  37
  38   # adjust the weights for the next run based on what was selected
  39   w[!names(w) == selected] <- w[!names(w) == selected] * pp.weight
  40
  41   # if we can reduce the weights by a lowest common denom, do it
  42   if (all((w %% pp.weight) == 0)) w <- w / pp.weight
  43
  44   # save the variable in the global namespace so we can return to it next time
  45   assign("w", w, envir=.GlobalEnv)
  46
  47   # clean up the output and return the value
  48   names(selected) <- NULL
  49   return(selected)
  50 }
  51
  52 # run this function to get a person selected
  53 get.ping.pong.ball()
  54
  55 # run the following function to reset the weights
  56 reset.weights()