R/expected_strictness.R

In neumanrq/fairreviewers: "Strictness correction mechanics: Re-order a set of documents that have been ranked by humans"

expected_strictness_env <- function(rating_matrix) {
  env <- new.env()

  total_point_frequencies <- table(rating_matrix, useNA = "no")
  probabilities_X         <- total_point_frequencies / sum(!is.na(rating_matrix))
  values                  <- as.numeric(rownames(total_point_frequencies))
  mat_X                   <- cbind(values, probabilities_X) # each row is of the form [x, p(x)]
  E_X                     <- sum(apply(mat_X, 1, prod)) # sum up x*p(x) looping over x from 0 to 10

  # Now we do the same but for a single reviewer.
  relative_point_frequencies_for_reviewer <- function(reviewer_column) {
    table(reviewer_column)
  }

  # Each item describes the probability that the fixed reviewer will assign
  # these rating points to a document.
  probabilities_X_l <- function(reviewer_column) {
    total_ratings_of_reviewer <- sum(!is.na(reviewer_column))
    relative_point_frequencies_for_reviewer(reviewer_column) / total_ratings_of_reviewer
  }

  # E[X_l]
  expected_value_reviewer <- function(reviewer_column) {
    frequencies <- relative_point_frequencies_for_reviewer(reviewer_column)
    values      <- as.numeric(rownames(frequencies))
    mat_X_l     <- cbind(values, probabilities_X_l(reviewer_column))

    sum(apply(mat_X_l, 1, prod))
  }

  # S* := E[X] / E[X_l]
  expected_strictness <- function(reviewer_column) { 
    E_X / expected_value_reviewer(reviewer_column)
  }

  # Let's apply this and find out how strict our reviewers have been:
  env$expected_strictness_vector <- apply(rating_matrix, 2, expected_strictness)
  env$expected_values_vector <- apply(rating_matrix, 2, expected_value_reviewer)

  env
}