An approach to peer review assignment

[jennybc]

As promised in Slack, here's code I used for assigning peer reviewers. Apparently I passed this along to other instructors in UBC's MDS program at some point, so here's my exposition. Basically we just use columns from a Latin square.

---

Functions needed to assign reviewers

g <- function(j, n) {
  i <- seq_len(n)
  (((i - 1) + (j - 1)) %% n) + 1
}
make_pr_assignments <- function(n = 4, m = 2, self = TRUE) {
  stopifnot(n > 1, m > 0, m < n)
  stopifnot(is.logical(self), length(self) == 1L)
  n <- as.integer(n)
  m <- as.integer(m)
  j <- sample(2:n, m)
  res <- do.call(cbind, lapply(j, g, n = n))
  if (isTRUE(self)) {
    res <- cbind(seq_len(n), res)
  }
  res
}

Worked example.

Let n be the number of students and m be the number of peer reviews given/received. self defaults to TRUE, which means the first column will be 1:n. Set to FALSE to suppress that.

n <- 10
m <- 2
hw_assign <- make_pr_assignments(n = n, m = m)
colnames(hw_assign) <- c("self", "first", "second")
hw_assign
#>       self first second
#>  [1,]    1     7      4
#>  [2,]    2     8      5
#>  [3,]    3     9      6
#>  [4,]    4    10      7
#>  [5,]    5     1      8
#>  [6,]    6     2      9
#>  [7,]    7     3     10
#>  [8,]    8     4      1
#>  [9,]    9     5      2
#> [10,]   10     6      3

Test the constraints.

n_unique <- apply(hw_assign, 1, function(x) length(unique(x)))
all(n_unique == 3)
#> [1] TRUE
n_unique <- apply(hw_assign, 2, function(x) length(unique(x)))
all(n_unique == n)
#> [1] TRUE

Now you will use the columns of hw_assign to index into student names. If you want more exposition, read on.

Exposition

Peer review assignments must obey these constraints:

1. No one should review their own work.
2. The two peers whose work is assigned should be distinct.

This is why I hold the peer review assignments for one homework as a matrix with n rows, where n is the number of students, and m + 1 columns, where m is the number of peer reviews given/received. For example, if m = 2:

1. First column holds 1, 2, …, n = the peer reviewer.
2. Second column holds a permutation of 1, 2, …, n = the first peer.
3. Third column holds another permutation of 1, 2, …, n = the second peer.

We meet the constraints when columns 2 and 3 hold permutations of 1:n and each row holds 3 distinct values.

I used to generate the assignments randomly, but I recently realized there’s a deterministic solution. Consider an n x n Latin square with 1:n as the first column. Pick two of the other columns at random. You’re DONE.

Just FYI: One can read about random generation of latin squares here: http://math.stackexchange.com/questions/63131/generate-random-latin-squares. But note we don’t need to do this, just picking valid ones from the Latin square is good enough. I never promised a uniform distribution over all possible peer review assignments! However, if the set of students if fixed, like it is in MDS, you might want to do a bunch of peer review assignments at once, if you’re worried about re-using the same column by chance.

Explicit examples of the logic

Here’s the entire Latin square.

library(tidyverse)
#> ── Attaching packages ─────────────────────────────────────────── tidyverse 1.2.1.9000 ──
#> ✔ ggplot2 3.1.1          ✔ purrr   0.3.2     
#> ✔ tibble  2.1.2          ✔ dplyr   0.8.1     
#> ✔ tidyr   0.8.3.9000     ✔ stringr 1.4.0     
#> ✔ readr   1.3.1          ✔ forcats 0.4.0
#> ── Conflicts ─────────────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
n <- 4
x <- crossing(j = seq_len(n) - 1,
              i = seq_len(n) - 1)
x <- x %>%
  mutate(k = ((j + i) %% n) + 1)
matrix(x$k, nrow = n)
#>      [,1] [,2] [,3] [,4]
#> [1,]    1    2    3    4
#> [2,]    2    3    4    1
#> [3,]    3    4    1    2
#> [4,]    4    1    2    3

Here’s how to generate just the i,j-th entry.

f <- function(i, j, n) {
  (((i - 1) + (j - 1)) %% n) + 1
}
f(2, 3, n)
#> [1] 4

Here’s how to generate j-th column, which is what we do above in the main function.

g <- function(j, n) {
  i <- seq_len(n)
  (((i - 1) + (j - 1)) %% n) + 1
}
g(4, n)
#> [1] 4 1 2 3

[thereseanders]

Thank you so much @jennybc for this suggestion! We used the Latin Square approach within the peer_roster_create() function (in PR #66).

latin_square = function(j, n) {
  i <- seq_len(n)
  (((i - 1) + (j - 1)) %% n) + 1
}

j = sample(2:length(user), n_rev)
res = purrr::map(j, ~ latin_square(.x, length(user)))