## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(grouper)
library(ompr)
library(ompr.roi)
#library(ROI.plugin.gurobi)
library(ROI.plugin.glpk)

## -----------------------------------------------------------------------------
dba_gc_ex001

## ----echo=FALSE, comment=''---------------------------------------------------
cat(readLines(system.file("extdata",  "dba_params_ex001.yml",   
                          package = "grouper")),  sep = '\n')

## -----------------------------------------------------------------------------
# indicate appropriate columns using integer ids.
df_ex001_list <- extract_student_info(dba_gc_ex001, "diversity",
                                  demographic_cols = 2, skills = 3, 
                                  self_formed_groups = 4)
yaml_ex001_list <- extract_params_yaml(system.file("extdata", 
                                             "dba_params_ex001.yml",  
                                             package = "grouper"),
                                       "diversity")
m1 <- prepare_model(df_ex001_list, yaml_ex001_list, assignment="diversity",
                    w1=1.0, w2=0.0)
#result3 <- solve_model(m1, with_ROI(solver="gurobi"))
result3 <- solve_model(m1, with_ROI(solver="glpk"))
assign_groups(result3, assignment = "diversity", dframe=dba_gc_ex001, 
              group_names="groups")

## -----------------------------------------------------------------------------
df_ex001_alt <- extract_info(
  assignment = "diversity",
  dframe = dba_gc_ex001,
  demographic_cols = 2,
  skills = 3,
  self_formed_groups = 4
)

m1_alt <- prepare_model(
  df_ex001_alt,
  assignment = "diversity",
  w1 = 1.0,
  w2 = 0.0,
  n_topics = 2,
  nmin = 2,
  nmax = 2,
  rmin = 1,
  rmax = 1
)

result3_alt <- solve_model(m1_alt, with_ROI(solver = "glpk"))
assign_groups(
  model_result = result3_alt,
  assignment = "diversity",
  dframe = dba_gc_ex001,
  group_names = "groups"
)

## -----------------------------------------------------------------------------
# indicate appropriate columns using integer ids.
df_ex001_list <- extract_student_info(dba_gc_ex001, "diversity",
                                  demographic_cols = 2, skills = 3, 
                                  self_formed_groups = 4)
yaml_ex001_list <- extract_params_yaml(system.file("extdata", 
                                             "dba_params_ex001.yml",  
                                             package = "grouper"),
                                       "diversity")
m1a <- prepare_model(df_ex001_list, yaml_ex001_list, assignment="diversity",
                    w1=0.0, w2=1.0)
#result3 <- solve_model(m1a, with_ROI(solver="gurobi"))
result3 <- solve_model(m1a, with_ROI(solver="glpk"))

assign_groups(result3, assignment = "diversity", dframe=dba_gc_ex001, 
              group_names="groups")

get_solution(result3, smin)
get_solution(result3, smax)

## -----------------------------------------------------------------------------
df_ex001_skill_alt <- extract_info(
  assignment = "diversity",
  dframe = dba_gc_ex001,
  demographic_cols = 2,
  skills = 3,
  self_formed_groups = 4
)

m1a_alt <- prepare_model(
  df_ex001_skill_alt,
  assignment = "diversity",
  w1 = 0.0,
  w2 = 1.0,
  n_topics = 2,
  nmin = 2,
  nmax = 2,
  rmin = 1,
  rmax = 1
)

result3_skill_alt <- solve_model(m1a_alt, with_ROI(solver = "glpk"))

assign_groups(
  model_result = result3_skill_alt,
  assignment = "diversity",
  dframe = dba_gc_ex001,
  group_names = "groups"
)

get_solution(result3_skill_alt, smin)
get_solution(result3_skill_alt, smax)

## -----------------------------------------------------------------------------
dba_gc_ex003

## -----------------------------------------------------------------------------
d_mat <- matrix(c(0, 1, 1, 2,
                  1, 0, 2, 1,
                  1, 2, 0, 1,
                  2, 1, 1, 0), nrow=4, byrow = TRUE)

## -----------------------------------------------------------------------------
df_ex003_list <- extract_student_info(dba_gc_ex003, "diversity",
                                skills = NULL,
                                self_formed_groups = 3,
                                d_mat=d_mat)
yaml_ex003_list <- extract_params_yaml(system.file("extdata",   
                                                   "dba_params_ex003.yml",   
                                                   package = "grouper"), 
                                       "diversity")
m3 <- prepare_model(df_ex003_list, yaml_ex003_list, w1=1.0, w2=0.0)
result <- solve_model(m3, with_ROI(solver="glpk", verbose=TRUE))

