-2

3 つの入力ベクトル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

4

1 に答える 1

0

これは機能します：

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
于 2013-06-21T04:52:22.947 に答える