Test case for within plate optimization #21
Description
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.