基于另一个矩阵计算矩阵子集每列的平均值（或其他函数）

Question

我在 R 中使用 classifier 输出一个实数值矩阵，我正在 class 化的每个 class 都有一列。然后，我将一个函数应用于输出矩阵和我的 class 标签矩阵（每个 class 一列）以计算每个 class（列）的误差。

这适用于小型数据集以及 class 和非 class 行的均等分布，但当我使用更大的文件且 class 与非 - class。通常我的文件包含少于 0.3% class 而 99.7% 是非 class 并且在这种情况下我的 classifier 倾向于简单地输出非 class 值 (0) .

我想尝试不同的错误（成本）函数来尝试平衡这一点。我也会尝试向上和向下采样，但他们还有其他问题。我想尝试的一个可能的简单更改是分别计算 class 1 和 class 0 的误差，然后以不隐藏 class 误差的方式组合这些误差由压倒性的非 class 错误。

我提供了一个最低限度的工作示例来帮助演示我想要什么。

    L1 <- runif(13, min=0, max=1)
    L2 <- runif(13, min=0, max=1)
    predy <- cbind(L1, L2) # simulated output from the classifier
    #predy
    L1 <- c(0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0)
    L2 <- c(0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0)
    classy <- cbind(L1, L2) # Simulated class matrix
    #classy
    # Now compute error showing existing method
    mse <- apply((predy - classy)^2, 2, mean)
    nrmse <- sqrt(mse / apply(classy, 2, var))
    #
    #nrmse
    # L1       L2
    # 1.343796 1.062442
    #
    # Sort-of-code for what I would like to have
    # mse0 <- apply((predy - classy)^2, 2, mean) where x=0
    # mse1 <- apply((predy - classy)^2, 2, mean) where x=1
    # mse <- (mse0 + mse1) / 2   # or some similar way of combining them of my choice
    # nrmse <- sqrt(mse / apply(classy, 2, var))

此外，我的文件很大，我的 classifier 模型也很大，因此以计算效率高的方式执行此操作会非常有帮助。

我设法使用 for 循环（如下）做到了这一点，有人可以帮助翻译它以应用吗？

    mean.ones  <- matrix(0, dim(classy)[2])
    mean.zeros <- matrix(0, dim(classy)[2])
    for (ix in 1:dim(classy)[2]) {
        ix.ones <- classy[, ix]==1
        mean.ones[ix]  <- mean(predy[ix.ones, ix])
        mean.zeros[ix] <- mean(predy[!ix.ones, ix])
    }

上面的代码与原来的代码不一样，它只是计算条件均值，但代码流程似乎是正确的。

Answer 1

这是一个利用 (1) 词法范围的解决方案您不必将矩阵传递给传递给第一个 lapply() 的汇总函数，并且 (2) predy 和 classy 具有相同的维度。

条件均值的计算如下：

# calculation of means
temp <- lapply(seq.int(ncol(predy)),
               function(i)tapply(predy[,i],
                                 classy[,i],
                                 mean))
# presumably each column has members of both classes,
# but if not, we'll assure that there are two members 
# two each element of the list 'temp', as follows:
temp <- lapply(temp,
               function(x)x[match(0:1,names(x))])

# bind the outputs togeather by column.
mean_mx = do.call(cbind,temp)
all(mean_mx[1,]==mean.zeros)
all(mean_mx[2,]==mean.ones)

这里是均方误差的计算：

# calculation of MSE
temp <- lapply(seq.int(ncol(predy)),
               function(i)tapply((predy[,i] - classy[,i])^2,
                                 classy[,i],
                                 mean))
# presumably each column has members of both classes,
# but if not, we'll assure that there are two members 
# two each element of the list 'temp', as follows:
temp <- lapply(temp,
               function(x)x[match(0:1,names(x))])

# bind the outputs togeather by column.
mse_mx = do.call(cbind,temp)

mse0 <- mse_mx[1,]
mse1 <- mse_mx[2,]
mse <- (mse0 + mse1) / 2 

nrmse <- sqrt(mse / apply(classy, 2, var))

基于另一个矩阵计算矩阵子集每列的平均值（或其他函数）

calculate mean (or other function) per column for subsets of a matrix based on another matrix

r

for-loop

apply

lapply

tapply