Calculating the design
#> ... user specified treatment allocation constraint (Treatment-Strain-Sex) #> ... facilitating homogeneity of treatment in cages (CageGroup) #> ... ANOVA -logP for numerical variables balanced across treatment (ArrivalWeight, AgeGroup) -#> CAUTION: User defined constraints could not be fully met (remaining score 4) +#> Success. User provided constraints could be fully met. # Form cages with reasonable animal numbers and compliant with all constraints design_cage <- Invivo_assignCages(design_trt, @@ -39,17 +39,15 @@Calculating the design
) #> Setting up batch container. #> -#> Formed 19 homogeneous groups using 59 samples. +#> Formed 22 homogeneous groups using 59 samples. #> 27 subgroups needed to satisfy size constraints. #> #> Finding possible ways to allocate variable of interest with 1 levels ... #> #> Finished with 27 recursive calls. #> 1 allocations found. -#> No permutations fulfilling the 'keep_separate' constraints in 1000 iters! -#> Increasing number of tolerated violations to 1 #> -#> Expecting 27 cages to be created and 3 single-housed animals. +#> Expecting 27 cages to be created and 4 single-housed animals. #> Constructing scoring functions: #> ... ANOVA -logP for numerical variables balanced across cages (ArrivalWeight, AgeGroup) #> Adding 4 attributes to samples. @@ -70,7 +68,7 @@Calculating the design
#> Distributing target variables (Treatment, Strain, Sex) within rack #> ... Rack 1 #> ... Performing simple mean/stddev adjustment. -#> ... final scores: Plate_Treatment: 5.2, Plate_Strain: 5.46, Plate_Sex: 5.67 +#> ... final scores: Plate_Treatment: 5.12, Plate_Strain: 5.48, Plate_Sex: 5.72Visualization of the study design
@@ -82,7 +80,7 @@Cage composition
treatment, strain and sex.Females are exclusively used for treatment 2, as was specified in the treatment list.
-
Body weights
@@ -95,19 +93,19 @@Body weights
compensate, achieving better cross-treatment balance of this factor.Red diamonds mark the mean values for a specific sex within each treatment group.
-
Cage arrangement in rack
The following plots show the organization of the cage rack, individual cages colored by different variables each time.
-
Individual animals in cages
Finally, an overview plot illustrates the placement of animals in the cages. Notice the distinct earmarks within each cage, a ‘soft’ design constraint that could be achieved with the given solution.
-
Example 1: An expensive way to construct a 4x4 latin square (one
# Add samples to container
# Need unique Sample ID. Can we drop this constraint?
-assign_in_order(example1,
+example1 <- assign_in_order(example1,
samples = tibble::tibble(
Group = rep(c("Grp 1", "Grp 2", "Grp 3", "Grp 4"), each = 4),
ID = 1:16
@@ -39,23 +39,22 @@ Example 1: An expensive way to construct a 4x4 latin square (one
)
# The following does not work (an gives a constant score of 144!)
-# example1$scoring_f <- osat_score_generator(batch_vars = c("row","col"), feature_vars = c("Group"))
+# scoring_f <- osat_score_generator(batch_vars = c("row","col"), feature_vars = c("Group"))
# First analysis of problem indicates that osat_score generates a full row*col vector of 'ideal scores'
# which are in fact the same value, implying an identical overall result as each position can be either
# allocated by 1 sample or 0 samples, the sum of 1's being the sample count.
# --> don't use osat_score if there's a lack of samples as compared to possible positioning
-bc <- example1$copy()
-
# # Set scoring function
-bc$scoring_f <- list(
+scoring_f <- list(
Row.Score = osat_score_generator(batch_vars = c("row"), feature_vars = c("Group")),
Column.Score = osat_score_generator(batch_vars = c("col"), feature_vars = c("Group"))
)
-
-set.seed(41)
+set.seed(41)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example1,
+ scoring = scoring_f,
max_iter = 300, # this is set to shorten vignette run-time based on known random seed, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
@@ -121,35 +120,33 @@ Example 1: An expensive way to construct a 4x4 latin square (one
#> Aggregated: 16
#> Achieved score: c(0, 0) at iteration 284
#> Aggregated: 0
-trace
-#> Optimization trace (301 score values, elapsed 21.10947 secs).
-#> Starting score: 48,0
-#> Final score : 0,0
+bc$trace$elapsed
+#> Time difference of 5.483629 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex1: Using OSAT scores for plate design\n(not the recommended way!)"
)
-
+
Now using a dedicated scoring for the group distances on a plate.
This should reliably lead to a nice symmetry-bearing latin square
design with only a one-dimensional score to look at.
-bc <- example1$copy()
-
-bc$scoring_f <- mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group")
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example1,
+ scoring = scoring_f,
max_iter = 1000, # this is set to shorten vignette run-time based on random seed, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 11.43023 secs
+bc$trace$elapsed
+#> Time difference of 6.182886 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex1: Using a dedicated plate scoring function:\nThis should show a latin square!"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex2.html b/vignettes/cached/_plate_scoring_ex2.html
index a5299f2d..efcb9fbf 100644
--- a/vignettes/cached/_plate_scoring_ex2.html
+++ b/vignettes/cached/_plate_scoring_ex2.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 2: Scoring two plates at once
@@ -26,37 +34,37 @@ Example 2: Scoring two plates at once
)
# Add samples to container
-assign_in_order(example2, samples = tibble::tibble(
+example2 <- assign_in_order(example2, samples = tibble::tibble(
Group = c(rep(c("Grp 1", "Grp 2", "Grp 3", "Grp 4"), each = 8)),
ID = 1:32
))
-bc <- example2$copy()
-
-bc$scoring_f <- c(mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group"),
+scoring_f <- c(mk_plate_scoring_functions(example2, plate = "plate", row = "row", column = "col", group = "Group"),
osat_plate = osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
)
-plot_plate(bc,
+plot_plate(example2,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: Initial sample arrangement"
)
-
+
-bc$score()
+example2$score(scoring_f)
#> Plate 1 Plate 2 osat_plate
#> 23.89265 23.89265 128.00000
set.seed(41)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
n_shuffle = c(rep(10, 10), rep(3, 90), rep(2, 100), rep(1, 1400)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
aggregate_scores_func = worst_score,
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 25.73155 secs
+bc$trace$elapsed
+#> Time difference of 16.73602 secs
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 osat_plate
#> 6.127258 6.094080 0.000000
@@ -64,7 +72,7 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: Design created by swapping samples 'globally' across the plates"
)
-
+
While this ‘global’ optimization is possible, it does probably not
converge to an (almost) ideal solution in an acceptable time if there
are more samples involved. This is due to a lot of unproductive sample
@@ -75,48 +83,46 @@
Example 2: Scoring two plates at once
the use of a dedicated sample permutation function which takes the plate
structure into account and only shuffles samples around within one
plate.
-# Setting up the batch container
-
-bc <- example2$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 200, # this is set to shorten vignette run-time, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
)
-#> Optimization trace (201 score values, elapsed 4.254329 secs).
-#> Starting score: 128
-#> Final score : 0
+bc$trace$elapsed
+#> Time difference of 2.140794 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Plate wise' design\nStep 1: after allocating samples to plates"
)
-
+
-bc$scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 12.77527 13.63704
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 400,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate")),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm,
quiet = TRUE
)
-trace
-#> Optimization trace (401 score values, elapsed 3.579697 secs).
-#> Starting score: 12.775,13.637
-#> Final score : 6.855,6.309
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 2.140794 3.270934
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.854748 6.309297
@@ -124,7 +130,7 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Plate wise' design\nStep 2: after arranging samples within plates"
)
-
+
In this case, the shuffling function exchanges 1 pair of sample
assignments every time (the default). However, any number of constant
swaps or a swapping protocol (formally a vector of integers) can be
@@ -137,64 +143,62 @@
Example 2: Scoring two plates at once
generates the permutations. It enforces permutation only to happen first
within plate 1, then within plate 2, so that the two scores can be
optimized in succeeding runs.
-# Setting up the batch container
-
-bc <- example2$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 150, # this is set to shorten vignette run-time, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
)
-trace
-#> Optimization trace (151 score values, elapsed 4.056035 secs).
-#> Starting score: 128
-#> Final score : 0
+bc$trace$elapsed
+#> Time difference of 1.791624 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Serial plate' design\nStep 1: after allocating samples to plates"
)
-
+
-bc$scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 10.57482 26.16613
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 150,
quiet = TRUE,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate"), restrain_on_subgroup_levels = c(1)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm
)
-trace
-#> Optimization trace (151 score values, elapsed 2.528134 secs).
-#> Starting score: 10.575,26.166
-#> Final score : 6.416,26.166
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 1.791624 1.591002
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.416193 26.166134
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 550,
quiet = TRUE,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate"), restrain_on_subgroup_levels = c(2)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm
)
-trace
-#> Optimization trace (551 score values, elapsed 2.93787 secs).
-#> Starting score: 6.416,26.166
-#> Final score : 6.416,6.582
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 1.791624 1.591002 4.226352
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.416193 6.581966
@@ -202,5 +206,5 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Serial plate' design\nStep 2: after optimizing each plate in turn"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex3.html b/vignettes/cached/_plate_scoring_ex3.html
index 35a11141..40ed3f06 100644
--- a/vignettes/cached/_plate_scoring_ex3.html
+++ b/vignettes/cached/_plate_scoring_ex3.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 3: 3 plates with different dimension and different sample
@@ -39,7 +47,7 @@ Example 3: 3 plates with different dimension and different sample
# Assign samples randomly to start from a better initial state
-assign_random(example3,
+example3 <- assign_random(example3,
samples = tibble::tibble(
Group = rep.int(c("Grp 1", "Grp 2", "Grp3"),
times = c(69, 30, 69)
@@ -48,35 +56,35 @@ Example 3: 3 plates with different dimension and different sample
)
)
-bc <- example3$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example3,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 150,
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
)
-trace
-#> Optimization trace (151 score values, elapsed 3.348524 secs).
-#> Starting score: 17.714
-#> Final score : 1.429
+bc$trace$elapsed
+#> Time difference of 2.03003 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex3: Dealing with plates of different size\nStep 1: after distributing groups across plates"
)
-
-bc$scoring_f <- mk_plate_scoring_functions(bc,
+
+scoring_f <- mk_plate_scoring_functions(bc,
plate = "plate", row = "row",
column = "col", group = "Group"
)
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 Plate 3
-#> 9.706637 9.585770 10.419567
+#> 9.387071 10.302690 9.826243
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 300,
shuffle_proposal_func = mk_subgroup_shuffling_function(
subgroup_vars = c("plate"),
@@ -86,15 +94,16 @@ Example 3: 3 plates with different dimension and different sample
aggregate_scores_func = L2s_norm,
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 40.35472 secs
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 2.030030 4.778121
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 Plate 3
-#> 8.974408 8.253074 7.980756
+#> 8.809205 8.553802 8.185525
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex3: Dealing with plates of different size\nStep 2: after swapping samples within plates"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex4.html b/vignettes/cached/_plate_scoring_ex4.html
index 61806644..d3c1472d 100644
--- a/vignettes/cached/_plate_scoring_ex4.html
+++ b/vignettes/cached/_plate_scoring_ex4.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 4: More than one group factor to balance and empty plate
@@ -26,31 +34,31 @@ Example 4: More than one group factor to balance and empty plate
# Assign samples randomly to start from lower score (avoid Inf values even since plate 3 will miss 2 groups initially :)
-assign_in_order(example4, samples = tibble::tibble(
+example4 <- assign_in_order(example4, samples = tibble::tibble(
Group = rep.int(c("Treatment 1", "Treatment 2"), times = c(10, 10)),
Sex = c(rep(c("M", "F", "F", "M"), times = 4), "M", NA, NA, "F"), ID = 1:20
))
-bc <- example4$copy()
-
cowplot::plot_grid(
- plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Initial layout by Group"),
- plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Initial layout by Sex"),
+ plot_plate(example4, plate = plate, row = row, column = col, .color = Group, title = "Initial layout by Group"),
+ plot_plate(example4, plate = plate, row = row, column = col, .color = Sex, title = "Initial layout by Sex"),
ncol = 2
)
-
+
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+example4$score(scoring_f)
#> Group.Plate Sex.Plate
#> 83.63858 239.20748
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 750,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 1)),
@@ -59,10 +67,10 @@ Example 4: More than one group factor to balance and empty plate
},
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 7.062086 secs
+bc$trace$elapsed
+#> Time difference of 6.251454 secs
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 8.019656 7.608810
@@ -71,11 +79,13 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
We do the same example with auto-scaling, weighted scoring and SA to
have a reference!
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 500,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 1)),
@@ -86,7 +96,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 8.080860 7.458345
@@ -95,25 +105,25 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
We do the same example with auto-scaling and position-dependent
scoring now, not aggregating the score vector! This is more effective
even when using the default acceptance function. We are strictly
prioritizing the leftmost score in addition to reflect relevance for the
design.
-bc <- example4$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+example4$score(scoring_f)
#> Group.Plate Sex.Plate
#> 83.63858 239.20748
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = accept_leftmost_improvement,
@@ -121,7 +131,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.619846 7.473524
@@ -130,20 +140,19 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
Using a tolerance value to accept slightly worse solutions in the
leftmost relevant score if overcompensated by other scores:
-bc <- example4$copy()
-
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = ~ accept_leftmost_improvement(..., tolerance = 0.1),
@@ -152,37 +161,33 @@ Example 4: More than one group factor to balance and empty plate
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.366667 7.323324
-bc$score()
-#> Group.Plate Sex.Plate
-#> 7.366667 7.323324
-
-cowplot::plot_grid(
+cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
Testing an alternative left-to-right weighing of scores, based on
exponential down-weighing of the respective score differences at
position \(p\) with factor \(\kappa^p\), \(0
< \kappa < 1\) We choose a \(\kappa\) of 0.5, i.e. the second score’s
improvement counts half of that of the first one.
-bc <- example4$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
-#> 83.63858 239.20748
+#> 7.366667 7.323324
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 1000,
n_shuffle = 1,
acceptance_func = mk_exponentially_weighted_acceptance_func(kappa = 0.5, simulated_annealing = T),
@@ -190,7 +195,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.630367 7.616179
@@ -199,5 +204,5 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex5.html b/vignettes/cached/_plate_scoring_ex5.html
index 35874c9f..368fc058 100644
--- a/vignettes/cached/_plate_scoring_ex5.html
+++ b/vignettes/cached/_plate_scoring_ex5.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 5: Avoiding ‘regular patterns’ in plate layout
@@ -21,36 +29,36 @@ Example 5: Avoiding ‘regular patterns’ in plate layout
)
# Assign samples randomly to start from lower score (avoid `Inf` values when doing the 'hard' penalization)
-assign_random(example5, samples = tibble::tibble(
+example5 <- assign_random(example5, samples = tibble::tibble(
Group = rep.int(paste("Group", 1:5), times = c(8, 8, 8, 8, 64)),
ID = 1:96
))
penalize_lines <- "hard"
-bc <- example5$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group", p = 2, penalize_lines = penalize_lines)
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example5, row = "row", column = "col", group = "Group", p = 2, penalize_lines = penalize_lines)
)
-bc$score()
+example5$score(scoring_f)
#> Group.Plate
-#> 9.960584
+#> 11.08608
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example5,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 500, alpha = 0.1)),
quiet = T
)
-trace$elapsed
-#> Time difference of 28.7293 secs
+bc$trace$elapsed
+#> Time difference of 29.47413 secs
-bc$score()
+bc$score(scoring_f)
#> Group.Plate
-#> 8.819968
+#> 8.785693
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = stringr::str_c("Line penalization: ", penalize_lines))
-
+
From 43a1a58be0ea5f70df183d55217fce039e85afb7 Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:17:07 +0200
Subject: [PATCH 27/32] silence "Namespace in Imports field not imported from"
---
R/batch_container.R | 1 +
1 file changed, 1 insertion(+)
diff --git a/R/batch_container.R b/R/batch_container.R
index d35eb762..97b23678 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -123,6 +123,7 @@ locations_table_from_dimensions <- function(dimensions, exclude) {
#' samples can be assigned to locations in that container.
#'
#' @export
+#' @import R6
BatchContainer <- R6::R6Class("BatchContainer",
public = list(
#' @description
From 18e190035cffd678232b88ddc6911180aea4ff8c Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:17:29 +0200
Subject: [PATCH 28/32] _doc
---
man/complete_random_shuffling.Rd | 6 +++---
man/mk_plate_scoring_functions.Rd | 6 +++---
man/mk_subgroup_shuffling_function.Rd | 17 +++++++++++------
man/mk_swapping_function.Rd | 4 ++--
man/plot_plate.Rd | 2 +-
man/shuffle_with_constraints.Rd | 5 +++--
6 files changed, 23 insertions(+), 17 deletions(-)
diff --git a/man/complete_random_shuffling.Rd b/man/complete_random_shuffling.Rd
index 75611c6c..e8b849f2 100644
--- a/man/complete_random_shuffling.Rd
+++ b/man/complete_random_shuffling.Rd
@@ -23,9 +23,9 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("plate" = 2, "column" = 5, "row" = 6)
)
-bc$scoring_f <- osat_score_generator("plate", "Sex")
-optimize_design(
- bc, invivo_study_samples,
+scoring_f <- osat_score_generator("plate", "Sex")
+bc <- optimize_design(
+ bc, scoring = scoring_f, invivo_study_samples,
max_iter = 100,
shuffle_proposal_func = complete_random_shuffling
)
diff --git a/man/mk_plate_scoring_functions.Rd b/man/mk_plate_scoring_functions.Rd
index 560b9a41..722ac793 100644
--- a/man/mk_plate_scoring_functions.Rd
+++ b/man/mk_plate_scoring_functions.Rd
@@ -42,12 +42,12 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("column" = 6, "row" = 10)
)
-assign_random(bc, invivo_study_samples)
-bc$scoring_f <- mk_plate_scoring_functions(
+bc <- assign_random(bc, invivo_study_samples)
+scoring_f <- mk_plate_scoring_functions(
bc,
row = "row", column = "column", group = "Sex"
)
-optimize_design(bc, max_iter = 100)
+bc <- optimize_design(bc, scoring = scoring_f, max_iter = 100)
plot_plate(bc$get_samples(), .col = Sex)
}
diff --git a/man/mk_subgroup_shuffling_function.Rd b/man/mk_subgroup_shuffling_function.Rd
index dd0728e0..dd265dd4 100644
--- a/man/mk_subgroup_shuffling_function.Rd
+++ b/man/mk_subgroup_shuffling_function.Rd
@@ -34,7 +34,7 @@ bc <- BatchContainer$new(
)
)
-assign_in_order(bc, samples = tibble::tibble(
+bc <- assign_in_order(bc, samples = tibble::tibble(
Group = c(rep(c("Grp 1", "Grp 2", "Grp 3", "Grp 4"), each = 8)),
ID = 1:32
))
@@ -49,24 +49,29 @@ plot_plate(bc,
)
# Step 1, assign samples to plates
-bc$scoring_f <- osat_score_generator(
+scoring_f <- osat_score_generator(
batch_vars = c("plate"), feature_vars = c("Group")
)
-optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 10, # the real number of iterations should be bigger
n_shuffle = 2,
quiet = TRUE
)
-plot_plate(bc,
+plot_plate(
+ bc,
plate = plate, row = row, column = col, .color = Group
)
# Step 2, distribute samples within plates
-bc$scoring_f <- mk_plate_scoring_functions(
+scoring_f <- mk_plate_scoring_functions(
bc,
plate = "plate", row = "row", column = "col", group = "Group"
)
-optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 50,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate")),
aggregate_scores_func = L2s_norm,
diff --git a/man/mk_swapping_function.Rd b/man/mk_swapping_function.Rd
index 1fdde7c5..65bffa4e 100644
--- a/man/mk_swapping_function.Rd
+++ b/man/mk_swapping_function.Rd
@@ -22,9 +22,9 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("plate" = 2, "column" = 5, "row" = 6)
)
-bc$scoring_f <- osat_score_generator("plate", "Sex")
+scoring_f <- osat_score_generator("plate", "Sex")
optimize_design(
- bc, invivo_study_samples,
+ bc, scoring = scoring_f, invivo_study_samples,
max_iter = 100,
shuffle_proposal_func = mk_swapping_function(1)
)
diff --git a/man/plot_plate.Rd b/man/plot_plate.Rd
index 276f48ed..24a53ce5 100644
--- a/man/plot_plate.Rd
+++ b/man/plot_plate.Rd
@@ -70,7 +70,7 @@ sample_sheet <- tibble::tibble(
)
# assign samples from the sample sheet
-assign_random(bc, samples = sample_sheet)
+bc <- assign_random(bc, samples = sample_sheet)
plot_plate(bc$get_samples(),
plate = plate, column = column, row = row,
diff --git a/man/shuffle_with_constraints.Rd b/man/shuffle_with_constraints.Rd
index 23880a09..48134daf 100644
--- a/man/shuffle_with_constraints.Rd
+++ b/man/shuffle_with_constraints.Rd
@@ -40,7 +40,7 @@ bc <- BatchContainer$new(
dimensions = c("plate" = 5, "position" = 25)
)
-bc$scoring_f <- function(samples) {
+scoring_f <- function(samples) {
osat_score(
samples,
"plate",
@@ -51,8 +51,9 @@ bc$scoring_f <- function(samples) {
# in this example we treat all the positions in the plate as equal.
# when shuffling we enforce that source location is non-empty,
# and destination location has a different plate number
-optimize_design(
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
samples,
shuffle_proposal = shuffle_with_constraints(
# source is non-empty location
From 0fc707f96f1b3216a2a8580ae5dfba578bcc4825 Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:41:03 +0200
Subject: [PATCH 29/32] remove import R6, this doesn't seem to fix the r check
note
---
R/batch_container.R | 1 -
1 file changed, 1 deletion(-)
diff --git a/R/batch_container.R b/R/batch_container.R
index 97b23678..d35eb762 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -123,7 +123,6 @@ locations_table_from_dimensions <- function(dimensions, exclude) {
#' samples can be assigned to locations in that container.
#'
#' @export
-#' @import R6
BatchContainer <- R6::R6Class("BatchContainer",
public = list(
#' @description
From 40dd496ca397948aeab1b3e6ca2ef3224b2280ef Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Mon, 7 Aug 2023 17:21:59 +0200
Subject: [PATCH 30/32] error when passing a partially named list of scoring
functions
---
R/batch_container.R | 4 +++
tests/testthat/test-scoring-names.R | 46 +++++++++++++++++++++++++++++
2 files changed, 50 insertions(+)
create mode 100644 tests/testthat/test-scoring-names.R
diff --git a/R/batch_container.R b/R/batch_container.R
index d35eb762..f2983c03 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -349,6 +349,10 @@ BatchContainer <- R6::R6Class("BatchContainer",
if (is.null(names(scoring))) {
names(scoring) <- stringr::str_c("score_", seq_along(scoring))
}
+ assertthat::assert_that(
+ !any(names(scoring) == ""),
+ msg = "scoring cannot be a partially named list"
+ )
assertthat::assert_that(is.list(scoring),
length(scoring) >= 1,
msg = "Scoring function should be a non-empty list"
diff --git a/tests/testthat/test-scoring-names.R b/tests/testthat/test-scoring-names.R
new file mode 100644
index 00000000..b4f4931e
--- /dev/null
+++ b/tests/testthat/test-scoring-names.R
@@ -0,0 +1,46 @@
+samples <- data.frame(i = 1:384, x = rnorm(384))
+
+bc <- BatchContainer$new(
+ dimensions = c(row = 16, column = 24)
+) |>
+ assign_in_order(samples)
+
+
+test_that("scoring functions can be an unnamed list", {
+ tmp <- optimize_design(bc,
+ scoring = list(
+ \(...) rnorm(1),
+ \(...) rnorm(1)
+ ),
+ max_iter = 10
+ )
+ expect_equal(
+ colnames(tmp$trace$scores[[1]]),
+ c("step", "score_1", "score_2")
+ )
+})
+
+test_that("all scoring functions should be named (or unnamed)", {
+ expect_error(
+ optimize_design(bc,
+ scoring = list(
+ \(...) rnorm(1),
+ f = \(...) rnorm(1)
+ ),
+ max_iter = 10
+ ),
+ "scoring cannot be a partially named list"
+ )
+})
+
+test_that("scoring function cannot have a name 'step'", {
+ expect_error(
+ optimize_design(bc,
+ scoring = list(
+ step = \(...) rnorm(1)
+ ),
+ max_iter = 10
+ ),
+ "score name cannot be 'step'"
+ )
+})
From 88810597cfd7e9f4c07fd82a6cd66f9be78e168c Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Wed, 23 Aug 2023 11:19:30 +0200
Subject: [PATCH 31/32] Update R/optimize.R
Co-authored-by: Balazs Banfai <5557093+banfai@users.noreply.github.com>
---
R/optimize.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/optimize.R b/R/optimize.R
index 48f2b650..2ae7b8eb 100644
--- a/R/optimize.R
+++ b/R/optimize.R
@@ -125,7 +125,7 @@ update_batchcontainer <- function(bc, shuffle_params) {
#' Should be `NULL` if the `BatchContainer` already has samples in it.
#' @param scoring Scoring function or a named [list()] of scoring functions.
#' @param n_shuffle Vector of length 1 or larger, defining how many random sample
-#' swaps should be performed in each iteration. If length(n_shuffle)==1,
+#' swaps should be performed in each iteration. If `length(n_shuffle)==1`,
#' this sets no limit to the number of iterations. Otherwise, the optimization
#' stops if the swapping protocol is exhausted.
#' @param shuffle_proposal_func A user defined function to propose the next shuffling of samples.
From d5cc0520dbdc19c52d67e020668dd30bebafacf4 Mon Sep 17 00:00:00 2001
From: Balazs Banfai <5557093+banfai@users.noreply.github.com>
Date: Wed, 23 Aug 2023 11:58:05 +0200
Subject: [PATCH 32/32] Update man/optimize_design.Rd
---
man/optimize_design.Rd | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/man/optimize_design.Rd b/man/optimize_design.Rd
index b9bf91f2..5ce33e36 100644
--- a/man/optimize_design.Rd
+++ b/man/optimize_design.Rd
@@ -31,7 +31,7 @@ Should be \code{NULL} if the \code{BatchContainer} already has samples in it.}
\item{scoring}{Scoring function or a named \code{\link[=list]{list()}} of scoring functions.}
\item{n_shuffle}{Vector of length 1 or larger, defining how many random sample
-swaps should be performed in each iteration. If length(n_shuffle)==1,
+swaps should be performed in each iteration. If \code{length(n_shuffle)==1},
this sets no limit to the number of iterations. Otherwise, the optimization
stops if the swapping protocol is exhausted.}
-set.seed(41)
+set.seed(41)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example1,
+ scoring = scoring_f,
max_iter = 300, # this is set to shorten vignette run-time based on known random seed, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
@@ -121,35 +120,33 @@ Example 1: An expensive way to construct a 4x4 latin square (one
#> Aggregated: 16
#> Achieved score: c(0, 0) at iteration 284
#> Aggregated: 0
-trace
-#> Optimization trace (301 score values, elapsed 21.10947 secs).
-#> Starting score: 48,0
-#> Final score : 0,0
+bc$trace$elapsed
+#> Time difference of 5.483629 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex1: Using OSAT scores for plate design\n(not the recommended way!)"
)
-
+
Now using a dedicated scoring for the group distances on a plate.
This should reliably lead to a nice symmetry-bearing latin square
design with only a one-dimensional score to look at.
-bc <- example1$copy()
-
-bc$scoring_f <- mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group")
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example1,
+ scoring = scoring_f,
max_iter = 1000, # this is set to shorten vignette run-time based on random seed, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 11.43023 secs
+bc$trace$elapsed
+#> Time difference of 6.182886 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex1: Using a dedicated plate scoring function:\nThis should show a latin square!"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex2.html b/vignettes/cached/_plate_scoring_ex2.html
index a5299f2d..efcb9fbf 100644
--- a/vignettes/cached/_plate_scoring_ex2.html
+++ b/vignettes/cached/_plate_scoring_ex2.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 2: Scoring two plates at once
@@ -26,37 +34,37 @@ Example 2: Scoring two plates at once
)
# Add samples to container
-assign_in_order(example2, samples = tibble::tibble(
+example2 <- assign_in_order(example2, samples = tibble::tibble(
Group = c(rep(c("Grp 1", "Grp 2", "Grp 3", "Grp 4"), each = 8)),
ID = 1:32
))
-bc <- example2$copy()
-
-bc$scoring_f <- c(mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group"),
+scoring_f <- c(mk_plate_scoring_functions(example2, plate = "plate", row = "row", column = "col", group = "Group"),
osat_plate = osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
)
-plot_plate(bc,
+plot_plate(example2,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: Initial sample arrangement"
)
-
+
-bc$score()
+example2$score(scoring_f)
#> Plate 1 Plate 2 osat_plate
#> 23.89265 23.89265 128.00000
set.seed(41)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
n_shuffle = c(rep(10, 10), rep(3, 90), rep(2, 100), rep(1, 1400)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
aggregate_scores_func = worst_score,
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 25.73155 secs
+bc$trace$elapsed
+#> Time difference of 16.73602 secs
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 osat_plate
#> 6.127258 6.094080 0.000000
@@ -64,7 +72,7 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: Design created by swapping samples 'globally' across the plates"
)
-
+
While this ‘global’ optimization is possible, it does probably not
converge to an (almost) ideal solution in an acceptable time if there
are more samples involved. This is due to a lot of unproductive sample
@@ -75,48 +83,46 @@
Example 2: Scoring two plates at once
the use of a dedicated sample permutation function which takes the plate
structure into account and only shuffles samples around within one
plate.
-# Setting up the batch container
-
-bc <- example2$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 200, # this is set to shorten vignette run-time, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
)
-#> Optimization trace (201 score values, elapsed 4.254329 secs).
-#> Starting score: 128
-#> Final score : 0
+bc$trace$elapsed
+#> Time difference of 2.140794 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Plate wise' design\nStep 1: after allocating samples to plates"
)
-
+
-bc$scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 12.77527 13.63704
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 400,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate")),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm,
quiet = TRUE
)
-trace
-#> Optimization trace (401 score values, elapsed 3.579697 secs).
-#> Starting score: 12.775,13.637
-#> Final score : 6.855,6.309
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 2.140794 3.270934
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.854748 6.309297
@@ -124,7 +130,7 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Plate wise' design\nStep 2: after arranging samples within plates"
)
-
+
In this case, the shuffling function exchanges 1 pair of sample
assignments every time (the default). However, any number of constant
swaps or a swapping protocol (formally a vector of integers) can be
@@ -137,64 +143,62 @@
Example 2: Scoring two plates at once
generates the permutations. It enforces permutation only to happen first
within plate 1, then within plate 2, so that the two scores can be
optimized in succeeding runs.
-# Setting up the batch container
-
-bc <- example2$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example2,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 150, # this is set to shorten vignette run-time, normally we don't know.
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5)),
)
-trace
-#> Optimization trace (151 score values, elapsed 4.056035 secs).
-#> Starting score: 128
-#> Final score : 0
+bc$trace$elapsed
+#> Time difference of 1.791624 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Serial plate' design\nStep 1: after allocating samples to plates"
)
-
+
-bc$scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
+scoring_f <- mk_plate_scoring_functions(bc, plate = "plate", row = "row", column = "col", group = "Group")
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 10.57482 26.16613
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 150,
quiet = TRUE,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate"), restrain_on_subgroup_levels = c(1)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm
)
-trace
-#> Optimization trace (151 score values, elapsed 2.528134 secs).
-#> Starting score: 10.575,26.166
-#> Final score : 6.416,26.166
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 1.791624 1.591002
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.416193 26.166134
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 550,
quiet = TRUE,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate"), restrain_on_subgroup_levels = c(2)),
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
aggregate_scores_func = L2s_norm
)
-trace
-#> Optimization trace (551 score values, elapsed 2.93787 secs).
-#> Starting score: 6.416,26.166
-#> Final score : 6.416,6.582
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 1.791624 1.591002 4.226352
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2
#> 6.416193 6.581966
@@ -202,5 +206,5 @@ Example 2: Scoring two plates at once
plate = plate, row = row, column = col, .color = Group,
title = "Ex2: 'Serial plate' design\nStep 2: after optimizing each plate in turn"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex3.html b/vignettes/cached/_plate_scoring_ex3.html
index 35a11141..40ed3f06 100644
--- a/vignettes/cached/_plate_scoring_ex3.html
+++ b/vignettes/cached/_plate_scoring_ex3.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 3: 3 plates with different dimension and different sample
@@ -39,7 +47,7 @@ Example 3: 3 plates with different dimension and different sample
# Assign samples randomly to start from a better initial state
-assign_random(example3,
+example3 <- assign_random(example3,
samples = tibble::tibble(
Group = rep.int(c("Grp 1", "Grp 2", "Grp3"),
times = c(69, 30, 69)
@@ -48,35 +56,35 @@ Example 3: 3 plates with different dimension and different sample
)
)
-bc <- example3$copy()
-
-bc$scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
+scoring_f <- osat_score_generator(batch_vars = c("plate"), feature_vars = c("Group"))
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example3,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 150,
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 1000, alpha = 0.5)),
)
-trace
-#> Optimization trace (151 score values, elapsed 3.348524 secs).
-#> Starting score: 17.714
-#> Final score : 1.429
+bc$trace$elapsed
+#> Time difference of 2.03003 secs
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex3: Dealing with plates of different size\nStep 1: after distributing groups across plates"
)
-
-bc$scoring_f <- mk_plate_scoring_functions(bc,
+
+scoring_f <- mk_plate_scoring_functions(bc,
plate = "plate", row = "row",
column = "col", group = "Group"
)
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 Plate 3
-#> 9.706637 9.585770 10.419567
+#> 9.387071 10.302690 9.826243
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 300,
shuffle_proposal_func = mk_subgroup_shuffling_function(
subgroup_vars = c("plate"),
@@ -86,15 +94,16 @@ Example 3: 3 plates with different dimension and different sample
aggregate_scores_func = L2s_norm,
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 40.35472 secs
+bc$trace$elapsed
+#> Time differences in secs
+#> [1] 2.030030 4.778121
-bc$score()
+bc$score(scoring_f)
#> Plate 1 Plate 2 Plate 3
-#> 8.974408 8.253074 7.980756
+#> 8.809205 8.553802 8.185525
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
title = "Ex3: Dealing with plates of different size\nStep 2: after swapping samples within plates"
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex4.html b/vignettes/cached/_plate_scoring_ex4.html
index 61806644..d3c1472d 100644
--- a/vignettes/cached/_plate_scoring_ex4.html
+++ b/vignettes/cached/_plate_scoring_ex4.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 4: More than one group factor to balance and empty plate
@@ -26,31 +34,31 @@ Example 4: More than one group factor to balance and empty plate
# Assign samples randomly to start from lower score (avoid Inf values even since plate 3 will miss 2 groups initially :)
-assign_in_order(example4, samples = tibble::tibble(
+example4 <- assign_in_order(example4, samples = tibble::tibble(
Group = rep.int(c("Treatment 1", "Treatment 2"), times = c(10, 10)),
Sex = c(rep(c("M", "F", "F", "M"), times = 4), "M", NA, NA, "F"), ID = 1:20
))
-bc <- example4$copy()
-
cowplot::plot_grid(
- plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Initial layout by Group"),
- plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Initial layout by Sex"),
+ plot_plate(example4, plate = plate, row = row, column = col, .color = Group, title = "Initial layout by Group"),
+ plot_plate(example4, plate = plate, row = row, column = col, .color = Sex, title = "Initial layout by Sex"),
ncol = 2
)
-
+
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+example4$score(scoring_f)
#> Group.Plate Sex.Plate
#> 83.63858 239.20748
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 750,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 1)),
@@ -59,10 +67,10 @@ Example 4: More than one group factor to balance and empty plate
},
quiet = TRUE
)
-trace$elapsed
-#> Time difference of 7.062086 secs
+bc$trace$elapsed
+#> Time difference of 6.251454 secs
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 8.019656 7.608810
@@ -71,11 +79,13 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
We do the same example with auto-scaling, weighted scoring and SA to
have a reference!
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 500,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 1)),
@@ -86,7 +96,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 8.080860 7.458345
@@ -95,25 +105,25 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
We do the same example with auto-scaling and position-dependent
scoring now, not aggregating the score vector! This is more effective
even when using the default acceptance function. We are strictly
prioritizing the leftmost score in addition to reflect relevance for the
design.
-bc <- example4$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+example4$score(scoring_f)
#> Group.Plate Sex.Plate
#> 83.63858 239.20748
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = accept_leftmost_improvement,
@@ -121,7 +131,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.619846 7.473524
@@ -130,20 +140,19 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
Using a tolerance value to accept slightly worse solutions in the
leftmost relevant score if overcompensated by other scores:
-bc <- example4$copy()
-
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = ~ accept_leftmost_improvement(..., tolerance = 0.1),
@@ -152,37 +161,33 @@ Example 4: More than one group factor to balance and empty plate
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.366667 7.323324
-bc$score()
-#> Group.Plate Sex.Plate
-#> 7.366667 7.323324
-
-cowplot::plot_grid(
+cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
Testing an alternative left-to-right weighing of scores, based on
exponential down-weighing of the respective score differences at
position \(p\) with factor \(\kappa^p\), \(0
< \kappa < 1\) We choose a \(\kappa\) of 0.5, i.e. the second score’s
improvement counts half of that of the first one.
-bc <- example4$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group"),
- Sex = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Sex")
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Group"),
+ Sex = mk_plate_scoring_functions(example4, row = "row", column = "col", group = "Sex")
)
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
-#> 83.63858 239.20748
+#> 7.366667 7.323324
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example4,
+ scoring = scoring_f,
max_iter = 1000,
n_shuffle = 1,
acceptance_func = mk_exponentially_weighted_acceptance_func(kappa = 0.5, simulated_annealing = T),
@@ -190,7 +195,7 @@ Example 4: More than one group factor to balance and empty plate
quiet = TRUE
)
#> ... Performing simple mean/stddev adjustment.
-bc$score()
+bc$score(scoring_f)
#> Group.Plate Sex.Plate
#> 7.630367 7.616179
@@ -199,5 +204,5 @@ Example 4: More than one group factor to balance and empty plate
plot_plate(bc, plate = plate, row = row, column = col, .color = Sex, title = "Final layout by Sex"),
ncol = 2
)
-
+
diff --git a/vignettes/cached/_plate_scoring_ex5.html b/vignettes/cached/_plate_scoring_ex5.html
index 35874c9f..368fc058 100644
--- a/vignettes/cached/_plate_scoring_ex5.html
+++ b/vignettes/cached/_plate_scoring_ex5.html
@@ -4,6 +4,14 @@
library(designit)
library(ggplot2)
library(dplyr)
+#>
+#> Attaching package: 'dplyr'
+#> The following objects are masked from 'package:stats':
+#>
+#> filter, lag
+#> The following objects are masked from 'package:base':
+#>
+#> intersect, setdiff, setequal, union
library(tidyr)
Example 5: Avoiding ‘regular patterns’ in plate layout
@@ -21,36 +29,36 @@ Example 5: Avoiding ‘regular patterns’ in plate layout
)
# Assign samples randomly to start from lower score (avoid `Inf` values when doing the 'hard' penalization)
-assign_random(example5, samples = tibble::tibble(
+example5 <- assign_random(example5, samples = tibble::tibble(
Group = rep.int(paste("Group", 1:5), times = c(8, 8, 8, 8, 64)),
ID = 1:96
))
penalize_lines <- "hard"
-bc <- example5$copy()
-
-bc$scoring_f <- c(
- Group = mk_plate_scoring_functions(bc, row = "row", column = "col", group = "Group", p = 2, penalize_lines = penalize_lines)
+scoring_f <- c(
+ Group = mk_plate_scoring_functions(example5, row = "row", column = "col", group = "Group", p = 2, penalize_lines = penalize_lines)
)
-bc$score()
+example5$score(scoring_f)
#> Group.Plate
-#> 9.960584
+#> 11.08608
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example5,
+ scoring = scoring_f,
max_iter = 5000,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 500, alpha = 0.1)),
quiet = T
)
-trace$elapsed
-#> Time difference of 28.7293 secs
+bc$trace$elapsed
+#> Time difference of 29.47413 secs
-bc$score()
+bc$score(scoring_f)
#> Group.Plate
-#> 8.819968
+#> 8.785693
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = stringr::str_c("Line penalization: ", penalize_lines))
-
+
From 43a1a58be0ea5f70df183d55217fce039e85afb7 Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:17:07 +0200
Subject: [PATCH 27/32] silence "Namespace in Imports field not imported from"
---
R/batch_container.R | 1 +
1 file changed, 1 insertion(+)
diff --git a/R/batch_container.R b/R/batch_container.R
index d35eb762..97b23678 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -123,6 +123,7 @@ locations_table_from_dimensions <- function(dimensions, exclude) {
#' samples can be assigned to locations in that container.
#'
#' @export
+#' @import R6
BatchContainer <- R6::R6Class("BatchContainer",
public = list(
#' @description
From 18e190035cffd678232b88ddc6911180aea4ff8c Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:17:29 +0200
Subject: [PATCH 28/32] _doc
---
man/complete_random_shuffling.Rd | 6 +++---
man/mk_plate_scoring_functions.Rd | 6 +++---
man/mk_subgroup_shuffling_function.Rd | 17 +++++++++++------
man/mk_swapping_function.Rd | 4 ++--
man/plot_plate.Rd | 2 +-
man/shuffle_with_constraints.Rd | 5 +++--
6 files changed, 23 insertions(+), 17 deletions(-)
diff --git a/man/complete_random_shuffling.Rd b/man/complete_random_shuffling.Rd
index 75611c6c..e8b849f2 100644
--- a/man/complete_random_shuffling.Rd
+++ b/man/complete_random_shuffling.Rd
@@ -23,9 +23,9 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("plate" = 2, "column" = 5, "row" = 6)
)
-bc$scoring_f <- osat_score_generator("plate", "Sex")
-optimize_design(
- bc, invivo_study_samples,
+scoring_f <- osat_score_generator("plate", "Sex")
+bc <- optimize_design(
+ bc, scoring = scoring_f, invivo_study_samples,
max_iter = 100,
shuffle_proposal_func = complete_random_shuffling
)
diff --git a/man/mk_plate_scoring_functions.Rd b/man/mk_plate_scoring_functions.Rd
index 560b9a41..722ac793 100644
--- a/man/mk_plate_scoring_functions.Rd
+++ b/man/mk_plate_scoring_functions.Rd
@@ -42,12 +42,12 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("column" = 6, "row" = 10)
)
-assign_random(bc, invivo_study_samples)
-bc$scoring_f <- mk_plate_scoring_functions(
+bc <- assign_random(bc, invivo_study_samples)
+scoring_f <- mk_plate_scoring_functions(
bc,
row = "row", column = "column", group = "Sex"
)
-optimize_design(bc, max_iter = 100)
+bc <- optimize_design(bc, scoring = scoring_f, max_iter = 100)
plot_plate(bc$get_samples(), .col = Sex)
}
diff --git a/man/mk_subgroup_shuffling_function.Rd b/man/mk_subgroup_shuffling_function.Rd
index dd0728e0..dd265dd4 100644
--- a/man/mk_subgroup_shuffling_function.Rd
+++ b/man/mk_subgroup_shuffling_function.Rd
@@ -34,7 +34,7 @@ bc <- BatchContainer$new(
)
)
-assign_in_order(bc, samples = tibble::tibble(
+bc <- assign_in_order(bc, samples = tibble::tibble(
Group = c(rep(c("Grp 1", "Grp 2", "Grp 3", "Grp 4"), each = 8)),
ID = 1:32
))
@@ -49,24 +49,29 @@ plot_plate(bc,
)
# Step 1, assign samples to plates
-bc$scoring_f <- osat_score_generator(
+scoring_f <- osat_score_generator(
batch_vars = c("plate"), feature_vars = c("Group")
)
-optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 10, # the real number of iterations should be bigger
n_shuffle = 2,
quiet = TRUE
)
-plot_plate(bc,
+plot_plate(
+ bc,
plate = plate, row = row, column = col, .color = Group
)
# Step 2, distribute samples within plates
-bc$scoring_f <- mk_plate_scoring_functions(
+scoring_f <- mk_plate_scoring_functions(
bc,
plate = "plate", row = "row", column = "col", group = "Group"
)
-optimize_design(bc,
+bc <- optimize_design(
+ bc,
+ scoring = scoring_f,
max_iter = 50,
shuffle_proposal_func = mk_subgroup_shuffling_function(subgroup_vars = c("plate")),
aggregate_scores_func = L2s_norm,
diff --git a/man/mk_swapping_function.Rd b/man/mk_swapping_function.Rd
index 1fdde7c5..65bffa4e 100644
--- a/man/mk_swapping_function.Rd
+++ b/man/mk_swapping_function.Rd
@@ -22,9 +22,9 @@ data("invivo_study_samples")
bc <- BatchContainer$new(
dimensions = c("plate" = 2, "column" = 5, "row" = 6)
)
-bc$scoring_f <- osat_score_generator("plate", "Sex")
+scoring_f <- osat_score_generator("plate", "Sex")
optimize_design(
- bc, invivo_study_samples,
+ bc, scoring = scoring_f, invivo_study_samples,
max_iter = 100,
shuffle_proposal_func = mk_swapping_function(1)
)
diff --git a/man/plot_plate.Rd b/man/plot_plate.Rd
index 276f48ed..24a53ce5 100644
--- a/man/plot_plate.Rd
+++ b/man/plot_plate.Rd
@@ -70,7 +70,7 @@ sample_sheet <- tibble::tibble(
)
# assign samples from the sample sheet
-assign_random(bc, samples = sample_sheet)
+bc <- assign_random(bc, samples = sample_sheet)
plot_plate(bc$get_samples(),
plate = plate, column = column, row = row,
diff --git a/man/shuffle_with_constraints.Rd b/man/shuffle_with_constraints.Rd
index 23880a09..48134daf 100644
--- a/man/shuffle_with_constraints.Rd
+++ b/man/shuffle_with_constraints.Rd
@@ -40,7 +40,7 @@ bc <- BatchContainer$new(
dimensions = c("plate" = 5, "position" = 25)
)
-bc$scoring_f <- function(samples) {
+scoring_f <- function(samples) {
osat_score(
samples,
"plate",
@@ -51,8 +51,9 @@ bc$scoring_f <- function(samples) {
# in this example we treat all the positions in the plate as equal.
# when shuffling we enforce that source location is non-empty,
# and destination location has a different plate number
-optimize_design(
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
samples,
shuffle_proposal = shuffle_with_constraints(
# source is non-empty location
From 0fc707f96f1b3216a2a8580ae5dfba578bcc4825 Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Thu, 27 Jul 2023 11:41:03 +0200
Subject: [PATCH 29/32] remove import R6, this doesn't seem to fix the r check
note
---
R/batch_container.R | 1 -
1 file changed, 1 deletion(-)
diff --git a/R/batch_container.R b/R/batch_container.R
index 97b23678..d35eb762 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -123,7 +123,6 @@ locations_table_from_dimensions <- function(dimensions, exclude) {
#' samples can be assigned to locations in that container.
#'
#' @export
-#' @import R6
BatchContainer <- R6::R6Class("BatchContainer",
public = list(
#' @description
From 40dd496ca397948aeab1b3e6ca2ef3224b2280ef Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Mon, 7 Aug 2023 17:21:59 +0200
Subject: [PATCH 30/32] error when passing a partially named list of scoring
functions
---
R/batch_container.R | 4 +++
tests/testthat/test-scoring-names.R | 46 +++++++++++++++++++++++++++++
2 files changed, 50 insertions(+)
create mode 100644 tests/testthat/test-scoring-names.R
diff --git a/R/batch_container.R b/R/batch_container.R
index d35eb762..f2983c03 100644
--- a/R/batch_container.R
+++ b/R/batch_container.R
@@ -349,6 +349,10 @@ BatchContainer <- R6::R6Class("BatchContainer",
if (is.null(names(scoring))) {
names(scoring) <- stringr::str_c("score_", seq_along(scoring))
}
+ assertthat::assert_that(
+ !any(names(scoring) == ""),
+ msg = "scoring cannot be a partially named list"
+ )
assertthat::assert_that(is.list(scoring),
length(scoring) >= 1,
msg = "Scoring function should be a non-empty list"
diff --git a/tests/testthat/test-scoring-names.R b/tests/testthat/test-scoring-names.R
new file mode 100644
index 00000000..b4f4931e
--- /dev/null
+++ b/tests/testthat/test-scoring-names.R
@@ -0,0 +1,46 @@
+samples <- data.frame(i = 1:384, x = rnorm(384))
+
+bc <- BatchContainer$new(
+ dimensions = c(row = 16, column = 24)
+) |>
+ assign_in_order(samples)
+
+
+test_that("scoring functions can be an unnamed list", {
+ tmp <- optimize_design(bc,
+ scoring = list(
+ \(...) rnorm(1),
+ \(...) rnorm(1)
+ ),
+ max_iter = 10
+ )
+ expect_equal(
+ colnames(tmp$trace$scores[[1]]),
+ c("step", "score_1", "score_2")
+ )
+})
+
+test_that("all scoring functions should be named (or unnamed)", {
+ expect_error(
+ optimize_design(bc,
+ scoring = list(
+ \(...) rnorm(1),
+ f = \(...) rnorm(1)
+ ),
+ max_iter = 10
+ ),
+ "scoring cannot be a partially named list"
+ )
+})
+
+test_that("scoring function cannot have a name 'step'", {
+ expect_error(
+ optimize_design(bc,
+ scoring = list(
+ step = \(...) rnorm(1)
+ ),
+ max_iter = 10
+ ),
+ "score name cannot be 'step'"
+ )
+})
From 88810597cfd7e9f4c07fd82a6cd66f9be78e168c Mon Sep 17 00:00:00 2001
From: Iakov Davydov <671660+idavydov@users.noreply.github.com>
Date: Wed, 23 Aug 2023 11:19:30 +0200
Subject: [PATCH 31/32] Update R/optimize.R
Co-authored-by: Balazs Banfai <5557093+banfai@users.noreply.github.com>
---
R/optimize.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/optimize.R b/R/optimize.R
index 48f2b650..2ae7b8eb 100644
--- a/R/optimize.R
+++ b/R/optimize.R
@@ -125,7 +125,7 @@ update_batchcontainer <- function(bc, shuffle_params) {
#' Should be `NULL` if the `BatchContainer` already has samples in it.
#' @param scoring Scoring function or a named [list()] of scoring functions.
#' @param n_shuffle Vector of length 1 or larger, defining how many random sample
-#' swaps should be performed in each iteration. If length(n_shuffle)==1,
+#' swaps should be performed in each iteration. If `length(n_shuffle)==1`,
#' this sets no limit to the number of iterations. Otherwise, the optimization
#' stops if the swapping protocol is exhausted.
#' @param shuffle_proposal_func A user defined function to propose the next shuffling of samples.
From d5cc0520dbdc19c52d67e020668dd30bebafacf4 Mon Sep 17 00:00:00 2001
From: Balazs Banfai <5557093+banfai@users.noreply.github.com>
Date: Wed, 23 Aug 2023 11:58:05 +0200
Subject: [PATCH 32/32] Update man/optimize_design.Rd
---
man/optimize_design.Rd | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/man/optimize_design.Rd b/man/optimize_design.Rd
index b9bf91f2..5ce33e36 100644
--- a/man/optimize_design.Rd
+++ b/man/optimize_design.Rd
@@ -31,7 +31,7 @@ Should be \code{NULL} if the \code{BatchContainer} already has samples in it.}
\item{scoring}{Scoring function or a named \code{\link[=list]{list()}} of scoring functions.}
\item{n_shuffle}{Vector of length 1 or larger, defining how many random sample
-swaps should be performed in each iteration. If length(n_shuffle)==1,
+swaps should be performed in each iteration. If \code{length(n_shuffle)==1},
this sets no limit to the number of iterations. Otherwise, the optimization
stops if the swapping protocol is exhausted.}