2

私は xts オブジェクトを持っています:

df <- structure(c(0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 
  0L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L),
  .Dim = c(10L, 3L), .Dimnames = list(NULL, NULL),
  index = structure(c(790387200, 790473600, 790560000, 790819200, 790905600,
  790992000, 791078400, 791164800, 791424000, 791510400), tzone = "UTC",
  tclass = "Date"), .indexCLASS = "Date", tclass = "Date", .indexTZ = "UTC",
  tzone = "UTC", class = c("xts", "zoo"))
df
#            [,1] [,2] [,3]
# 1995-01-18    0    1    1
# 1995-01-19    0    1    1
# 1995-01-20    1    1    1
# 1995-01-23    1    0    1
# 1995-01-24    1    1    1
# 1995-01-25    0    1    1
# 1995-01-26    0    1    0
# 1995-01-27    0    1    1
# 1995-01-30    0    1    1
# 1995-01-31    0    0    1

1 が に等しくTRUE、0 が に等しいとしFALSEます。これはデータの小さなサブセットにすぎませんが、0 が 1 に変わったときの最新 (最後) の発生を見つけたいと思います。したがって、最初の列では、これは 1995 年 1 月 20 日に発生し、2 番目の列は 1995 年 1 月 24 日に発生しました。 、1995 年 1 月 27 日の第 3 列。

私は試した

max.col(t(df),"last")

しかし、これは 1 の最新のオカレンスを返します。

これを達成するための最良の方法は何ですか？

4

2 に答える 2

3

1)正規表現 各列の要素をまとめて貼り付け、結果の文字列を検索して、最後に出現し01た . 次に、この一致の長さが返されます (つまり、一致には 01 だけでなく、それまでのすべても含まれます)。

f <- function(x) attr(regexpr(".*01", paste(x, collapse = "")), "match.length")
apply(df, 2, f)
[1] 3 5 8

01 が列に表示されない場合、その列に対して -1 が返されることに注意してください。

2) rollapply このソリューションでは、幅 2 の各ローリング セクションを 0:1 と比較し、最後のセクションのインデックスを返します。

tmp <- rbind(1L, coredata(df), 0L)
max.col(t(rollapply(tmp, 2, identical, c(0,1))), "last")
[1] 3 5 8

列に一致がない場合はnrow(df)+1、その列に対して返されます。

3) gtこのソリューションでは、大なり比較 (または最初の項に応じて小なり比較) を使用して、各要素を次の要素と比較します。

> cdf <- coredata(df)
> max.col(cbind(TRUE, t(cdf[-nrow(df),] < cdf[-1,])), "last")
[1] 3 5 8

列が一致しない場合、その列に対して 1 が返されます (一致する場合、これは可能な戻り値ではありません)。

速度比較はこちら。出力は、100 回のレプリケーションの経過時間です。出力は昇順で、100 回のレプリケーションの秒数を表しているため、最速 (gt) が最初になります。

> library(xts)
> library(rbenchmark)
> benchmark(order = "elapsed",
+ gt = { cdf <- coredata(df); max.col(cbind(TRUE, t(cdf[-nrow(df),] < cdf[-1,])), "last") },
+ regexpr = apply(df, 2, f), 
+ rollapply = { tmp <- rbind(1L, coredata(df), 0L)
+ max.col(t(rollapply(tmp, 2, identical, c(0,1))), "last") }, 
+ diff = { df.diff = t(diff(df)[-1])
+ max.col(df.diff, "last") + 1 + (rowSums(df.diff > 0) == 0) },
+ intersect = { n <- nrow(df); cols <- 1:ncol(df)
+ lastdays <- sapply(cols,function(j){max(intersect(which(df[2:n,j]==1),which(df[1:(n-1),j]==0)))+1})
+ data.frame(cols,lastdays) })
       test replications elapsed relative user.self sys.self user.child sys.child
1        gt          100    0.02      1.0      0.02        0         NA        NA
2   regexpr          100    0.05      2.5      0.04        0         NA        NA
4      diff          100    0.09      4.5      0.10        0         NA        NA
5 intersect          100    0.26     13.0      0.27        0         NA        NA
3 rollapply          100    0.84     42.0      0.85        0         NA        NA
>

また、100,000 行を使用して、上記の 3 つの最速のレプリケーションを 10 回試みましたが、その場合でも gt が最速であり、そのスケールでは diff が 2 位に上昇しました。 

> df <- xts(coredata(df)[rep(1:10, each = 10000), ], Sys.Date() + 1:100000)
> dim(df)
[1] 100000      3
> library(rbenchmark)
> benchmark(order = "elapsed", replications = 10,
+   gt = { cdf <- coredata(df); max.col(cbind(TRUE, t(cdf[-nrow(df),] < cdf[-1,])), "last") },
+   regexpr = apply(df, 2, f), 
+ diff = { df.diff = t(diff(df)[-1])
+ max.col(df.diff, "last") + 1 + (rowSums(df.diff > 0) == 0) })
     test replications elapsed relative user.self sys.self user.child sys.child
1      gt           10    0.32    1.000      0.31     0.00         NA        NA
3    diff           10    6.04   18.875      5.91     0.12         NA        NA
2 regexpr           10    8.31   25.969      8.01     0.31         NA        NA

更新 1: 最初ではなく最後になるように修正しました。また、データ フレームではなく、問題の dput 出力で動作するようになりました。また簡略化。

更新 2: 2 番目のソリューションを追加しました。

更新 3: パフォーマンス比較を追加しました (手元のデータに限定)。

更新 4: 3 番目の方法を追加しました。

于 2013-05-15T19:53:03.197 に答える