speed/Testing_split_plot.R at main · biometryhub/speed · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
# Hierarchical split-plot design
df_split <- data.frame(
  row = rep(1:12, each = 4),
  col = rep(1:4, times = 12),
  block = rep(1:4, each = 12),
  wholeplot = rep(1:12, each = 4),
  wholeplot_treatment = rep(rep(LETTERS[1:3], each = 4), times = 4),
  subplot_treatment = rep(letters[1:4], 12)
)

options(speed.cooling_rate = 0.9999)
result <- speed(
  df_split,
  swap = list(wp = "wholeplot_treatment", sp = "subplot_treatment"),
  swap_within = list(wp = "block", sp = "wholeplot"),
  early_stop_iterations = list(wp = 1000, sp = 20000),
  iterations = list(wp = 5000, sp = 50000)
)

autoplot(result, treatments = "wholeplot_treatment")
autoplot(result, treatments = "subplot_treatment")


new_design <- generate_sequential_neighbour(
  design,
  swap,
  swap_within,
  level,
  swap_count,
  swap_all_blocks
)

class(new_design$design) <- c("design", class(new_design$design))
autoplot(new_design$design, treatments = "wholeplot_treatment")
autoplot(new_design$design, treatments = "subplot_treatment")


options(speed.cooling_rate = 0.99)
df_split_split <- data.frame(
  row = rep(1:16, each = 9),
  col = rep(1:9, times = 16),
  block = rep(1:4, each = 36),
  # Fixed wholeplot assignment: 3 wholeplots per block, each 4×3
  wholeplot = rep(rep(1:3, each = 3), times = 16) + rep(0:3 * 3, each = 36),
  wholeplot_treatment = rep(rep(LETTERS[1:3], each = 3), times = 16),
  subplot = rep(1:48, each = 3),
  subplot_treatment = rep(rep(letters[1:4], each = 3), times = 12),
  subsubplot_treatment = rep(c("x", "y", "z"), 48)
)

result_ss <- speed(
  df_split_split,
  swap = list(
    wp = "wholeplot_treatment",
    sp = "subplot_treatment",
    ssp = "subsubplot_treatment"
  ),
  swap_within = list(wp = "block", sp = "wholeplot", ssp = "subplot"),
  iterations = list(wp = 2000, sp = 2000, ssp = 50000),
  early_stop_iterations = list(wp = 1000, sp = 3000, ssp = 30000)
)

autoplot(result_ss, treatments = "wholeplot_treatment")
autoplot(result_ss, treatments = "subplot_treatment")
autoplot(result_ss, treatments = "subsubplot_treatment")


df_strip <- data.frame(
  row = rep(1:12, each = 6), # 24 rows total (4 rows per block x 6 blocks)
  col = rep(1:6, times = 12), # 3 columns repeated
  block = rep(rep(1:2, each = 3), times = 4) + rep(0:2 * 2, each = 24), # 6 blocks, 12 plots each

  # Horizontal strips (3 levels, applied to rows within each block)
  vertical_treatment = rep(rep(LETTERS[1:3], times = 2), times = 12), # A, B, C

  # Vertical strips (4 levels, applied to columns within each block)
  horizontal_treatment = rep(rep(letters[1:4], each = 6), times = 3), # a, b, c, d

  # Plot identifier within each block
  plot_in_block = rep(1:12, times = 6)
)

class(df_strip) <- c("design", class(df_strip))
autoplot(df_strip, treatments = "block")
autoplot(df_strip, treatments = "horizontal_treatment")
autoplot(df_strip, treatments = "vertical_treatment")

result_strip <- speed(
  df_strip,
  swap = list(ht = "horizontal_treatment", vt = "vertical_treatment"),
  swap_within = list(ht = "block", vt = "block")
)

autoplot(result_strip, treatments = "horizontal_treatment")
autoplot(result_strip, treatments = "vertical_treatment")


result_strip <- speed(
  df_strip,
  swap = list(trial = "variety", within_trial = "variety"),
  swap_within = list(trial = "1", within_trial = "site"),
  spatial_factors = list(
    trial = ~trial,
    within_trial = ~ colBlocks + Lane + Position
  ),
  adj_factors = list(dim1 = "Lane", dim2 = "Position"),
  obj_function = list(
    trial = objective_function(),
    within_trial = objective_function(adj)
  )
)

result_strip <- speed(
  df_strip,
  swap = list(trial = "variety", within_trial = "variety"),
  swap_within = list(trial = "1", within_trial = "site"),
  spatial_factors = ~ row + col,
  grid_factors = list(dim1 = "row", dim2 = "column"),
  obj_function = list(
    trial = objective_function(),
    within_trial = objective_function(adj)
  )
)

speed(
  factorial_design,
  swap = list(A = "A", B = "B"),
  swap_within = list(A = "block:B", B = "block:A"),
  spatial_factors = ~ row + column,
  seed = 42
)