assign_groups(result, "diversity", dba_gc_ex003, group_names="self_groups")

## -----------------------------------------------------------------------------
df_ex003_alt <- extract_info(
  assignment = "diversity",
  dframe = dba_gc_ex003,
  skills = NULL,
  self_formed_groups = 3,
  d_mat = d_mat
)

m3_alt <- prepare_model(
  df_ex003_alt,
  assignment = "diversity",
  w1 = 1.0,
  w2 = 0.0,
  n_topics = 2,
  nmin = 2,
  nmax = 2,
  rmin = 1,
  rmax = 1
)

result_alt <- solve_model(m3_alt, with_ROI(solver = "glpk", verbose = TRUE))

assign_groups(
  model_result = result_alt,
  assignment = "diversity",
  dframe = dba_gc_ex003,
  group_names = "self_groups"
)

## -----------------------------------------------------------------------------
dba_gc_ex004

## -----------------------------------------------------------------------------
df_ex004_list <- extract_student_info(dba_gc_ex004, 
                                      skills = 2, 
                                      self_formed_groups = 3, 
                                      d_mat=matrix(0, 5, 5))
yaml_ex004_list <- extract_params_yaml(system.file("extdata",    
                                                   "dba_params_ex004.yml",   
                                                   package = "grouper"),  
                                       "diversity")
m4 <- prepare_model(df_ex004_list, yaml_ex004_list, w1=0.0, w2=1.0)
result <- solve_model(m4, with_ROI(solver="glpk", verbose=TRUE))
assign_groups(result, "diversity", dba_gc_ex004, group_names="self_groups")

## -----------------------------------------------------------------------------
df_ex004_alt <- extract_info(
  assignment = "diversity",
  dframe = dba_gc_ex004,
  skills = 2,
  self_formed_groups = 3,
  d_mat = matrix(0, 5, 5)
)

m4_alt <- prepare_model(
  df_ex004_alt,
  assignment = "diversity",
  w1 = 0.0,
  w2 = 1.0,
  n_topics = 2,
  nmin = c(2, 3),
  nmax = c(2, 3),
  rmin = 1,
  rmax = 1
)

result4_alt <- solve_model(m4_alt, with_ROI(solver = "glpk", verbose = TRUE))
assign_groups(
  model_result = result4_alt,
  assignment = "diversity",
  dframe = dba_gc_ex004,
  group_names = "self_groups"
)

## -----------------------------------------------------------------------------
pba_gc_ex002

## -----------------------------------------------------------------------------
pba_prefmat_ex002

## -----------------------------------------------------------------------------
df_ex002_list <- extract_student_info(pba_gc_ex002, "preference", 
                                      self_formed_groups = 2, 
                                      pref_mat = pba_prefmat_ex002)
yaml_ex002_list <- extract_params_yaml(system.file("extdata", 
                                             "pba_params_ex002.yml",  
                                             package = "grouper"),
                                       "preference")
m2 <- prepare_model(df_ex002_list, yaml_ex002_list, "preference")

#result2 <- solve_model(m2, with_ROI(solver="gurobi"))
result2 <- solve_model(m2, with_ROI(solver="glpk"))
assign_groups(result2, assignment = "preference", 
              dframe=pba_gc_ex002, yaml_ex002_list, 
              group_names="grouping")

## -----------------------------------------------------------------------------
df_ex002_alt <- extract_info(
  assignment = "preference",
  dframe = pba_gc_ex002,
  self_formed_groups = 2,
  pref_mat = pba_prefmat_ex002
)

m2_alt <- prepare_model(
  df_ex002_alt,
  assignment = "preference",
  n_topics = 2,
  B = 2,
  nmin = 2,
  nmax = 2,
  rmin = 1,
  rmax = 1
)

result2_alt <- solve_model(m2_alt, with_ROI(solver = "glpk"))
assign_groups(
  model_result = result2_alt,
  assignment = "preference",
  dframe = pba_gc_ex002,
  params_list = list(n_topics = 2, B = 2),
  group_names = "grouping"
)

## -----------------------------------------------------------------------------
multirole_students_ex001
multirole_prefmat_ex001
multirole_demand_ex001

## ----include = FALSE----------------------------------------------------------
c_sem <- 4

## -----------------------------------------------------------------------------
multirole_ex001 <- extract_multirole_info(
  student_df = multirole_students_ex001,
  d_mat = multirole_demand_ex001,
  p_ta_mat = multirole_prefmat_ex001,
  e_mode = "rr",
  C = c_sem
)

