R应用矩阵和选择器的功能

时间:2013-12-08 03:02:48

标签: r apply

我有一个使用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

1 个答案:

答案 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)
}