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 等于TRUE0 等于FALSE。虽然这只是一小部分数据，但我想找到 0 变为 1 时的最新（最后一次）出现。所以对于第一列，这发生在 1995-1-20，第二列在 1995-01-24 ，以及 1995 年 1 月 27 日的第三栏。

我试过了

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

但这会返回最近出现的 1。

实现这一目标的最佳方法是什么？

4

2 回答 2

3

您可以扩展您的max.col想法以包括diff：

max.col(t(sapply(df[,-1], diff)), "last") + 1

以上假设data.frame第一列是日期。对于一个xts对象（在行名称中包含日期），请执行以下操作：

max.col(t(diff(df)[-1]), "last") + 1

编辑更正@G.Grothendieck 指出的问题：

df.diff = t(diff(df)[-1])
max.col(df.diff, "last") + 1 + (rowSums(df.diff > 0) == 0)
# or put an ifelse instead and assign NA or 0 or whatever you like
于 2013-05-15T19:17:57.097 回答
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 行从上面尝试了 10 次最快的三个复制，在这种情况下， gt 仍然是最快的，并且在该比例下，diff 已经上升到第二位。 

> 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：添加了第二个解决方案。

更新 3：添加了性能比较（仅限于手头的数据）。

更新 4：添加了第三种方法。

于 2013-05-15T19:53:03.197 回答