committed initial version to git

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..e4e5f6c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
\ No newline at end of file

diff --git a/README b/README
new file mode 100644 (file)
index 0000000..3f23564
--- /dev/null
+++ b/README
@@ -0,0 +1,53 @@
+The following R program was designed to (mostly) randomly select
+students to call for questions in a class room environment. It was
+created in Harvard Graduate School of Graduate Education's S-290 to
+replace a physical ping-pong ball jar.
+
+It takes a list of options (e.g., students), selects one at random and
+returns it, and then adjusts the weights so that the selected option
+is relatively less likely to be selected in subsequent draws.  Every
+student can be called on at any time.
+
+It is particularly well suited to classes in which a reasonably small
+number of students will be called on a small number of times. Over
+even a small number of classes, a very balanced list is likely.
+
+The software was written by Benjamin Mako Hill <mako@atdot.cc> and is
+released into the public domain.
+
+Usage
+--------
+
+The first time you the program this you'll need to:
+
+  Modify ping_pong_ball_jar.R in a text editor to include the list of
+  options or students that you want. There are comments in the file
+  which should help provide some direction.
+
+  Save the modified version for later if you'll be doing this again.
+
+Each time you use it, you'll need to:
+
+  Paste the contents of ping_pong_ball_jar.R into a running session of R.
+
+Every time you want to select an option, you'll need to:
+
+  Type "get.ping.pong.ball()" and then <ENTER> within R.
+
+  As a shortcut, you can usually just type <UP> once or twice to see
+  the last command if you're going to be running it repeatedly.
+
+Files
+---------
+
+ping_pong_ball_jar.R
+
+  Contains the R necessary to run the program. You'll need to at least
+  modify the list of options.
+
+ping_pong_ball_jar_simulation.R
+simulation_unweighted_random.png
+simulation_weighted.png
+
+  Code and output from simulations that show the number of questions
+  asked to each participant in a large number of simulated classes.

diff --git a/ping_pong_ball_jar.R b/ping_pong_ball_jar.R
new file mode 100644 (file)
index 0000000..f5fe990
--- /dev/null
+++ b/ping_pong_ball_jar.R
@@ -0,0 +1,56 @@
+# S-290 PingPong Ball
+#
+# The following R program was designed for use in cold calling in a
+# class room environment. It takes a list of options, selects one at
+# random and returns it, and then adjusts the weights so that the
+# selected option is relatively less likely to be selected in the next
+# draw.
+#
+# The software was written by Benjamin Mako Hill <mako@atdot.cc> and
+# is released into the public domain.
+
+# replace this line with a list of the names from which we want to sample
+member.names <- c("Alonso", "Alejandro", "Andres", "Becky",
+                  "Deborah", "Lauren", "Mako", "Nikhit", "North",
+                  "Steve")
+
+# set the default weight: after being selected the likelihood of the
+# selected value being chosen will be reduced to 1 over this value
+pp.weight <- 2
+
+# create a variable which we'll use to keep track of who has been selected
+reset.weights <- function () {
+  w <- rep(1, length(member.names))
+  names(w) <- member.names
+  assign("w", w, envir=.GlobalEnv)
+}
+
+# only run this if you want to create new we
+if (!exists("w")) reset.weights()
+
+get.ping.pong.ball <- function () {
+  # create the "jar" according to the weights
+  weighted.names <- c(sapply(member.names,
+                             function (x) {rep(x, w[x])}), recursive=TRUE)
+  # select something out of it
+  selected <- sample(weighted.names, 1)
+
+  # adjust the weights for the next run based on what was selected
+  w[!names(w) == selected] <- w[!names(w) == selected] * pp.weight
+
+  # if we can reduce the weights by a lowest common denom, do it
+  if (all((w %% pp.weight) == 0)) w <- w / pp.weight
+
+  # save the variable in the global namespace so we can return to it next time
+  assign("w", w, envir=.GlobalEnv)
+
+  # clean up the output and return the value
+  names(selected) <- NULL
+  return(selected)
+}
+
+# run this function to get a person selected
+get.ping.pong.ball()
+
+# run the following function to reset the weights
+reset.weights()

diff --git a/ping_pong_ball_jar_simulation.R b/ping_pong_ball_jar_simulation.R
new file mode 100644 (file)
index 0000000..b25ce20
--- /dev/null
+++ b/ping_pong_ball_jar_simulation.R
@@ -0,0 +1,67 @@
+## simluation 
+############################################################
+
+pingpong <- get.ping.pong.ball
+reset.weights()
+
+# create a non-weighted function to compare
+pingpong.nonweighted <- function () {
+  return(sample(member.names, 1))
+}
+
+# function to run a simulation and generate 1000 classes
+run.simulation <- function (pingpong.fun, questions=10) {
+
+  d <- c()
+  # run the comand 1000 times
+  for (i in seq(1,1000)) {
+
+    all.prev <- c()
+    reset.weights()
+    for (j in seq(1,questions)) {
+      selected <-  pingpong.fun()
+      all.prev <- append(all.prev, selected)
+    }
+
+    d <- append(d, table(all.prev))
+
+    missing.names <- names(w)[sapply(names(w),
+                                     function (x) {!x %in% names(table(all.prev))})]
+    d.tmp <- rep(0, length(missing.names))
+    names(d.tmp) <- missing.names
+
+    d <- append(d, d.tmp)
+  }
+
+  total.nums <- sapply(names(w),
+                       function (x) {sum(d[names(d) == x])})
+
+  cat("Number of total selections:\n")
+  print(total.nums)
+  cat(paste("SD:", sd(total.nums), "\n"))
+
+  return(d)
+}
+
+d.nw <- run.simulation(pingpong.nonweighted, 15)
+d.w <- run.simulation(pingpong, 15)
+
+library(ggplot2)
+
+graph.sim.output <- function (d, label.text="") {
+  qplot(as.factor(names(table(d))), as.integer(table(d)), geom="bar") +
+    scale_x_discrete("Number of questions asked to participant") +
+    scale_y_continuous("Number of occurances") +
+    opts(title = paste(label.text, "- 1000 classes of 15 questions"))
+}
+
+p.weighted <- graph.sim.output(d.w, "weighted")
+p.nonweighted <- graph.sim.output(d.nw, "non-weighted")
+
+png("simulation_weighted.png")
+print(p.weighted)
+dev.off()
+
+png("simulation_unweighted_random.png")
+p.nonweighted
+dev.off()

diff --git a/simulation_unweighted_random.png b/simulation_unweighted_random.png
new file mode 100644 (file)
index 0000000..f9b6e83
Binary files /dev/null and b/simulation_unweighted_random.png differ

diff --git a/simulation_weighted.png b/simulation_weighted.png
new file mode 100644 (file)
index 0000000..ff9cf6d
Binary files /dev/null and b/simulation_weighted.png differ