Test case for within plate optimization

[julianesiebourg]

This example data did not do well using the standard options for the plate scoring function in the multi_plate_wrapper.

samples <- tibble::tribble(
     ~OriginalSampleID, ~StudyID, ~Diagnosis, ~SeverityGroup,  ~Status,  ~Gender, ~Age,
                    1L,     "S4",  "Disease",       "Severe",   "high",   "Male",   91,
                    2L,     "S4",  "Disease", "MildModerate", "normal", "Female",   80,
                    3L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   82,
                    4L,     "S4",  "Disease", "MildModerate", "normal", "Female",   66,
                    5L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   89,
                    6L,     "S4",  "Disease",       "Severe", "normal",   "Male",   64,
                    7L,     "S4",  "Disease",       "Severe", "normal",   "Male",   61,
                    8L,     "S4",  "Disease", "MildModerate", "normal", "Female",   77,
                    9L,     "S4",  "Disease",       "Severe",   "high",   "Male",   86,
                   10L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   65,
                   11L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   73,
                   12L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   72,
                   13L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   76,
                   14L,     "S4",  "Disease", "MildModerate", "normal",   "Male",   62,
                   15L,     "S4",  "Disease", "MildModerate", "normal", "Female",   78,
                   16L,     "S4",  "Control",      "Control", "normal", "Female",   70,
                   17L,     "S4",  "Control",      "Control", "normal",   "Male",   75,
                   18L,     "S4",  "Control",      "Control", "normal", "Female",   75,
                   19L,     "S4",  "Control",      "Control", "normal", "Female",   73,
                   20L,     "S4",  "Control",      "Control", "normal", "Female",   75,
                   21L,     "S4",  "Control",      "Control", "normal",   "Male",   57,
                   22L,     "S4",  "Control",      "Control", "normal", "Female",   69,
                   23L,     "S4",  "Control",      "Control", "normal", "Female",   74,
                   24L,     "S4",  "Control",      "Control", "normal", "Female",   72,
                   25L,     "S4",  "Control",      "Control", "normal",   "Male",   63,
                   26L,     "S4",  "Control",      "Control", "normal",   "Male",   55,
                   27L,     "S4",  "Control",      "Control", "normal", "Female",   55,
                   28L,     "S4",  "Control",      "Control", "normal", "Female",   63,
                   29L,     "S4",  "Control",      "Control", "normal", "Female",   66,
                   30L,     "S3",  "Control",      "Control",   "high", "Female",   48,
                   31L,     "S3",  "Control",      "Control",   "high",   "Male",   63,
                   32L,     "S2",  "Control",      "Control",   "high", "Female",   67,
                   33L,     "S2",  "Control",      "Control",   "high", "Female",   82,
                   34L,     "S2",  "Control",      "Control",   "high", "Female",   81,
                   35L,     "S1",  "Control",      "Control",   "high",   "Male",   72,
                   36L,     "S1",  "Control",      "Control",   "high", "Female",   63,
                   37L,     "S2",  "Control",      "Control", "normal", "Female",   79,
                   38L,     "S2",  "Control",      "Control", "normal",   "Male",   72,
                   39L,     "S2",  "Control",      "Control", "normal",   "Male",   66,
                   40L,     "S2",  "Control",      "Control", "normal", "Female",   77,
                   41L,     "S2",  "Control",      "Control", "normal",   "Male",   62,
                   42L,     "S2",  "Control",      "Control", "normal",   "Male",   81,
                   43L,     "S2",  "Control",      "Control", "normal",   "Male",   75,
                   44L,     "S3",  "Disease", "MildModerate", "normal", "Female",   47,
                   45L,     "S3",  "Disease", "MildModerate", "normal",   "Male",   55,
                   46L,     "S2",  "Disease", "MildModerate", "normal",   "Male",   75,
                   47L,     "S2",  "Disease", "MildModerate", "normal", "Female",   87,
                   48L,     "S2",  "Disease", "MildModerate", "normal", "Female",   53,
                   49L,     "S2",  "Disease", "MildModerate", "normal", "Female",   71,
                   50L,     "S2",  "Disease", "MildModerate", "normal", "Female",   78,
                   51L,     "S2",  "Disease", "MildModerate", "normal", "Female",   76,
                   52L,     "S2",  "Disease", "MildModerate", "normal",   "Male",   73,
                   53L,     "S2",  "Disease", "MildModerate", "normal", "Female",   65,
                   54L,     "S3",  "Disease", "MildModerate",   "high", "Female",   52,
                   55L,     "S3",  "Disease", "MildModerate",   "high",   "Male",   45,
                   56L,     "S3",  "Disease", "MildModerate",   "high",   "Male",   48,
                   57L,     "S3",  "Disease", "MildModerate",   "high",   "Male",   47,
                   58L,     "S2",  "Disease", "MildModerate",   "high", "Female",   75,
                   59L,     "S2",  "Disease", "MildModerate",   "high",   "Male",   63,
                   60L,     "S2",  "Disease", "MildModerate",   "high",   "Male",   62,
                   61L,     "S2",  "Disease", "MildModerate",   "high", "Female",   77,
                   62L,     "S1",  "Disease", "MildModerate",   "high", "Female",   69,
                   63L,     "S1",  "Disease", "MildModerate",   "high",   "Male",   83,
                   64L,     "S1",  "Disease", "MildModerate",   "high", "Female",   67,
                   65L,     "S3",  "Disease",       "Severe", "normal", "Female",   56,
                   66L,     "S3",  "Disease",       "Severe", "normal",   "Male",   54,
                   67L,     "S3",  "Disease",       "Severe", "normal",   "Male",   50,
                   68L,     "S2",  "Disease",       "Severe",   "high", "Female",   74,
                   69L,     "S2",  "Disease",       "Severe", "normal",   "Male",   70,
                   70L,     "S2",  "Disease",       "Severe", "normal", "Female",   75,
                   71L,     "S2",  "Disease",       "Severe", "normal",   "Male",   78,
                   72L,     "S2",  "Disease",       "Severe", "normal", "Female",   57,
                   73L,     "S2",  "Disease",       "Severe", "normal",   "Male",   70,
                   74L,     "S2",  "Disease",       "Severe", "normal",   "Male",   72,
                   75L,     "S2",  "Disease",       "Severe", "normal", "Female",   76,
                   76L,     "S2",  "Disease",       "Severe",   "high",   "Male",   76,
                   77L,     "S2",  "Disease",       "Severe",   "high",   "Male",   86,
                   78L,     "S2",  "Disease",       "Severe",   "high",   "Male",   74,
                   79L,     "S2",  "Disease",       "Severe",   "high",   "Male",   59,
                   80L,     "S2",  "Disease",       "Severe",   "high", "Female",   73,
                   81L,     "S3",  "Disease",       "Severe",   "high",   "Male",   65,
                   82L,     "S3",  "Disease",       "Severe",   "high", "Female",   66,
                   83L,     "S2",  "Disease",       "Severe",   "high", "Female",   53,
                   84L,     "S2",  "Disease",       "Severe",   "high",   "Male",   73,
                   85L,     "S1",  "Disease",       "Severe",   "high", "Female",   57,
                   86L,     "S1",  "Disease",       "Severe",   "high",   "Male",   77
     )     

bc <- BatchContainer$new(
  dimensions = list(
    "plate" = 1,
    "row" = 8,
    "column" = 11
  )
)
assign_random(bc, samples)

# set scoring function for each balance variable
scoring_funcs <- purrr::map(
  params$balance_variables, 
  ~ mk_plate_scoring_functions(bc, row = "row", column = "column", group = .x, 
                               p = 2, penalize_lines = "soft")
  ) %>% unlist()
names(scoring_funcs) <- params$balance_variables
bc$scoring_f <- scoring_funcs

traces <- optimize_design(
  bc,
  max_iter = 5000,
  quiet = TRUE,
  # not actually needed... since here is only one plate
  shuffle_proposal_func = mk_subgroup_shuffling_function(
          subgroup_vars = "plate",
          restrain_on_subgroup_levels = 1
  ),
  acceptance_func = accept_leftmost_improvement
)
 

Changing the mk_plate_scoring_functions options p = 1, penalize_lines = "none" works a lot better.