在 R 中，根据因子替换矩阵中的值

Question

我正在尝试根据协方差的某些部分是否属于某个因子，将协方差矩阵的某些部分转换为 0。一个简短的例子是一个 4x4 矩阵，它由 x 组成的两个因子组成：x1 和 x2，x3 和 x4。

以下代码生成协方差矩阵。

dataframe <- matrix(c(18, 29, 13, 56, 64, 23, 56, 92, 23, 65, 28, 54, 46, 82, 46, 92), 4, 4)
colnames(dataframe) <- (c("x1", "x2", "x3", "x4"))
rownames(dataframe) <- (c("x1", "x2", "x3", "x4"))
cov.d <- cov(dataframe)
round(cov.d, 2)

     x1      x2      x3     x4
x1 368.67  294.67  252.33 414.00
x2 294.67  806.25 -161.50  80.83
x3 252.33 -161.50  409.67 446.33
x4 414.00   80.83  446.33 577.00

假设 x1 和 x2 是因子 1 的一部分，并且假设 x3 和 x4 是因子 2 的一部分，我希望输出如下所示：

     x1      x2      x3     x4
x1 368.67  294.67    0       0
x2 294.67  806.25    0       0
x3   0       0    409.67 446.33
x4   0       0    446.33 577.00

我认为解决方案与循环和替换功能有关。

到目前为止，我已经尝试了以下参数设置：

num.factors <- 2; vars.per.factor <- 10; num.vars <- 20

for(k in 1:num.factors)
  for(i in 1:vars.per.factor)
    for(j in 1:num.vars) {
      factor.cov <- replace(cov.d, cov.d[i + k * vars.per.factor - vars.per.factor, j + k * vars.per.factor - vars.per.factor], 0)
}

问题在于替换功能。具体来说，cov.d[i, i]。我知道 [i, i] 不是执行我需要它执行的操作所需的代码。但是，我在从这里去哪里画一个空白。我会玩弄它并更新我的进度。

感谢您的帮助！

Answer 1

您可以使用行和列索引来分配0。

m <- matrix(data = c(18, 29, 13, 56, 64, 23, 56, 92, 
                     23, 65, 28, 54, 46, 82, 46, 92),
            nrow = 4, byrow = TRUE)

m[3:4, 1:2] <- 0
m[1:2, 3:4] <- 0
m
#     [,1] [,2] [,3] [,4]
#[1,]   18   29    0    0
#[2,]   64   23    0    0
#[3,]    0    0   28   54
#[4,]    0    0   46   92

Answer 2

这就是我只使用基本 R 的方式。我并没有声称这是最有效的代码——我倾向于编写额外的命令以使其更易于阅读，而且，%in% 会减慢如果你的因素列表很长或者因素本身有很多因素，那么你的表现就会下降——但它可以为一小部分小因素完成工作（它们甚至不必是相同的大小）。

facReplace <- function(m, f) {
  # f is a list of factors, f1, f2, ..., fn
  # They are combined to make an array called x
  # Also make a data-frame copy of the matrix m 
  x <- do.call("c", f)
  m1 <- data.frame(m)
  row.names(m1) <- x
  names(m1) <- x

  # use %in% recursively to set items in m1 that don't share a factor to 0
  for (i in 1:length(f)) {
    for (j in 1:length(x)) {
      for (k in 1:length(x)) {
        tempfac <- do.call("c", f[i])
        temprow <- x[j]
        tempcol <- x[k]
        if (!(temprow %in% tempfac) & (tempcol %in% tempfac)) (m1[j, k] <- 0)
      }
    }
  }
  return(m1)
}

# Test the function with the original example
set.seed(123)
thedata <- matrix(data = runif(16, 0, 10), nrow = 4, ncol = 4)
thedata

         [,1]     [,2]     [,3]     [,4]
[1,] 2.875775 9.404673 5.514350 6.775706
[2,] 7.883051 0.455565 4.566147 5.726334
[3,] 4.089769 5.281055 9.568333 1.029247
[4,] 8.830174 8.924190 4.533342 8.998250

factor1 <- c("x1", "x2")
factor2 <- c("x3", "x4")
theFactors <- list(factor1, factor2)

facReplace(thedata, theFactors)

         x1       x2       x3       x4
x1 2.875775 9.404673 0.000000 0.000000
x2 7.883051 0.455565 0.000000 0.000000
x3 0.000000 0.000000 9.568333 1.029247
x4 0.000000 0.000000 4.533342 8.998250

Answer 3

我感觉以前可能有人问过这个问题，但是通过快速搜索找不到任何问题。

无论如何，以下将做你想要的：

setzero <- function(x) {
x[ ((length(rownames(x))/2) +1) : length(rownames(x)), 1 : (length(rownames(x))/2 )] <- 0
x[ 1:(length(rownames(x))/2) , ((length(rownames(x))/2)+1) : length(rownames(x))] <- 0
return(x)
}

> cov.d <- setzero(cov.d)
> cov.d
     x1       x2       x3       x4
x1 368.6667 294.6667   0.0000   0.0000
x2 294.6667 806.2500   0.0000   0.0000
x3   0.0000   0.0000 409.6667 446.3333
x4   0.0000   0.0000 446.3333 577.0000

这可以作为一个快速的通用函数，正如您所指示的那样。可能有更优雅的解决方案。