-
Notifications
You must be signed in to change notification settings - Fork 2
/
weight_design.R
executable file
·62 lines (56 loc) · 2 KB
/
weight_design.R
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
#' Create design matrices with different weights
#'
#' Creates all the possible matrices given a number of blocks and a number of
#' weights. Optionally it can create just a subset of those based on a numeric
#' vector.
#' @param weights A numeric value with the number of weights to be used
#' @param size A numeric value with the number of datasets on the design.
#' @param diff0 A Numeric vector of position which should be different from 0
#' from the `lower.tri()`. See examples
#' @return A list of matrices with the designs with different weights.
#' @export
#' @author Flodel: <https://codereview.stackexchange.com/a/203517/36067>
#' @seealso `subSymm()`
#' @examples
#' out <- weight_design(4, 4)
#' head(out)
#' # Using previously defined matrix
#' C <- diag(4)
#' diag(C) <- 0
#' C <- subSymm(C, 1, 2, 0.456)
#' C <- subSymm(C, 2, 3, runif(1))
#' C <- subSymm(C, 1, 3, runif(1))
#' C <- subSymm(C, 3, 4, runif(1))
#' # Explore matrices which are similar to C
#' d <- weight_design(weights = 11, size = 4, which(lower.tri(C) & C != 0))
#' head(d)
weight_design <- function(weights = 4, size, diff0 = NULL){
p <- size * (size - 1) / 2 # 6
w <- seq(from = 0, to = 1, length.out = weights)
stopifnot(is.numeric(size))
stopifnot(size > 0)
X <- matrix(seq_len(size*size), size, size) # pattern matrix of indices
lt <- lower.tri(X)
if (!is.null(diff0)) {
w <- w[w != 0] # Filter those values that are 0
W <- as.matrix(expand.grid(rep(list(w), length(diff0))))
keep <- diff0 %in% X[lt]
if (!any(keep)) {
stop("Incorrect indices in diff0, it should be the lower.tri")
}
lt <- diff0
} else {
# all possible combinations by doing:
W <- as.matrix(expand.grid(rep(list(w), p)))
}
A <- matrix(0, nrow(W), size * size)
lower.pos <- X[lt]
upper.pos <- t(X)[lt]
# Replace the positions by the weights
A[, lower.pos] <- W
A[, upper.pos] <- W
# A 3D array with the weights
dim(A) <- c(nrow(W), size, size)
# Convert to a list
lapply(seq(nrow(A)), function(i) A[i, , ])
}