Question

给定三个输入向量v，a，m以及以下函数：

f1 <- function(v, m, a) {
   o = outer(m, v, ">")
   rowSums(t(t(o) * a ))
}

我试图更有效地重写。这是我的尝试：

f2 <- function(v, m, a) {
   vm=c(m, v)
   index = c(rep(0, length(m)), rep(1, length(v)))
   index1 = index[order(vm)]
   cumsum1 = cumsum(index1)
   r = cumsum1[index1 == 0]
   cumsum.a = cumsum(a)
   cumsum.a[r]
}

两个函数对以下输入给出相同的结果：

     v = c(0, 0.11, 0.17, 0.31, 0.63)
     a = c(11.41, 9.40, 7.11, 2.80, 0.27)
     m = c(0.03, 0.097, 0.14, 0.19, 0.26, 0.31, 0.46, 0.63, 1.13)
     f1(v, m, a)
     # [1] 11.41 11.41 20.81 27.92 27.92 27.92 30.72 30.72 30.99
     f2(v, m, a)
     # [1] 11.41 11.41 20.81 27.92 27.92 27.92 30.72 30.72 30.99

但不适用于：

     w = c(0.07, 0.21, 0.30, 0.62, 1.63)

     f1(w, m, a)
     # [1]  0.00 11.41 11.41 11.41 20.81 27.92 27.92 30.72 30.72
     f2(w, m, a)
     # [1] 11.41 11.41 11.41 20.81 27.92 27.92 30.72 30.72

您可以帮助我修复f2，以便为两组输入提供与f1相同的结果吗？

Answer 1

这有效：

f1 <- function(w, m, a) {
  o <- outer(m, w, ">")
  rowSums(t(t(o) * a ))
}

f2 <- function(w, m, a) {
  wm <- c(m, w)
  index <- c(rep(0, length(m)), rep(1, length(w)))
  index2 <- index[order(wm)]
  cumsum2 <- cumsum(index2)
  r1 <- cumsum2[index2 == 0]
  cumsum(c(0, a))[r1 + 1]
}

v <- c(0, 0.11, 0.17, 0.31, 0.63)
w <- c(0.07, 0.21, 0.30, 0.62, 1.63)
a <- c(11.41, 9.40, 7.11, 2.80, 0.27)
m <- c(0.03, 0.097, 0.14, 0.19, 0.26, 0.31, 0.46, 0.63, 1.13)

identical(f1(v, m, a), f2(v, m, a))
# [1] TRUE
identical(f1(w, m, a), f2(w, m, a))
# [1] TRUE

替换R中的outer和rowSums

1 个答案: