edibble icon indicating copy to clipboard operation
edibble copied to clipboard

Revisit algorithm for `assign_trts()`

Open emitanaka opened this issue 3 years ago • 2 comments

The current algorithm doesn't take into account a hierarchical structure with more than one level. Therefore the randomisation for something like below doesn't balance out on the second level of the hierarchy (i.e. rep) but it is on the first top level (i.e. block). A more general approach needed to account for this.

library(edibble)
eg <- design("Balanced Incomplete Block Design") %>%
  set_units(rep = 3, 
            block = nested_in(rep, 12),
            unit = nested_in(block, 4)) %>%
  set_trts(trt = 48) %>%
  allot_trts(trt ~ unit) %>%
  assign_trts("random", seed = 32) %>%
  serve_table()

with(eg, table(trt,rep))
#>        rep
#> trt     rep1 rep2 rep3
#>   trt1     3    0    0
#>   trt10    0    2    1
#>   trt11    0    1    2
#>   trt12    2    1    0
#>   trt13    0    1    2
#>   trt14    1    1    1
#>   trt15    2    0    1
#>   trt16    0    1    2
#>   trt17    1    1    1
#>   trt18    1    1    1
#>   trt19    1    1    1
#>   trt2     2    1    0
#>   trt20    1    0    2
#>   trt21    0    2    1
#>   trt22    0    2    1
#>   trt23    2    1    0
#>   trt24    1    1    1
#>   trt25    1    2    0
#>   trt26    0    0    3
#>   trt27    1    2    0
#>   trt28    1    2    0
#>   trt29    0    2    1
#>   trt3     1    2    0
#>   trt30    1    0    2
#>   trt31    2    1    0
#>   trt32    0    1    2
#>   trt33    2    1    0
#>   trt34    1    1    1
#>   trt35    2    0    1
#>   trt36    1    2    0
#>   trt37    0    1    2
#>   trt38    0    1    2
#>   trt39    2    1    0
#>   trt4     2    0    1
#>   trt40    0    0    3
#>   trt41    1    1    1
#>   trt42    0    1    2
#>   trt43    1    1    1
#>   trt44    1    1    1
#>   trt45    1    2    0
#>   trt46    1    1    1
#>   trt47    2    0    1
#>   trt48    1    0    2
#>   trt5     1    2    0
#>   trt6     1    1    1
#>   trt7     1    1    1
#>   trt8     2    1    0
#>   trt9     1    0    2

apply(with(eg, table(trt, block)), 2, table)
#>    block
#>     block1 block10 block11 block12 block13 block14 block15 block16 block17
#>   0     44      44      44      44      44      44      44      44      44
#>   1      4       4       4       4       4       4       4       4       4
#>    block
#>     block18 block19 block2 block20 block21 block22 block23 block24 block25
#>   0      44      44     44      44      44      44      44      44      44
#>   1       4       4      4       4       4       4       4       4       4
#>    block
#>     block26 block27 block28 block29 block3 block30 block31 block32 block33
#>   0      44      44      44      44     44      44      44      44      44
#>   1       4       4       4       4      4       4       4       4       4
#>    block
#>     block34 block35 block36 block4 block5 block6 block7 block8 block9
#>   0      44      44      44     44     44     44     44     44     44
#>   1       4       4       4      4      4      4      4      4      4

Created on 2022-03-21 by the reprex package (v2.0.1)

emitanaka avatar Mar 21 '22 04:03 emitanaka

See #45

emitanaka avatar Sep 25 '23 05:09 emitanaka

Neither solved with blockdesign algorithm:

library(edibble)
eg <- design("Balanced Incomplete Block Design") %>%
  set_units(rep = 3, 
            block = nested_in(rep, 12),
            unit = nested_in(block, 4)) %>%
  set_trts(trt = 48) %>%
  allot_trts(trt ~ unit) %>%
  assign_trts("blocksdesign", seed = 32) %>%
  serve_table()
#> Loading required namespace: blocksdesign

with(eg, table(trt,rep))
#>        rep
#> trt     rep1 rep2 rep3
#>   trt01    1    0    2
#>   trt02    0    1    2
#>   trt03    1    1    1
#>   trt04    0    2    1
#>   trt05    0    2    1
#>   trt06    1    2    0
#>   trt07    1    0    2
#>   trt08    1    0    2
#>   trt09    2    1    0
#>   trt10    3    0    0
#>   trt11    1    1    1
#>   trt12    1    2    0
#>   trt13    2    0    1
#>   trt14    1    1    1
#>   trt15    0    2    1
#>   trt16    2    1    0
#>   trt17    2    0    1
#>   trt18    1    2    0
#>   trt19    1    1    1
#>   trt20    1    0    2
#>   trt21    1    2    0
#>   trt22    1    1    1
#>   trt23    1    1    1
#>   trt24    0    2    1
#>   trt25    0    1    2
#>   trt26    1    1    1
#>   trt27    1    1    1
#>   trt28    0    2    1
#>   trt29    1    0    2
#>   trt30    0    2    1
#>   trt31    2    1    0
#>   trt32    2    1    0
#>   trt33    0    1    2
#>   trt34    0    0    3
#>   trt35    1    1    1
#>   trt36    1    1    1
#>   trt37    0    2    1
#>   trt38    2    0    1
#>   trt39    1    1    1
#>   trt40    1    1    1
#>   trt41    0    1    2
#>   trt42    1    1    1
#>   trt43    1    0    2
#>   trt44    2    1    0
#>   trt45    2    1    0
#>   trt46    0    2    1
#>   trt47    2    0    1
#>   trt48    2    1    0

apply(with(eg, table(trt, block)), 2, table)
#>    block
#>     block01 block02 block03 block04 block05 block06 block07 block08 block09
#>   0      44      44      44      44      44      44      44      44      44
#>   1       4       4       4       4       4       4       4       4       4
#>    block
#>     block10 block11 block12 block13 block14 block15 block16 block17 block18
#>   0      44      44      44      44      44      44      44      44      44
#>   1       4       4       4       4       4       4       4       4       4
#>    block
#>     block19 block20 block21 block22 block23 block24 block25 block26 block27
#>   0      44      44      44      44      44      44      44      44      44
#>   1       4       4       4       4       4       4       4       4       4
#>    block
#>     block28 block29 block30 block31 block32 block33 block34 block35 block36
#>   0      44      44      44      44      44      44      44      44      44
#>   1       4       4       4       4       4       4       4       4       4

Created on 2023-11-24 with reprex v2.0.2

emitanaka avatar Nov 24 '23 07:11 emitanaka