Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
First pass at getting #random reviewer/reviewee assignments
## Generate a markdown table of permuted peer assignments
## Designed for putting into output into GitHub Wiki
## Permutation code
source("https://gist.github.com/maptracker/f0ec01bed4d1c1583bf6/raw/a9cbd9983703a293584e826d903f21a8556e41a3/StudentPeerReview.R")
makeMarkdownTable <- function
(file, peers = 2, out = paste(c(file,"md"), collapse = '.'),
subtitle = NULL,
...) {
## Ugh. I need to understand how ... gets passed on
args <- as.list(substitute(list(...)))
dat <- read.table(file = file, header = args$header, sep = args$sep,
stringsAsFactors = FALSE, colClasses = "character")
if (length(dat) > 1) {
## Presume that the second column is a flag for if the student
## is included
flag <- dat[[2]]
keep <- !is.na(flag) & grepl("^\\s*(t|true|yes)\\s*$", flag,
ignore.case = TRUE, perl = TRUE)
students <- dat[ keep, 1 ]
} else {
## Take the entire first column
students <- dat[[1]]
}
## Generate the peer assignments
mat <- reviewerMatrix(students, peers)
cols <- dim(mat)[2]
## Generate the markdown file
## Default name is the input file plus ".md"
fh <- file(out, "w")
writeLines(c("## Student Peer Assignments",""), fh)
if (!is.null(subtitle)) writeLines(c(subtitle,""), fh)
## Header
writeLines(paste(c("Reviewer", dimnames(mat)[[2]]), collapse = " | "), fh)
writeLines(paste(rep('-----', cols + 1), collapse = " | "), fh)
## Student rows
rnames <- dimnames(mat)[[1]]
for (r in seq_len(length(rnames))) {
writeLines(paste(c(rnames[r], mat[r,]), collapse = " | "), fh)
}
close(fh)
mat
}
### For a class, randomly assign peers to each student in the class so
### they can review each other's work.
## The goal for the awkward code that follows is to:
## 1. Keep the pairings fully random, but within the constraints that:
## 2. A student does not review themselves
## 3. A student does not review another student twice or more
reviewerMatrix <- function(s = NULL, n = 2, sp = NULL) {
allReviews <- NULL # matrix holding reviewer x reviewee grid
classroom <- NULL # vector of students in class
numReviewers <- NULL # number of reviews requested for each student
classSize <- NULL # simply the length of classroom
totReviews <- NULL # simply classSize * numReviewers
setClass <- function( students, nRev = 2, splitter = NULL) {
## Defined the names of the students in the class, as well as the
## number of peers each student needs to review
if (is.null(students)) {
message("No students provided, using example data")
students <- c("Aphrodite","Apollo","Ares","Artemis","Athena",
"Demeter", "Dionysus","Hera","Hermes","Hades",
"Hestia","Poseidon")
}
if (is.null(splitter)) {
## Allow single strings to be split into an array
classroom <<- students
} else {
classroom <<- strsplit(students, splitter)[[1]]
}
numReviewers <<- nRev
classSize <<- length(classroom)
if (numReviewers > classSize -1) {
stop("You can not have more reviewers than classSize - 1")
}
totReviews <<- classSize * numReviewers
allReviews <<- makeRandomMatrix()
fixSelfReview()
fixDuplicates()
allReviews
}
makeRandomMatrix <- function() {
## Begin by blindly randomizing all the review tasks:
RevHeader <- paste("Student", 1:numReviewers, sep = "")
mat <- matrix(sample(rep(classroom, numReviewers)),
ncol = numReviewers,
dimnames = list( classroom, RevHeader))
## Tracking the corrections we will make to honor the constraints:
attr(mat, "Corrections") <- vector("character")
mat
}
## 1-indexed arrays are silly...
row4cell <- function( c ) (c-1) %% classSize + 1
col4cell <- function( c ) as.integer((c-1) / classSize) + 1
swapReview <- function( c1, c2, why ) {
## Swaps a pair of reviews between two students
c1val <- allReviews[c1]
c2val <- allReviews[c2]
action <- sprintf("%s: %s trades %s to %s for %s", why,
classroom[ row4cell(c1)], c1val,
classroom[ row4cell(c2)], c2val )
attr(allReviews, "Corrections") <<-
c(attr(allReviews, "Corrections"), action)
allReviews[c1] <<- c2val
allReviews[c2] <<- c1val
}
swappableCells <- function ( r, exclude ) {
## Find cells that we can swap from
## r is the row we are swapping out of, need to exclude it:
cells <- seq(from = r, by = classSize, length.out = numReviewers)
src <- seq(totReviews)[ -cells ]
## 'exclude' represents student names to NOT include
src <- src[ !(allReviews[src] %in% exclude) ]
## Randomize and return
sample(src)
}
fixSelfReview <- function() {
## Resolve rows that are reviewing themselves
## message("Correcting rows where student is self-evaluating")
numSwapped <- 0
for (r in 1:classSize) {
## The name of this reviewer:
rev <- classroom[r]
## The students currently assigned to them:
row <- allReviews[r,]
## Do nothing if the student is not reviewing themselves
if (!(rev %in% row)) next
## Ok, we need to swap the self-entry(ies) with someone else
## The cells owned by this row:
cells <- seq(from = r, by = classSize, length.out = numReviewers)
src <- swappableCells( r, rev )
srcInd <- 0
## We know at least one cell is ourself. Change each one that is
for (c1 in cells) {
if (allReviews[c1] == rev) {
## Ok, this cell is a problem. Swap it:
srcInd <- srcInd + 1
swapReview( c1, src[ srcInd], "Self-reviewed" )
numSwapped <- numSwapped + 1
}
}
}
}
fixDuplicates <- function() {
## Fix rows where the reviewer has been assigned the same
## classmate two or more times
numSwapped <- 0
for (r in 1:classSize) {
## The name of this reviewer:
rev <- classroom[r]
## The cells owned by this row:
cells <- seq(from = r, by = classSize, length.out = numReviewers)
## Consider each cell in turn:
for (cellInd in seq_len(length(cells))) {
c1 <- cells[ cellInd ]
this <- allReviews[ c1 ]
those <- allReviews[ cells[ -cellInd ] ]
if (this %in% those) {
## This cell is a duplicate within the row
src <- swappableCells( r, c(rev, allReviews[ cells ]) )
## We need to make sure that we are not introducing a
## problem in the donor row, too.
for (c2 in src) {
## Which row is the donor:
r2 <- row4cell(c2)
## We do not want to make the donor review themselves:
if (classroom[ r2 ] == this) next
## Do not introduce a duplication in the donor:
col <- col4cell(c2)
dCells <- allReviews[r2, -col]
if (this %in% dCells) next
## Looks like this swap will not violate constraints
swapReview( c1, c2, "Duplicate" )
## Ok, we can stop looping
break
}
}
}
}
}
setClass(s, n, sp)
}
## This was partly an exercise to assure fully random (at least as
## random as R's RNG is) sampling of values within the context of
## specific row and column constraints. I don't know if the sequential
## (ie non-random) resolution of constraint violations introduces
## non-randomness. I don't *think* so ...
## Test the above code:
source("https://gist.github.com/maptracker/f0ec01bed4d1c1583bf6/raw/025e60b1ee773d65f97a16ec81d2ee2879271dbf/StudentPeerReview.R")
## Demo with Class Olympus:
reviewerMatrix()
## Demo class with 4 reviews each:
reviewerMatrix(NULL, 4)
## Using a string with a splitter:
reviewerMatrix("Sally, Bob, Marcos, Rover, Betsy, Conan", 2, ", ")
@maptracker

