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