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

时间:2015-02-19 02:58:00

标签: r for-loop apply lapply tapply

我在R中使用分类器,该分类器输出一个实数值矩阵,每列我要分类一列。然后我将一个函数应用于输出矩阵和我的类标签矩阵(每个类一列)来计算每个类(列)的错误。

这适用于小型数据集以及类和非类行的相等分布,但是当我使用具有偏差的类与非类的分布的较大文件时会发生故障。通常我的文件包含小于0.3%的类而非99.7%的非类,在这种情况下,我的分类器倾向于简单地输出非类值(0)。

我想尝试不同的错误(成本)功能来尝试平衡这一点。我也会尝试上下采样,但他们还有其他问题。我想尝试的一个可能的简单更改是从类0中分别计算类1的错误,然后以这样的方式组合这些错误,即类错误不会被压倒性的非类错误所掩盖。

我将包含一个最低限度的工作示例来帮助演示我想要的内容。

    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))

另外,我的文件很大,我的分类器模型很大,所以以计算效率的方式这样做会非常有帮助。

我设法使用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])
    }

上面的代码与原始代码的作用不同,只是计算条件均值,但代码流似乎是正确的。

1 个答案:

答案 0 :(得分:0)

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

这里有条件的计算方法:

# 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))