This comment has been minimized.

Copy link
Owner Author

@maptracker maptracker commented Feb 10, 2016

source("https://gist.github.com/maptracker/f0ec01bed4d1c1583bf6/raw/025e60b1ee773d65f97a16ec81d2ee2879271dbf/StudentPeerReview.R")
set.seed(1234)
reviewerMatrix(NULL, 4)

No students provided, using example data
          Student1    Student2   Student3    Student4   
Aphrodite "Demeter"   "Athena"   "Hestia"    "Apollo"   
Apollo    "Demeter"   "Hermes"   "Dionysus"  "Hades"    
Ares      "Hermes"    "Artemis"  "Poseidon"  "Aphrodite"
Artemis   "Hades"     "Dionysus" "Hera"      "Ares"     
Athena    "Apollo"    "Hades"    "Hestia"    "Artemis"  
Demeter   "Athena"    "Hermes"   "Aphrodite" "Artemis"  
Dionysus  "Aphrodite" "Poseidon" "Hera"      "Apollo"   
Hera      "Hades"     "Dionysus" "Apollo"    "Demeter"  
Hermes    "Ares"      "Dionysus" "Aphrodite" "Poseidon" 
Hades     "Hermes"    "Hestia"   "Hera"      "Athena"   
Hestia    "Artemis"   "Athena"   "Ares"      "Poseidon" 
Poseidon  "Ares"      "Demeter"  "Hera"      "Hestia"   
attr(,"Corrections")
[1] "Self-reviewed: Athena trades Athena to Aphrodite for Hestia"
[2] "Self-reviewed: Demeter trades Demeter to Hera for Artemis"  
[3] "Duplicate: Ares trades Athena to Hades for Hermes"          
[4] "Duplicate: Demeter trades Artemis to Ares for Athena"       
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment