2

RI を使用するときは、「可能であればループの使用を避ける」ことを常に念頭に置いてください。しかし、私は今立ち往生しています。必要なものをコーディングするCRANTASTICの方法を見つけることができませんでした。

記録のために、いくつかのコメントの後、上記の私のステートメントは正しいステートメントではありません。効率を改善するためにここでループを避ける必要はありません。

入力として 2 つの文字列ベクトルを持ってaいbます。"M""I""D"

a = c("M","I","D","D","M","M","M","M","M","M")
b = c("M","M","M","M","M","M","D","M","M")

私の望ましい出力は次のとおりです。

d = c("M","I","D","D","M","M","M","M","I","M","M")

次の関数は、そのような出力を提供します。

my.function <- function(a, b)
{
  nrow.df = length(a) + length(which(b=="D"))
  my.df = data.frame(a = rep(NA, nrow.df),  
                      b = rep(NA, nrow.df), 
                      d = rep(NA, nrow.df))
  my.df$a[1:length(a)] = a
  my.df$b[1:length(b)] = b
  for (i in 1:nrow.df)
  {
    if(my.df$a[i] == "D") {
      my.df$d[i] = "D"
      my.df$b[(i+1):nrow.df] = my.df$b[i:(nrow.df-1)]
    } else if (my.df$b[i] == "D") {
      my.df$d[i] = "I"
      my.df$a[(i+1):nrow.df] = my.df$a[i:(nrow.df-1)]
    } else if (my.df$a[i] == "I") {
      my.df$d[i] = "I"
    } else if (my.df$b[i] == "I") {
      my.df$d[i] = "D"
    } else {
      my.df$d[i] = my.df$a[i]
    }
  }
  return(my.df$d)
}

> d = my.function(a,b)
> d
 [1] "M" "I" "D" "D" "M" "M" "M" "M" "I" "M" "M"

関数のロジックは次のとおりです。 in がある場合は常に"D"inaを入れてベクトルを 1 シフトし、"D"逆に in がある場合は常にinを入れて 1シフトします。 db"D"b"I"da

次に、 in があって"I"inaがない場合は"D"inbを入れ、逆に"I"inがあってinがない場合はinを入れます。そうでなければ、.a"I"b"D"a"D"dd = a

複雑な関数ではありませんが、R を効率的にする方法に苦労しています。私はこの関数を mclapply で何百万回も適用しているので、そのような関数を高速に実装することで多くの時間を節約できます。

Rcppの使用をお勧めしますか? それははるかに速いでしょうか？R と Cpp の何百万回もの通信で速度が低下することはありますか、それとも Rcpp では自動ですか?

4

4 に答える 4

4

ここでループを回避する簡単な方法はありません。ただし、これを行うより効率的な方法はまだあります。問題は、実際にシフトaしbていて、文字に出くわすたびにD、このようなベクトルのシフトはO(n)操作であるため、このループの実行時間は実際にはO(n^2).

次のように、コードを単純化してパフォーマンスをわずかに向上させることができます。

f<-function(a,b){
 aSkipped<-0
 bSkipped<-0
 d<-rep(0,length(a)+sum(b=="D"))

 for(i in 1:length(d)){

    if(a[i-aSkipped] == "D") {
      d[i] = "D"
      bSkipped<-bSkipped+1
    } else if (b[i-bSkipped] == "D") {
      d[i] = "I"
      aSkipped<-aSkipped+1
    } else if (a[i-aSkipped] == "I") {
      d[i] = "I"
    } else if (b[i-bSkipped] == "I") {
      d[i] = "D"
    } else {
      d[i] = a[i-aSkipped]
    }
  }
  d
}

編集中。入力が大きくなると、パフォーマンスが大幅に向上します。文字列が小さく、「D」が多すぎない場合、これと Ananda Mahto のソリューションはほぼ同時に実行されます。

> set.seed(123)
> a<-c(sample(c("M","I"),500,T))
> b<-c(sample(c("M","I"),500,T))
> a[sample(500,50)]<-"D"
> b[sample(500,50)]<-"D"
> microbenchmark(f(a,b),my.function.v(a,b))
Unit: milliseconds
                expr      min       lq   median       uq      max neval
             f(a, b) 4.259970 4.324046 4.368018 4.463925 9.694951   100
 my.function.v(a, b) 4.442873 4.497172 4.533196 4.639543 9.901044   100

しかし、5000 個の "D" を持つ長さ 50000 の文字列の場合、違いはかなり大きくなります。

> set.seed(123)
> a<-c(sample(c("M","I"),50000,T))
> b<-c(sample(c("M","I"),50000,T))
> a[sample(50000,5000)]<-"D"
> b[sample(50000,5000)]<-"D"
> system.time(f(a,b))
   user  system elapsed 
  0.460   0.000   0.463 
> system.time(my.function.v(a,b))
   user  system elapsed 
  7.056   0.008   7.077