multirole_ex001$d

## -----------------------------------------------------------------------------
m_multirole_ex001 <- prepare_multirole_model(
  multirole_ex001,
  ta_protected_max = 1,
  ta_min = 1, ta_max = 1,
  gr_min = 1, gr_max = 1,
  alpha_ta = 2, beta_ta = 1, phi = 1, rho_ta = 10,
  alpha_gr = NULL, beta_gr = NULL, rho_gr = NULL
)

result_multirole_ex001 <- solve_model(
  m_multirole_ex001,
  with_ROI(solver = "glpk")
)

assign_job(
  result_multirole_ex001,
  student_df = multirole_students_ex001,
  course_codes = rownames(multirole_demand_ex001),
  name_col = "Name"
)

## -----------------------------------------------------------------------------
full_multirole_inputs <- extract_info(
  assignment = "multirole",
  student_df = multirole_students_ex001,
  d_mat = multirole_demand_ex001,
  p_ta_mat = multirole_prefmat_ex001,
  p_gr_mat = multirole_prefmat_ex001,
  e_mode = "rr",
  C = c_sem
)

full_multirole_model <- prepare_model(
  full_multirole_inputs,
  assignment = "multirole",
  protected_year_ta = 1,
  protected_year_gr = 2,
  ta_protected_max = 1,
  gr_protected_max = 1,
  alpha_ta = 2,
  alpha_gr = 2,
  beta_ta = 1,
  beta_gr = 1,
  phi = 1,
  rho_ta = 10,
  rho_gr = 10
)

full_multirole_result <- solve_assignment(
  model = full_multirole_model,
  assignment = "multirole",
  solver = "glpk",
  student_df = multirole_students_ex001,
  course_codes = rownames(multirole_demand_ex001),
  name_col = "Name",
  verbose = FALSE
)

full_multirole_result$output

## ----echo = FALSE-------------------------------------------------------------
full_assignment <- full_multirole_result$output
full_ta_cols <- grepl("-t$", names(full_assignment))
full_gr_cols <- grepl("-g$", names(full_assignment))
full_e_cols <- grepl("-e$", names(full_assignment))

data.frame(
  Name = full_assignment$Name,
  TA = rowSums(full_assignment[, full_ta_cols, drop = FALSE]),
  GR = rowSums(full_assignment[, full_gr_cols, drop = FALSE]),
  E = rowSums(full_assignment[, full_e_cols, drop = FALSE]),
  current_total = rowSums(
    full_assignment[
      , full_ta_cols | full_gr_cols | full_e_cols,
      drop = FALSE
    ]
  )
)

## -----------------------------------------------------------------------------
multirole_students_ex001_sem <- multirole_students_ex001[
  , c("student_id", "year", "Name")
]

multirole_ex001_sem <- extract_multirole_info(
  student_df = multirole_students_ex001_sem,
  d_mat = multirole_demand_ex001,
  p_ta_mat = multirole_prefmat_ex001,
  e_mode = "rr",
  C = c_sem,
  single_semester = TRUE
)

m_multirole_ex001_sem <- prepare_model(
  multirole_ex001_sem,
  assignment = "multirole",
  ta_protected_max = 1,
  ta_min = 1, ta_max = 1,
  gr_min = 1, gr_max = 1
)

result_multirole_ex001_sem <- solve_model(
  m_multirole_ex001_sem,
  with_ROI(solver = "glpk")
)

job_multirole_ex001_sem <- assign_job(
  result_multirole_ex001_sem,
  student_df = multirole_students_ex001_sem,
  course_codes = rownames(multirole_demand_ex001),
  name_col = "Name"
)

job_multirole_ex001_sem

## -----------------------------------------------------------------------------
ta_cols <- grepl("-t$", names(job_multirole_ex001_sem))
gr_cols <- grepl("-g$", names(job_multirole_ex001_sem))
e_cols <- grepl("-e$", names(job_multirole_ex001_sem))

data.frame(
  Name = job_multirole_ex001_sem$Name,
  TA = rowSums(job_multirole_ex001_sem[, ta_cols, drop = FALSE]),
  GR = rowSums(job_multirole_ex001_sem[, gr_cols, drop = FALSE]),
  E = rowSums(job_multirole_ex001_sem[, e_cols, drop = FALSE]),
  current_total = rowSums(
    job_multirole_ex001_sem[, ta_cols | gr_cols | e_cols, drop = FALSE]
  )
)