Question

我有一个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，1995-01-24的第二列，1995-01-27的第三栏。

我试过

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

但是这会返回最近出现的1.

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

Answer 1

您可以将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

Answer 2

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仍然是最快的，并且在那个尺度上差异已经上升到第二位。

> 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：已修复，因此需要使用last而不是first。此外，它现在适用于有问题的输出输出而不是数据帧。也简化了。

更新2：添加了第二个解决方案。

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

更新4：增加了第3种方法。

最近出现的价值变化

2 个答案: