First pass at getting #random reviewer/reviewee assignments

StudentListToGitHubWiki.R

## 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
}

StudentPeerReview.R

### 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 ...

StudentPeerReviewTest.R

## 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, ", ")

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"