我有一个使用for循环的R例程,它似乎是转换为“apply”的明显候选者,但我无法弄清楚如何编写适当的函数,因为它需要来自两个矩阵的行/列,并行使用相同的索引。
该函数采用两个相同大小的矩阵。第二个是第一个的圆形和截断版本。它返回最小和最大差异的自定义版本 圆形和非圆形矩阵之间,按行或按列取决于值 “保证金”。在计算最小值/最大值时忽略舍入舍入值的单元格,因此我为每个函数计算选择器,为我提供适当的值。
diff.minmax <- function(unrounded, rounded, margin, min.threshold=0, max.threshold=100, rounding=0) {
diff <- rounded - unrounded
min.sel <- rounded < max.threshold | (unrounded >= max.threshold & round(unrounded,rounding) < max.threshold)
max.sel <- rounded > min.threshold | (unrounded <= min.threshold & round(unrounded,rounding) > min.threshold)
len <- dim(diff)[margin]
mm <- matrix(0, nrow=len, ncol=2)
for (i in 1:len) {
if (margin == 1) {
# min/max values by row
mm[i,1] <- min(diff[i,min.sel[i,]])
mm[i,2] <- max(diff[i,max.sel[i,]])
}
else {
# min/max values by column
mm[i,1] <- min(diff[min.sel[,i],i])
mm[i,2] <- max(diff[max.sel[,i],i])
}
}
return(mm)
}
虽然这个例程有效,并且它在我正在使用的矩阵大小的合理时间内执行,但我想知道是否可以通过“apply”使其更高效。我特别希望避免为索引变量中的行/列显式编写代码。能够将此函数扩展到任意数量的维度是很好的,因为可以使用“apply”。
一些测试数据:
U <- matrix(c(-0.825, -0.031, 1.398, 3.148, 4.604,
0.662, 1.457, 2.886, 4.636, 6.091,
2.487, 3.281, 4.710, 6.460, 7.916,
4.513, 5.308, 6.737, 8.487, 9.942,
6.758, 7.553, 8.982, 10.732, 12.187), nrow=5)
R <- matrix(c(0, 0, 1, 3, 5, 1, 1, 3, 5, 6, 2, 3, 5, 6, 8,
5, 5, 7, 8, 10, 7, 8, 9, 11, 12), nrow=5)
diff.minmax(U, R, 1)
[,1] [,2]
[1,] -0.487 0.487
[2,] -0.457 0.447
[3,] -0.398 0.290
[4,] -0.487 0.364
[5,] -0.187 0.396
diff.minmax(U, R, 2)
[,1] [,2]
[1,] -0.398 0.396
[2,] -0.457 0.364
[3,] -0.487 0.290
[4,] -0.487 0.487
[5,] -0.187 0.447
答案 0 :(得分:3)
如果不是顶部的逻辑内容,我会说,
apply(diff, margin, range)
但这可以通过设置你不想要的那些来做你想做的事情:
function(unrounded, rounded, margin, min.threshold=0, max.threshold=100, rounding=0) {
diff <- rounded - unrounded
min.sel <- rounded < max.threshold | (unrounded >= max.threshold & round(unrounded,rounding) < max.threshold)
max.sel <- rounded > min.threshold | (unrounded <= min.threshold & round(unrounded,rounding) > min.threshold)
len <- dim(diff)[margin]
mm <- matrix(0, nrow=len, ncol=2)
mm[,1] <- apply( diff + ifelse(min.sel, 0, Inf), margin, min)
mm[,2] <- apply( diff + ifelse(max.sel, 0, -Inf), margin, max)
return(mm)
}