vendredi 18 septembre 2020

Random draw of pairs (co-workers) per week

From a friend I got a script which draws random sets of co-workers based on an online spreadsheet they filled at lite.framacalc.org. At the moment it draws randomized pairs on a daily basis, but I would like to change it into a weekly draw. Based on the available days instead of the availability of co-workers per day.

Does anyone have a suggestion? Thanks alot!




#### 0. Initialisation ####


## Clear workspace
#rm(list=ls())

## Packages
library(readxl)
library(dplyr)
Sys.setlocale("LC_TIME", "C")

## Paths (TO CHANGE)
wd = "c:/coffee_date/"
path_save =  paste0(wd,"data/")


path_availability <- "https://lite.framacalc.org/spreadsheet"



#### I. Load participants ####


stopifnot(exists("path_availability"))
population = read.csv(url(paste0(path_availability,".csv")), header = T)


#### II. Selection participants ####

## Select participants for today
today = as.character(format(Sys.Date(), "%A"))
population$availability = as.character(population[, today])

population_today = population %>% filter(availability == "V")
population = population_today$name

## Select round number
if (length(population) %% 2 == 1){
  remove_id = sample(population, 1)
  population = setdiff(population, remove_id)
} 


#### III. Draw pairs ####

## Load past pairs
if (file.exists(paste0(path_save, "past_pairs.rds"))){
past_pairs = readRDS(paste0(path_save, "past_pairs.rds"))
} else {
  past_pairs =  data.frame(v1 = NA, v2 = NA, nb_days = 0)
}

## Draw new paires
repeated_pairs = T
while (repeated_pairs) {
  # Draw paires 
  pairs  = t(as.data.frame(split(sample(population),rep(1:(length(population)/2),each=2)))) 
  # Check not the same as previous days
  black_list = as.matrix(past_pairs[,1:2])
  if (sum(duplicated(rbind(pairs, black_list))) == 0){
    repeated_pairs = F
  }
}

#### IV Save and print pairs ####



##  Save ##

# Formatting draw of the day
to_save = as.data.frame(rbind(pairs, pairs[,c(2,1)]))
to_save$nb_days = 0

# Appending with past draws and updating count
updated_previous_draw = rbind(to_save, past_pairs)
updated_previous_draw$nb_days = updated_previous_draw$nb_days + 1

# Remode old draws
updated_previous_draw = updated_previous_draw %>%  filter(nb_days < 5)

# save 
saveRDS(updated_previous_draw, file = paste0(path_save, "past_pairs.rds"))


## Print pairs ##
to_print = as.data.frame(pairs) 
names(to_print) = c("Caller", "Receiver")
to_print = to_print %>% mutate_each(funs(as.character(.)))


if(exists("remove_id")){
  missing = c(as.character(remove_id), "has been left out due to uneven pool :(")
  space = c("","")
  to_print = rbind(to_print, space, missing)
}

print(to_print,right=F, row.names = F)






Aucun commentaire:

Enregistrer un commentaire