From: Benjamin Mako Hill Date: Tue, 6 Sep 2011 02:35:58 +0000 (-0400) Subject: committed initial version to git X-Git-Url: https://projects.mako.cc/source/s290-pingpong/commitdiff_plain/721ac22a7c5bd22aa09d30de47fef6abdd853c51 committed initial version to git --- 721ac22a7c5bd22aa09d30de47fef6abdd853c51 diff --git a/.gitignore b/.gitignore new file mode 100644 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 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 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 within R. + + As a shortcut, you can usually just type 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 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 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 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 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 index 0000000..ff9cf6d Binary files /dev/null and b/simulation_weighted.png differ