Movie to jury member assignment problem

the_assigment_problem_cookie_cutter_style_v1.R

if (!require("vecsets")) {install.packages("vecsets")}
library(vecsets)

movie_assignment <- function(jury, movies, views) {
  slots                  <- jury * views
  
  #### step 1: some basic checks with potential adding/removing of nr of views per member

  # check if more views per jury member than there are movies
  if(views>movies) {
    message("More views than there are movies.")
    message(paste0("Decreased views per jury member from ",views," to ", movies))
    message("Careful: that means each jury member watches all movies.")
    views                <- movies
    slots                <- jury * views
  }
  # Check if not too few views*jury to see all of the movies - if so, add views (loose constraint)
  if(slots<movies) {
    message("Too few views per jury member to see all movies.")
    add_views            <- ceiling((movies-(slots%%movies))/jury)
    views                <- add_views + views
    slots                <- jury * views
    message(paste0("Adding ",add_views," views per jury member, for a total of ", views, " views."))
  }
  
  ####  step 2: create some vector that contains (as close as possible to) equal overall views per movie
  
  # Divide movies over slots while mainting ascending order, up until quotient
  mvector   <- rep(c(1:movies), each = slots %/% movies)
  # If there is a remainder, fill
  if (slots %% movies > 0) {
    mvector <- c(mvector, (1:(slots %% movies)))
  }
  
  ####  step 3: Now repeatedly extract randomly unique combinations till no left, 
  ####          filling incidental NA's (mostly at the end of loop) with least chosen.
  
  vjm <- c()
  while(length(mvector) > 0) {
    # unique sample from remaining movies in movie vector with views length
    mviews   <- unique(sample(mvector))[1:views]
    # least favorite part, needed to catch NA's sometimes near end - anyways, it does the trick.
    if(anyNA(mviews)) {
      nas  <- is.na(mviews)
      snas <- sum(nas)
      mviews[nas] <- sample(sort(tabulate(vjm),index.return=TRUE)$ix[1:snas], snas, replace=F)
    }
    # add it to our matrix views/jury matrix
    vjm                 <- unname(cbind(vjm,mviews))
    # remove sampled set from movie vector
    mvector        <- vsetdiff(mvector, mviews)
  }
  # return our matrix with rows for views, jury for columns, and movie nr's for cells
  vjm 
}

######################## let's test our little evenly dividing function:

movies    <- 35    # Number of moviews
jury      <- 200   # Number of jury members
views     <- 15    # Number of movie views per jury member (loose constraint)

vjm <- movie_assignment(jury, movies, views)

message("Assignment matrix, columns are reviewers:")
print(vjm)
message("How many times is each movie viewed?")
print(tabulate(vjm))
message("Largest difference in views per movie?")
print(max(tabulate(vjm))- min(tabulate(vjm)))