简体   繁体   中英

R apply function with matrix and selector

I have an R routine that works with a for loop, and it seems an obvious candidate to convert to "apply", but I can't figure out how to write the appropriate function because it requires rows/columns from two matrices, working with the same index in parallel.

The function takes two matrices of the same size. The second is a rounded and truncated version of the first. It returns a custom version of the minimum and maximum difference between the rounded and unrounded matrices, by row or by column depending on the value of "margin". Cells where the rounded value is truncated are ignored in computing the min/max, so I compute selectors for each function that give me the appropriate values.

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

Although this routine works, and it executes in a reasonable amount of time for the size of matrices I'm using, I'd like to know if it could be made more efficient with "apply". I'd especially like to avoid having to code explicitly for the row/column in the indexed variables. It would be nice to be able to extend this function to an arbitrary number of dimensions, as one can with "apply".

Some test data:

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

If it weren't for the logical stuff at the top, I would say,

apply(diff, margin, range)

but this will do what you want by setting the ones you don't want to Inf:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM