--- /dev/null
+*~
\ No newline at end of file
--- /dev/null
+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.
--- /dev/null
+# 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()
--- /dev/null
+## 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()
projects / s290-pingpong / commitdiff
