Visualization 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.
-
Females are exclusively used for treatment 2, as was specified in the treatment list.
-
Red diamonds mark the mean values for a specific sex within each treatment group.
-
The following plots show the organization of the cage rack, individual cages colored by different variables each time.
-
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.
-
-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.Rmd b/vignettes/cached/_plate_scoring_ex2.Rmd
index cc47b1e0..b3cba4bc 100644
--- a/vignettes/cached/_plate_scoring_ex2.Rmd
+++ b/vignettes/cached/_plate_scoring_ex2.Rmd
@@ -1,7 +1,7 @@
---
title: "Plate scoring example 2"
output: html_fragment
-knit: (\(input, ...) rmarkdown::render(input, output_dir = "vignettes/cached"))
+knit: (\(input, ...) rmarkdown::render(input, output_dir = here::here("vignettes/cached")))
---
```{r, include = FALSE}
@@ -40,28 +40,28 @@ example2 <- BatchContainer$new(
)
# 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)
```
```{r}
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,
@@ -70,9 +70,9 @@ trace <- optimize_design(bc,
```
```{r}
-trace$elapsed
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
@@ -92,33 +92,34 @@ permutation function which takes the plate structure into account and only
shuffles samples around within one plate.
```{r}
-# 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)),
)
+bc$trace$elapsed
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)
```
```{r}
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)),
@@ -128,9 +129,9 @@ trace <- optimize_design(bc,
```
```{r}
-trace
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
@@ -153,16 +154,14 @@ happen first within plate 1, then within plate 2, so that the two scores can be
optimized in succeeding runs.
```{r}
-# 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"))
```
```{r}
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,
@@ -171,21 +170,23 @@ trace <- optimize_design(bc,
```
```{r}
-trace
+bc$trace$elapsed
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)
```
```{r}
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)),
@@ -195,14 +196,16 @@ trace <- optimize_design(bc,
```
```{r}
-trace
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
```
```{r}
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)),
@@ -212,9 +215,9 @@ trace <- optimize_design(bc,
```
```{r}
-trace
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
plot_plate(bc,
plate = plate, row = row, column = col, .color = Group,
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.Rmd b/vignettes/cached/_plate_scoring_ex3.Rmd
index 8f5fdca6..872e9d9d 100644
--- a/vignettes/cached/_plate_scoring_ex3.Rmd
+++ b/vignettes/cached/_plate_scoring_ex3.Rmd
@@ -1,7 +1,7 @@
---
title: "Plate scoring example 3"
output: html_fragment
-knit: (\(input, ...) rmarkdown::render(input, output_dir = "vignettes/cached"))
+knit: (\(input, ...) rmarkdown::render(input, output_dir = here::here("vignettes/cached")))
---
```{r, include = FALSE}
@@ -51,7 +51,7 @@ example3 <- BatchContainer$new(
# 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)
@@ -60,14 +60,14 @@ assign_random(example3,
)
)
-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"))
```
```{r}
set.seed(42)
-trace <- optimize_design(bc,
+bc <- optimize_design(
+ example3,
+ scoring = scoring_f,
quiet = TRUE,
max_iter = 150,
n_shuffle = 2,
@@ -76,7 +76,7 @@ trace <- optimize_design(bc,
```
```{r}
-trace
+bc$trace$elapsed
```
```{r, fig.width=7, fig.height=3.5}
@@ -87,17 +87,19 @@ plot_plate(bc,
```
```{r}
-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)
```
```{r}
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"),
@@ -110,9 +112,9 @@ trace <- optimize_design(bc,
```
```{r}
-trace$elapsed
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
```
```{r, fig.width=7, fig.height=3.5}
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.Rmd b/vignettes/cached/_plate_scoring_ex4.Rmd
index c12c29bc..6ce2e1c5 100644
--- a/vignettes/cached/_plate_scoring_ex4.Rmd
+++ b/vignettes/cached/_plate_scoring_ex4.Rmd
@@ -1,7 +1,7 @@
---
title: "Plate scoring example 4"
output: html_fragment
-knit: (\(input, ...) rmarkdown::render(input, output_dir = "vignettes/cached"))
+knit: (\(input, ...) rmarkdown::render(input, output_dir = here::here("vignettes/cached")))
---
```{r, include = FALSE}
@@ -38,31 +38,31 @@ example4 <- BatchContainer$new(
# 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)
```
```{r}
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)),
@@ -74,9 +74,9 @@ trace <- optimize_design(bc,
```
```{r, fig.width=7, fig.height=3.5}
-trace$elapsed
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
@@ -90,7 +90,9 @@ reference!
```{r}
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)),
@@ -103,7 +105,7 @@ trace <- optimize_design(bc,
```
```{r, fig.width=7, fig.height=3.5}
-bc$score()
+bc$score(scoring_f)
cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
@@ -118,17 +120,17 @@ default acceptance function. We are strictly prioritizing the leftmost score in
addition to reflect relevance for the design.
```{r}
-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)
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,
@@ -138,7 +140,7 @@ trace <- optimize_design(bc,
```
```{r, fig.width=7, fig.height=3.5}
-bc$score()
+bc$score(scoring_f)
cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
@@ -151,17 +153,16 @@ Using a tolerance value to accept slightly worse solutions in the leftmost
relevant score if overcompensated by other scores:
```{r}
-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),
@@ -169,12 +170,10 @@ trace <- optimize_design(bc,
quiet = TRUE
)
-bc$score()
+bc$score(scoring_f)
```
```{r, fig.width=7, fig.height=3.5}
-bc$score()
-
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"),
@@ -188,17 +187,17 @@ $\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.
```{r}
-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)
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),
@@ -208,7 +207,7 @@ trace <- optimize_design(bc,
```
```{r, fig.width=7, fig.height=3.5}
-bc$score()
+bc$score(scoring_f)
cowplot::plot_grid(
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = "Final layout by Group"),
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.Rmd b/vignettes/cached/_plate_scoring_ex5.Rmd
index be4af9be..064d0571 100644
--- a/vignettes/cached/_plate_scoring_ex5.Rmd
+++ b/vignettes/cached/_plate_scoring_ex5.Rmd
@@ -1,7 +1,7 @@
---
title: "Plate scoring example 5"
output: html_fragment
-knit: (\(input, ...) rmarkdown::render(input, output_dir = "vignettes/cached"))
+knit: (\(input, ...) rmarkdown::render(input, output_dir = here::here("vignettes/cached")))
---
```{r, include = FALSE}
@@ -33,25 +33,25 @@ example5 <- BatchContainer$new(
)
# 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)
```
```{r}
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)),
@@ -60,9 +60,9 @@ trace <- optimize_design(bc,
```
```{r, fig.width=7, fig.height=3.5}
-trace$elapsed
+bc$trace$elapsed
-bc$score()
+bc$score(scoring_f)
plot_plate(bc, plate = plate, row = row, column = col, .color = Group, title = stringr::str_c("Line penalization: ", penalize_lines))
```
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))
-
+
diff --git a/vignettes/custom_shuffle.Rmd b/vignettes/custom_shuffle.Rmd
index 6d835657..1dec234f 100644
--- a/vignettes/custom_shuffle.Rmd
+++ b/vignettes/custom_shuffle.Rmd
@@ -55,8 +55,8 @@ We start by assigning samples randomly.
set.seed(42)
bc <- BatchContainer$new(
dimensions = c("cage" = 11, "position" = 5)
-)
-assign_random(bc, samples)
+) %>%
+ assign_random(samples)
bc
```
@@ -96,15 +96,14 @@ and `sex` interactions are considered in the scoring function. We only use 10 it
shuffling is limited to locations with males and enforces change of cage on every iteration.
```{r}
-bc$scoring_f <- osat_score_generator(
- "cage",
- "sex"
-)
-
set.seed(10)
-res <- optimize_design(
+bc <- optimize_design(
bc,
+ scoring = osat_score_generator(
+ "cage",
+ "sex"
+ ),
shuffle_proposal_func = shuffle_with_constraints(
sex == "M",
cage != .src$cage
@@ -112,7 +111,7 @@ res <- optimize_design(
max_iter = 10
)
-plot(res)
+bc$plot_trace()
```
We expect the distribution of males become even, while other variables are not significantly
affected.
@@ -129,7 +128,7 @@ locations. We also ensure that on every iteration the cage number is changed; we
`position` dimension does affect actual animal allocation.
```{r}
-bc$scoring_f <- function(bc) {
+scoring_f <- function(bc) {
samples <- bc$get_samples(include_id = TRUE, as_tibble = FALSE)
avg_w <- samples[, mean(weight, na.rm = TRUE)]
avg_w_per_cage <- samples[!is.na(weight), mean(weight), by = cage]$V1
@@ -141,7 +140,8 @@ bc$scoring_f <- function(bc) {
}
set.seed(12)
-res <- optimize_design(bc,
+bc <- optimize_design(bc,
+ scoring = scoring_f,
shuffle_proposal = shuffle_with_constraints(
sex == "F",
cage != .src$cage & (is.na(sex) | sex != "M")
@@ -149,8 +149,8 @@ res <- optimize_design(bc,
n_shuffle = c(rep(10, 20), rep(5, 20), rep(3, 20), rep(1, 140)),
max_iter = 200
)
-plot(res)
-bc$score()
+bc$plot_trace()
+scoring_f(bc)
```
Now we have a much more even distribution of weights and treatment/control balance.
diff --git a/vignettes/invivo_study_design.Rmd b/vignettes/invivo_study_design.Rmd
index d09375ef..fec8ac1f 100644
--- a/vignettes/invivo_study_design.Rmd
+++ b/vignettes/invivo_study_design.Rmd
@@ -215,7 +215,7 @@ InVivo_assignTreatments <- function(animal_list, treatments,
exclude = exclude_table
)
- assign_in_order(bc_treatment, ani_bclevels)
+ bc_treatment <- assign_in_order(bc_treatment, ani_bclevels)
if (!quiet_process) message("Constructing scoring functions:")
@@ -275,20 +275,20 @@ InVivo_assignTreatments <- function(animal_list, treatments,
}
assertthat::assert_that(length(scoring_functions) > 0, msg = "No variables for scoring found or all have only one level. Nothing to do.")
- bc_treatment$scoring_f <- scoring_functions
- bc_treatment$score()
+ bc_treatment$score(scoring_functions)
- trace <- optimize_design(
+ bc_treatment <- optimize_design(
bc_treatment,
+ scoring = scoring_functions,
n_shuffle = n_shuffle,
acceptance_func = ~ accept_leftmost_improvement(..., tolerance = 0.1),
quiet = quiet_optimize
)
# Check if user given constraints (if provided) could be satisfied
- if ("trt_constraints" %in% names(bc_treatment$score())) {
- if (bc_treatment$score()[["trt_constraints"]] > 0) {
- message("CAUTION: User defined constraints could not be fully met (remaining score ", bc_treatment$score()[["trt_constraints"]], ")")
+ if ("trt_constraints" %in% names(bc_treatment$score(scoring_functions))) {
+ if (bc_treatment$score(scoring_functions)[["trt_constraints"]] > 0) {
+ message("CAUTION: User defined constraints could not be fully met (remaining score ", bc_treatment$score(scoring_functions)[["trt_constraints"]], ")")
} else {
if (!quiet_process) message("Success. User provided constraints could be fully met.")
}
@@ -325,7 +325,7 @@ Invivo_assignCages <- function(design_trt,
bc_cage <- BatchContainer$new(
dimensions = c("Dummy" = 1, ID = nrow(design_trt))
)
- assign_in_order(bc_cage, design_trt)
+ bc_cage <- assign_in_order(bc_cage, design_trt)
shuffle_proposal <- shuffle_grouped_data(bc_cage,
allocate_var = "Dummy",
@@ -372,15 +372,14 @@ Invivo_assignCages <- function(design_trt,
scoring_functions <- c(scoring_functions, sf)
}
- if (length(scoring_functions) > 0) {
- bc_cage$scoring_f <- scoring_functions
- } else {
+ if (length(scoring_functions) == 0) {
if (!quiet_process) message(" ... just a dummy score as there are no user provided balancing variables")
- bc_cage$scoring_f <- osat_score_generator(batch_vars = "Dummy", feature_vars = c("Treatment"))
+ scoring_functions <- osat_score_generator(batch_vars = "Dummy", feature_vars = c("Treatment"))
}
- trace <- optimize_design(
+ bc_cage <- optimize_design(
bc_cage,
+ scoring = scoring_functions,
shuffle_proposal_func = shuffle_proposal,
acceptance_func = accept_leftmost_improvement,
max_iter = maxiter,
@@ -436,7 +435,7 @@ Invivo_arrangeCages <- function(design_cage,
dimensions = c(Rack = nr_racks, CageRow = n_cage_x, CageCol = n_cage_y)
)
- assign_random(bc_rack, design_rack)
+ bc_rack <- assign_random(bc_rack, design_rack)
# Firstly, distribute variables across racks if necessary
if (nr_racks > 1) {
@@ -447,16 +446,18 @@ Invivo_arrangeCages <- function(design_cage,
)
}
- bc_rack$scoring_f <- list(across_rack = osat_score_generator(batch_vars = c("Rack"), feature_vars = distribute_cagerack_vars))
+ scoring_functions <- list(across_rack = osat_score_generator(batch_vars = c("Rack"), feature_vars = distribute_cagerack_vars))
- optimize_design(bc_rack,
+ bc_rack <- optimize_design(
+ bc_rack,
+ scoring = scoring_functions,
quiet = quiet_optimize,
min_score = 0, max_iter = 1e3,
n_shuffle = 2,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 10000, alpha = 0.5))
)
- if (!quiet_process) message(" ... final score: ", bc_rack$score())
+ if (!quiet_process) message(" ... final score: ", bc_rack$score(scoring_f))
}
if (!quiet_process) {
@@ -475,13 +476,12 @@ Invivo_arrangeCages <- function(design_cage,
}
names(scoring_functions) <- stringr::str_c(names(scoring_functions), rep(distribute_cagerack_vars, each = nr_racks), sep = "_")
- bc_rack$scoring_f <- scoring_functions
-
for (i in 1:nr_racks) {
if (!quiet_process) message(" ... Rack ", i)
- trace <- optimize_design(
+ bc_rack <- optimize_design(
bc_rack,
+ scoring = scoring_functions,
shuffle_proposal_func = mk_subgroup_shuffling_function(
subgroup_vars = "Rack",
restrain_on_subgroup_levels = c(i),
@@ -495,7 +495,7 @@ Invivo_arrangeCages <- function(design_cage,
)
}
- if (!quiet_process) message(" ... final scores: ", paste(names(bc_rack$score()), round(bc_rack$score(), 2), sep = ": ", collapse = ", "))
+ if (!quiet_process) message(" ... final scores: ", paste(names(bc_rack$score(scoring_functions)), round(bc_rack$score(scoring_functions), 2), sep = ": ", collapse = ", "))
# Translate Rack numbers to some text output and assign CageNr
design_rack <- bc_rack$get_samples() %>%
diff --git a/vignettes/nested_dimensions_examples.Rmd b/vignettes/nested_dimensions_examples.Rmd
index ffa9226f..575c3965 100644
--- a/vignettes/nested_dimensions_examples.Rmd
+++ b/vignettes/nested_dimensions_examples.Rmd
@@ -54,13 +54,8 @@ bc <- BatchContainer$new(
)
)
-# Add samples to container
-bc$samples <- multi_trt_day_samples
# Initial random assignment
-assign_in_order(bc)
-# Set scoring function
-bc$scoring_f <- osat_score_generator(c("batch"), c("Treatment", "Time"))
-
+bc <- assign_in_order(bc, multi_trt_day_samples)
bc
```
@@ -73,10 +68,10 @@ n_iterations <- length(n_shuffle)
set.seed(42) # should we have conventions for this?
-# initial score
-# bc$score()
-trace <- optimize_design(
+scoring_f <- osat_score_generator(c("batch"), c("Treatment", "Time"))
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
n_shuffle = n_shuffle,
max_iter = n_iterations
) # default is 10000
@@ -89,8 +84,10 @@ I practice you will have to run for a much higher number of iterations.
```{r, fig.width=5, fig.height= 4}
qplot(
- x = 1:trace$n_steps, y = trace$scores, color = factor(c(32, n_shuffle)),
- main = str_glue("Final score={bc$score()}"), geom = "point"
+ x = bc$trace$scores[[1]]$step,
+ y = bc$trace$scores[[1]]$score_1,
+ color = factor(c(32, n_shuffle)),
+ main = str_glue("Final score={bc$score(scoring_f)}"), geom = "point"
)
```
@@ -105,18 +102,16 @@ bc$get_samples(assignment = TRUE) %>%
# Repeat but use shuffle with contraints
```{r, fig.width=6, fig.height= 4}
-
# copy batch container for second optimization
-bc2 <- bc$copy()
-# Initial random assignment
-assign_in_order(bc2)
+bc2 <- assign_in_order(bc)
n_iterations <- 200
set.seed(42) # should we have conventions for this?
-trace2 <- optimize_design(
+bc2 <- optimize_design(
bc2,
+ scoring = scoring_f,
shuffle_proposal = shuffle_with_constraints(
src = TRUE,
# batch needs to change for shuffle to be accepted
@@ -126,8 +121,9 @@ trace2 <- optimize_design(
)
qplot(
- x = 1:trace$n_steps, y = trace2$scores, # color = factor(n_shuffle),
- main = str_glue("Final score={bc2$score()}"), geom = "point"
+ x = bc2$trace$scores[[1]]$step,
+ y = bc2$trace$scores[[1]]$score_1,
+ main = str_glue("Final score={bc2$score(scoring_f)}"), geom = "point"
)
bc2$get_samples(assignment = TRUE) %>%
@@ -147,16 +143,17 @@ For this we keep the optimized `batch` and now only optimize `run` with constrai
```{r}
n_iterations <- 100
-# assign new optimization function
-bc$scoring_f <- osat_score_generator(c("run"), c("Treatment", "Time"))
+# new optimization function
+scoring_f <- osat_score_generator(c("run"), c("Treatment", "Time"))
# like this the optimization score is wrong because it tries to optimize across Batches.
# Possible ways to go:
# - we'd need something like c("batch", batch/run") for optimize by batch and run within batch.
# - or we add "batch/run" to the constraints somehow.
-bc$score()
+bc$score(scoring_f)
-trace_run <- optimize_design(
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
shuffle_proposal = shuffle_with_constraints(
src = TRUE,
# batch remains the same and run needs to change
@@ -168,8 +165,10 @@ trace_run <- optimize_design(
```{r, fig.width=6, fig.height= 4}
qplot(
- x = 1:trace_run$n_steps, y = trace_run$scores, color = factor(n_iterations),
- main = str_glue("Final score={bc$score()}"), geom = "point"
+ x = bc$trace$scores[[1]]$step,
+ y = bc$trace$scores[[1]]$score_1,
+ color = factor(n_iterations),
+ main = str_glue("Final score={bc$score(scoring_f)}"), geom = "point"
)
```
@@ -178,7 +177,6 @@ qplot(
This is not giving the expected mix of treatments across runs.
```{r, fig.width=6, fig.height= 4}
-
bc$get_samples() %>%
mutate(run = factor(run)) %>%
ggplot(aes(x = run, fill = Treatment, alpha = factor(Time))) +
diff --git a/vignettes/optimizer_examples.Rmd b/vignettes/optimizer_examples.Rmd
index c707c416..be3bf7de 100644
--- a/vignettes/optimizer_examples.Rmd
+++ b/vignettes/optimizer_examples.Rmd
@@ -17,6 +17,7 @@ knitr::opts_chunk$set(
```{r setup}
library(designit)
+library(magrittr)
```
@@ -60,12 +61,9 @@ bc <- BatchContainer$new(
run = 2, position = 5
),
exclude = tibble::tibble(batch = 4, run = c(1, 2), position = c(5, 5))
-)
-
-# Add samples to container
-assign_in_order(bc, samples = multi_trt_day_samples)
-# Set scoring function
-bc$scoring_f <- osat_score_generator(c("batch"), c("Treatment", "Time"))
+) %>%
+ # Add samples to container
+ assign_in_order(samples = multi_trt_day_samples)
bc
```
@@ -85,15 +83,15 @@ Optimization finishes after the list of permutations is exhausted.
```{r}
n_shuffle <- rep(c(32, 10, 5, 2, 1), c(20, 40, 40, 50, 50))
+scoring_f <- osat_score_generator(c("batch"), c("Treatment", "Time"))
-bc1 <- bc$copy()
-
-trace1 <- optimize_design(
- bc1,
+bc1 <- optimize_design(
+ bc,
+ scoring = scoring_f,
n_shuffle = n_shuffle # will implicitly generate a shuffling function according to the provided schedule
)
-trace1$elapsed
+bc1$trace$elapsed
```
## Optimization trace
@@ -101,14 +99,27 @@ trace1$elapsed
Custom plot with some colours:
```{r, fig.width=5, fig.height= 4}
-ggplot2::qplot(x = seq_along(trace1$scores), y = trace1$scores, color = factor(n_shuffle)[1:length(trace1$scores)], geom = "point") +
- ggplot2::labs(title = "Score 1 tracing", subtitle = stringr::str_glue("Final score = {bc1$score()}"), x = "Iteration", y = "Score", color = "n_shuffle")
+bc1$scores_table() %>%
+ dplyr::mutate(
+ n_shuffle = c(NA, n_shuffle)
+ ) %>%
+ ggplot2::ggplot(
+ ggplot2::aes(step, value, color = factor(n_shuffle))
+ ) +
+ ggplot2::geom_point() +
+ ggplot2::labs(
+ title = "Score 1 tracing",
+ subtitle = stringr::str_glue("Final score = {bc1$score(scoring_f)}"),
+ x = "Iteration",
+ y = "Score",
+ color = "n_shuffle"
+ )
```
Using the internal method...
```{r, fig.width=5, fig.height= 4}
-trace1$plot()
+bc1$plot_trace()
```
We may safely apply the batch container methods get_samples() and score() also
@@ -116,7 +127,7 @@ after using the new optimization code.
## Final batch layout
```{r, fig.width=6, fig.height=5}
-bc1$score()
+bc1$score(scoring_f)
bc1$get_samples(assignment = TRUE) %>%
dplyr::filter(!is.na(Treatment)) %>%
@@ -136,8 +147,9 @@ immediately on the same batch container.
```{r}
n_shuffle <- rep(c(5, 2, 1), c(30, 30, 30))
-optimize_design(
+bc1 <- optimize_design(
bc1,
+ scoring = scoring_f,
n_shuffle = n_shuffle
)
```
@@ -154,10 +166,9 @@ reaching a specific minimum delta threshold (score improvement from one selected
solution to the next).
```{r}
-bc2 <- bc$copy()
-
-optimize_design(
- bc2,
+bc2 <- optimize_design(
+ bc,
+ scoring = scoring_f,
n_shuffle = 3, # will implicitly generate a shuffling function that will do 3 swaps at each iteration
max_iter = 2000,
min_delta = 0.1
@@ -168,7 +179,7 @@ optimize_design(
# Optimization with multi-variate scoring function
Instead of passing a single scoring function, a list of multiple scoring
-functions can be assigned to a batch container, each of which to return a scalar
+functions can be passed to the optimizer, each of which to return a scalar
value on evaluation.
By default, a strict improvement rule is applied for classifying a potential
@@ -182,16 +193,15 @@ The second scoring function used here is by the way rather redundant and just
serves for illustration.
```{r}
-bc3 <- bc$copy()
-
-bc3$scoring_f <- list(
+multi_scoring_f <- list(
osat_score_generator(c("batch"), c("Treatment", "Time")),
osat_score_generator(c("batch"), c("Treatment"))
)
-trace <- optimize_design(
- bc3,
+bc3 <- optimize_design(
+ bc,
+ scoring = multi_scoring_f,
n_shuffle = 3,
max_iter = 200,
min_delta = 0.1
@@ -216,16 +226,9 @@ We may also want to decrease the delta_min parameter to match the new numerical
range.
```{r}
-bc3_as <- bc$copy()
-
-bc3_as$scoring_f <- list(
- osat_score_generator(c("batch"), c("Treatment", "Time")),
- osat_score_generator(c("batch"), c("Treatment"))
-)
-
-
-trace <- optimize_design(
- bc3_as,
+bc3_as <- optimize_design(
+ bc,
+ scoring = multi_scoring_f,
n_shuffle = 3,
max_iter = 200,
min_delta = 0.01,
@@ -245,16 +248,9 @@ simply set the aggregated score to whichever of the individual scores is larger
```{r}
-bc4 <- bc$copy()
-
-bc4$scoring_f <- list(
- osat_score_generator(c("batch"), c("Treatment", "Time")),
- osat_score_generator(c("batch"), c("Treatment"))
-)
-
-
-optimize_design(
- bc4,
+bc4 <- optimize_design(
+ bc,
+ scoring = multi_scoring_f,
n_shuffle = 3,
aggregate_scores_func = worst_score,
max_iter = 200,
@@ -271,15 +267,9 @@ For illustration, we omit the `n_shuffle` parameter here, which will lead by
default to pairwise sample swaps being done on each iteration.
```{r, eval = FALSE}
-bc5 <- bc$copy()
-
-bc5$scoring_f <- list(
- osat_score_generator(c("batch"), c("Treatment", "Time")),
- osat_score_generator(c("batch"), c("Treatment"))
-)
-
-optimize_design(
- bc5,
+bc5 <- optimize_design(
+ bc,
+ scoring = multi_scoring_f,
aggregate_scores_func = sum_scores,
max_iter = 200,
autoscale_scores = TRUE,
@@ -295,15 +285,9 @@ Note that we don't use the auto-scaling in this case as the L2-norm based optimi
not the minimal (negative) value that would be desired in that case.
```{r, eval = FALSE}
-bc5_2 <- bc$copy()
-
-bc5_2$scoring_f <- list(
- osat_score_generator(c("batch"), c("Treatment", "Time")),
- osat_score_generator(c("batch"), c("Treatment"))
-)
-
-optimize_design(
- bc5_2,
+bc5_2 <- optimize_design(
+ bc,
+ scoring = multi_scoring_f,
aggregate_scores_func = L2s_norm,
max_iter = 200,
)
@@ -322,10 +306,9 @@ across all available positions in the batch container. Note that this is usually
not a good strategy for converging to a solution.
```{r}
-bc6 <- bc$copy()
-
-optimize_design(
- bc6,
+bc6 <- optimize_design(
+ bc,
+ scoring = scoring_f,
shuffle_proposal_func = complete_random_shuffling,
max_iter = 200
)
@@ -349,10 +332,9 @@ to be optimized. Choose an appropriate aggregation function if you happen to
have multiple scores initially.
```{r}
-bc7 <- bc$copy()
-
-trace7 <- optimize_design(
- bc7,
+bc7 <- optimize_design(
+ bc,
+ scoring = scoring_f,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(),
max_iter = 200
@@ -362,23 +344,22 @@ The trace may show a non strictly monotonic behavior now, reflecting the SA
protocol at work.
```{r, fig.width=5, fig.height= 4}
-trace7$plot()
+bc7$plot_trace()
```
Better results and quicker convergence may be achieved by playing with the
starting temperature (T0) and cooling speed (alpha) in a specific case.
```{r}
-bc8 <- bc$copy()
-
-trace8 <- optimize_design(
- bc8,
+bc8 <- optimize_design(
+ bc,
+ scoring = scoring_f,
n_shuffle = 1,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 100, alpha = 2)),
max_iter = 150
)
-trace8$plot()
+bc8$plot_trace()
```
# Full blown example
@@ -387,16 +368,15 @@ The following example puts together all possible options to illustrate the
flexibility of the optimization.
```{r}
-bc$scoring_f <- list(
- osat_score_generator(c("batch"), c("Treatment", "Time")),
- osat_score_generator(c("batch"), c("Treatment")),
- osat_score_generator(c("batch"), c("Time"))
-)
-
n_shuffle <- rep(c(3, 2, 1), c(20, 20, 200))
-trace <- optimize_design(
+bc9 <- optimize_design(
bc,
+ scoring = list(
+ osat_score_generator(c("batch"), c("Treatment", "Time")),
+ osat_score_generator(c("batch"), c("Treatment")),
+ osat_score_generator(c("batch"), c("Time"))
+ ),
n_shuffle = n_shuffle,
aggregate_scores_func = sum_scores,
acceptance_func = mk_simanneal_acceptance_func(mk_simanneal_temp_func(T0 = 500, alpha = 1)),
@@ -405,9 +385,9 @@ trace <- optimize_design(
autoscale_scores = T
)
-trace$plot()
+bc9$plot_trace()
-bc$get_samples(assignment = TRUE) %>%
+bc9$get_samples(assignment = TRUE) %>%
dplyr::mutate(batch = factor(batch)) %>%
ggplot2::ggplot(ggplot2::aes(x = batch, fill = Treatment, alpha = factor(Time))) +
ggplot2::geom_bar()
diff --git a/vignettes/osat.Rmd b/vignettes/osat.Rmd
index 1b9c38c7..17549095 100644
--- a/vignettes/osat.Rmd
+++ b/vignettes/osat.Rmd
@@ -124,7 +124,7 @@ bc$n_locations
Assign samples and get initial setup.
```{r}
-bc$samples <- samples
+bc <- assign_in_order(bc, samples)
starting_assignment <- bc$get_locations() %>%
left_join(g_setup_start) %>%
@@ -139,22 +139,23 @@ bc$get_samples(remove_empty_locations = TRUE) %>%
## Using designit OSAT score implementation
```{r}
-bc$scoring_f <- osat_score_generator("plates", c("SampleType", "Race", "AgeGrp"))
+scoring_f <- osat_score_generator("plates", c("SampleType", "Race", "AgeGrp"))
-bc$score()
+bc$score(scoring_f)
g_setup@metadata$optValue %>% head(1)
# should be identical
bench::system_time({
set.seed(123)
- trace_reference <- optimize_design(bc, max_iter = params$iterations)
+ bc_reference <- optimize_design(bc, scoring = scoring_f, max_iter = params$iterations)
})
```
```{r}
# final score
-bc$score()
-plot(trace_reference, main = str_glue("Final score={bc$score()}"))
+bc_reference$score(scoring_f)
+bc_reference$plot_trace() +
+ ggtitle(str_glue("Final score={bc$score(scoring_f)}"))
bc$get_samples(remove_empty_locations = TRUE) %>%
plot_batch()
```
@@ -163,9 +164,8 @@ bc$get_samples(remove_empty_locations = TRUE) %>%
Instead of relying on `BatchContainer`, here we have a manual optimization process using `data.table`.
```{r}
-bc$move_samples(location_assignment = starting_assignment)
-
fast_osat_optimize <- function(bc, batch_vars, feature_vars, iterations) {
+ bc <- bc$copy()
ldf <- data.table::data.table(bc$get_locations())[, c("plates")][, ".sample_id" := bc$assignment]
fcols <- c(".sample_id", feature_vars)
smp <- data.table::data.table(bc$samples)[, ..fcols]
@@ -202,27 +202,27 @@ fast_osat_optimize <- function(bc, batch_vars, feature_vars, iterations) {
bc$assignment <- df$.sample_id
- scores
+ list(bc=bc, scores=scores)
}
bench::system_time({
set.seed(123)
- trace <- fast_osat_optimize(bc, "plates", c("SampleType", "Race", "AgeGrp"), iterations = params$iterations)
+ opt_res <- fast_osat_optimize(bc, "plates", c("SampleType", "Race", "AgeGrp"), iterations = params$iterations)
})
```
# Shuffle optimization with burn-in
```{r}
-bc$move_samples(location_assignment = starting_assignment)
-
-bc$scoring_f <- osat_score_generator("plates", c("SampleType", "Race", "AgeGrp"))
+scoring_f <- osat_score_generator("plates", c("SampleType", "Race", "AgeGrp"))
burn_in_it <- floor(params$iterations * 0.1)
burn_in_it
bench::system_time({
set.seed(123)
- trace_burn_in <- optimize_design(bc,
+ bc_burn_in <- optimize_design(
+ bc,
+ scoring = scoring_f,
n_shuffle = c(
rep(20, burn_in_it),
rep(
@@ -237,9 +237,9 @@ bench::system_time({
```{r}
tibble(
- i = seq_len(trace_burn_in$n_steps),
- normal = trace_reference$scores,
- burnin = trace_burn_in$scores
+ i = bc_burn_in$trace$scores[[1]]$step,
+ normal = bc_reference$trace$scores[[1]]$score_1,
+ burnin = bc_burn_in$trace$scores[[1]]$score_1
) %>%
pivot_longer(-i, names_to = "method", values_to = "score") %>%
ggplot(aes(i, score, col = method)) +
@@ -249,9 +249,7 @@ tibble(
# Score demonstration
```{r}
-bc$score()
-bc$scoring_f <- function(...) rnorm(1)
-bc$score()
+bc$score(scoring_f)
```
```{r}
@@ -260,13 +258,11 @@ assign_random(bc)
bc$get_samples()
bc$get_samples(remove_empty_locations = TRUE)
-bc$score()
-
-bc$scoring_f <- list(
+scoring_f <- list(
fc0 = function(samples) rnorm(1) + 2 * rexp(1),
fc1 = function(samples) rnorm(1, 100),
fc2 = function(samples) -7
)
-bc$score()
+bc$score(scoring_f)
```
diff --git a/vignettes/plate_layouts.Rmd b/vignettes/plate_layouts.Rmd
index fe1af67b..b2c81095 100644
--- a/vignettes/plate_layouts.Rmd
+++ b/vignettes/plate_layouts.Rmd
@@ -68,7 +68,7 @@ bc <- BatchContainer$new(
dimensions = list("plate" = 3, "row" = 4, "col" = 6),
)
-assign_in_order(bc, dat)
+bc <- assign_in_order(bc, dat)
head(bc$get_samples()) %>% gt::gt()
```
@@ -99,7 +99,7 @@ The order of the factors indicate their relative importance.
In this case we prioritize Group over Sex.
```{r}
-traces <- optimize_multi_plate_design(bc,
+bc <- optimize_multi_plate_design(bc,
across_plates_variables = c("Group", "Sex"),
within_plate_variables = c("Group"),
plate = "plate",
@@ -130,8 +130,12 @@ cowplot::plot_grid(
We can look at the trace objects for each internal `optimize_design` run,
returned from the wrapper function.
-```{r fig.width=3, fig.height=3}
-purrr::imap(traces, ~ .x$plot(include_aggregated = TRUE) + labs(title = .y))
+```{r fig.width=6, fig.height=3}
+bc$scores_table() |>
+ ggplot(aes(step, value, color = score)) +
+ geom_line() +
+ geom_point() +
+ facet_wrap(~ optimization_index, scales = "free_y")
```
## Plate scoring
@@ -140,7 +144,7 @@ Note that internally the wrapper function sets up plate specific scoring functio
that could manually be set up in the following way.
```{r, eval = FALSE}
-bc$scoring_f <- c(
+scoring_f <- c(
Group = mk_plate_scoring_functions(bc,
plate = "plate", row = "row", column = "col",
group = "Group", penalize_lines = "hard"
@@ -184,12 +188,12 @@ bc <- BatchContainer$new(
dimensions = list("batch" = 3, "location" = 11)
)
-bc$scoring_f <- list(
+scoring_f <- list(
group = osat_score_generator(batch_vars = "batch", feature_vars = "Group"),
sex = osat_score_generator(batch_vars = "batch", feature_vars = "Sex")
)
-assign_random(
+bc <- assign_random(
bc,
dat %>% select(SubjectID, Group, Sex) %>% distinct()
)
@@ -217,8 +221,9 @@ cowplot::plot_grid(
Optimizing the layout with `optimize_design()`
```{r}
-trace <- optimize_design(
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
n_shuffle = 1,
acceptance_func = ~ accept_leftmost_improvement(..., tolerance = 0.01),
max_iter = 150,
@@ -238,7 +243,7 @@ cowplot::plot_grid(
bc$get_samples() %>% ggplot(aes(x = batch, fill = Sex)) +
geom_bar() +
labs(y = "subject count"),
- trace$plot(include_aggregated = TRUE)
+ bc$plot_trace(include_aggregated = TRUE)
),
ncol = 3
)
@@ -268,7 +273,7 @@ bc <- BatchContainer$new(
)
# initial assignment such that the original plate assigned stays the same
-assign_in_order(
+bc <- assign_in_order(
bc,
dat %>% arrange(batch)
)
@@ -295,7 +300,7 @@ For distributing samples within each plate, we use variables Group and Sex again
The order of the factors indicate their relative importance.
```{r}
-traces <- optimize_multi_plate_design(bc,
+bc <- optimize_multi_plate_design(bc,
within_plate_variables = c("Group", "Sex"),
plate = "plate",
row = "row",
@@ -322,8 +327,12 @@ cowplot::plot_grid(
)
```
-```{r fig.width=3, fig.height=3}
-purrr::imap(traces, ~ .x$plot(include_aggregated = TRUE) + labs(title = .y))
+```{r fig.width=9, fig.height=3}
+bc$scores_table() |>
+ ggplot(aes(step, value, color = score)) +
+ geom_line() +
+ geom_point() +
+ facet_wrap(~ optimization_index)
```
# Full dataset
@@ -381,12 +390,12 @@ bc <- BatchContainer$new(
dimensions = list("plate" = 3, "locations" = 11)
)
-bc$scoring_f <- list(
+scoring_f <- list(
group = osat_score_generator(batch_vars = "plate", feature_vars = c("Group")),
sex = osat_score_generator(batch_vars = "plate", feature_vars = "Sex")
)
-assign_random(bc, subjects)
+bc <- assign_random(bc, subjects)
```
```{r, fig.width= 8, fig.height=3}
@@ -409,8 +418,9 @@ cowplot::plot_grid(
Optimizing the layout with `optimize_design()`
```{r}
-trace <- optimize_design(
+bc <- optimize_design(
bc,
+ scoring = scoring_f,
n_shuffle = 1,
acceptance_func = ~ accept_leftmost_improvement(..., tolerance = 0.1),
max_iter = 150,
@@ -433,7 +443,7 @@ cowplot::plot_grid(
bc$get_samples() %>% ggplot(aes(x = factor(plate), y = Age)) +
geom_boxplot() +
geom_point(),
- trace$plot(include_aggregated = TRUE)
+ bc$plot_trace(include_aggregated = TRUE)
),
nrow = 2
)
@@ -472,7 +482,7 @@ bc <- BatchContainer$new(
)
# assign samples in order of plate
-assign_in_order(
+bc <- assign_in_order(
bc,
samples_with_plate %>%
arrange(plate) %>%
@@ -512,7 +522,7 @@ For distributing samples within each plate, we use variables Group and Sex again
The order of the factors indicate their relative importance.
```{r}
-traces <- optimize_multi_plate_design(bc,
+bc <- optimize_multi_plate_design(bc,
within_plate_variables = c("Group", "SubjectID", "Sex"),
plate = "plate",
row = "row",
@@ -545,6 +555,10 @@ cowplot::plot_grid(
```
-```{r fig.width=5, fig.height=5}
-purrr::imap(traces, ~ .x$plot(include_aggregated = TRUE) + labs(title = .y))
+```{r fig.width=6, fig.height=5}
+bc$scores_table() |>
+ ggplot(aes(step, value, color = score)) +
+ geom_line() +
+ geom_point() +
+ facet_wrap(~ optimization_index)
```
diff --git a/vignettes/shuffling_with_constraints.Rmd b/vignettes/shuffling_with_constraints.Rmd
index 9fe748af..4ebf87de 100644
--- a/vignettes/shuffling_with_constraints.Rmd
+++ b/vignettes/shuffling_with_constraints.Rmd
@@ -68,9 +68,9 @@ table(treatments)
bc <- BatchContainer$new(locations_table = data.frame(Treatment = treatments, Position = seq_along(treatments)))
-assign_in_order(bc, invivo_study_samples)
+bc <- assign_in_order(bc, invivo_study_samples)
-bc$scoring_f <- osat_score_generator(batch_vars = "Treatment", feature_vars = c("Strain", "Sex"))
+scoring_f <- osat_score_generator(batch_vars = "Treatment", feature_vars = c("Strain", "Sex"))
bc
```
@@ -100,11 +100,10 @@ defined above at the same time. It can be passed to the optimizer together with
such as the scoring or acceptance functions.
```{r}
-bc2 <- bc$copy()
-
-optimize_design(
- bc2,
- shuffle_proposal_func = shuffle_grouped_data(bc2,
+bc2 <- optimize_design(
+ bc,
+ scoring = scoring_f,
+ shuffle_proposal_func = shuffle_grouped_data(bc,
allocate_var = "Treatment",
keep_together_vars = c("Strain", "Sex"),
keep_separate_vars = c("Earmark"),
@@ -238,10 +237,9 @@ the beginning!)
We can finally use the customized shuffling function in the optimization.
```{r echo=TRUE}
-bc3 <- bc$copy()
-
-trace <- optimize_design(
- bc3,
+bc3 <- optimize_design(
+ bc,
+ scoring = scoring_f,
shuffle_proposal_func = shuffle_proposal,
max_iter = 300
)