于 2013-10-02T18:16:40.443 に答える
4

私のコメントに基づいて、速度が 1 つの懸念事項である場合、ステップ 1 は不必要にdata.frames を使用しないことです。この回答はループに対処していません（他の人がすでに言っているように、適切に行われればRでループを使用しても問題はありません）。

これは、s の代わりにs を使用してデータを格納する、関数のわずかに変更されたバージョンです。vectordata.frame

my.function.v <- function(a, b) {
  nrow.df = length(a) + length(which(b=="D"))
  A <- B <- D <- vector(length = nrow.df)
  A[1:length(a)] = a
  B[1:length(b)] = b
  for (i in 1:nrow.df)
  {
    if(A[i] == "D") {
      D[i] = "D"
      B[(i+1):nrow.df] = B[i:(nrow.df-1)]
    } else if (B[i] == "D") {
      D[i] = "I"
      A[(i+1):nrow.df] = A[i:(nrow.df-1)]
    } else if (A[i] == "I") {
      D[i] = "I"
    } else if (B[i] == "I") {
      D[i] = "D"
    } else {
      D[i] = A[i]
    }
  }
  return(D)
}

以下の速度の相対的な違いに注意してください。

library(microbenchmark)
microbenchmark(my.function(a, b), my.function.v(a, b), f(a, b))
# Unit: microseconds
#                 expr      min        lq    median        uq      max neval
#    my.function(a, b) 1448.416 1490.8780 1511.3435 1547.3880 6674.332   100
#  my.function.v(a, b)  157.248  165.8725  171.6475  179.1865  324.722   100
#              f(a, b)  168.874  177.5455  184.8775  193.3455  416.551   100

ご覧のとおり、@mrip の関数も元の関数よりもはるかに優れています。

于 2013-10-02T18:16:43.990 に答える
1

それがどのように行われるかを示すためだけに、R ではループなしで行うことができます。ここに1つの方法があります。長さがおよそ 1000 以下の場合は高速ですが、それ以上になると遅くなります。要点の 1 つは、Rcpp でこれを高速化できることです。

f2 <- function(a,b) {
  da <- which(a=="D")
  db <- which(b=="D")
  dif <- outer(da, db, `<`) 
  da <- da + rowSums(!dif)
  db <- db + colSums(dif)
  ia <- which(a=="I")  
  ia <- ia + colSums(outer(db, ia, `<`))
  ib <- which(b=="I")
  ib <- ib + colSums(outer(da, ib, `<`))
  out <- rep("M", length(a) + length(db))
  out[da] <- "D"
  out[db] <- "I"
  out[ia] <- "I"
  out[ib] <- "D"
  out
}

データ作成用

ab <- function(N) {
  set.seed(123)
  a<-c(sample(c("M","I"),N,TRUE))
  b<-c(sample(c("M","I"),N,TRUE))
  a[sample(N,N/10)]<-"D"
  b[sample(N,N/10)]<-"D"
  list(a=a,b=b)
}

タイミング:

> library(microbenchmark)
> with(ab(10), microbenchmark(my.function.v(a, b), f(a, b), f2(a,b)))
Unit: microseconds
                expr    min       lq   median       uq     max neval
 my.function.v(a, b) 79.102  86.9005  89.3680  93.2410 279.761   100
             f(a, b) 84.334  91.1055  94.1790  98.2645 215.579   100
            f2(a, b) 94.807 101.5405 105.1625 108.9745 226.149   100

> with(ab(100), microbenchmark(my.function.v(a, b), f(a, b), f2(a,b)))
Unit: microseconds
                expr     min       lq  median       uq      max neval
 my.function.v(a, b) 732.849 750.4480 762.906 845.0835 1953.371   100
             f(a, b) 789.380 805.8905 819.022 902.5865 1921.064   100
            f2(a, b) 124.442 129.1450 134.543 137.5910  237.498   100

> with(ab(1000), microbenchmark(my.function.v(a, b), f(a, b), f2(a,b)))
Unit: milliseconds
                expr       min        lq    median        uq      max neval
 my.function.v(a, b) 10.146865 10.387144 10.695895 11.123164 13.08263   100
             f(a, b)  7.776286  7.973918  8.266882  8.633563  9.98204   100
            f2(a, b)  1.322295  1.355601  1.385302  1.465469  1.85349   100

> with(ab(10000), microbenchmark(my.function.v(a, b), f(a, b), f2(a,b), times=10))
Unit: milliseconds
                expr      min        lq    median        uq       max neval
 my.function.v(a, b) 429.4030 435.00373 439.06706 442.51650 465.00124    10
             f(a, b)  80.7709  83.71715  85.14887  88.02067  89.00047    10
            f2(a, b) 164.7807 170.37608 175.94281 247.78353 251.14653    10
于 2013-10-02T19:25:01.047 に答える