R 最后一次发生的价值变化

我有一个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

---

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

您可以扩展您的

max.col

想法，以包括

diff

：

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

上面假设一个

data.frame

，第一列是日期。对于

xts

对象（日期在行名称中），请执行以下操作：

编辑对问题的更正@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

1） 正则表达式我们将每列的元素粘贴在一起，然后搜索结果字符串，查找上次出现的

01

之前的所有内容。然后返回该匹配的长度（即，该匹配不仅包括01，还包括它之前的所有内容）：

如果一列不匹配，它将为该列返回1（如果存在匹配，则不可能返回值）

这里是一个速度比较。输出是100次复制的运行时间。输出按升序排列，表示100次复制的秒数，因此最快（gt）为第一

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

> 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
> 

>库（xts）
>图书馆（rbenchmark）
>基准测试（order=“经过”，
+gt={cdf基准测试（order=“appeased”，复制次数=10，
+gt={cdf 0）==0}）
测试复制经过相对user.self sys.self user.child sys.child
1燃气轮机10 0.32 1.000 0.31 0.00不适用
3差异10 6.04 18.875 5.91 0.12 NA
2 regexpr 10 8.31 25.969 8.01 0.31 NA

更新1：修正了使用最后一个而不是第一个。另外，它现在可以处理有问题的dput输出，而不是数据帧。也简化了

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

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

---

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

好吧，这样做比每行使用for循环更好……当我尝试这个方法时，我得到了NA。我必须承认我的df是xtsobject@user1234440-请参见编辑，

diff.xts

的工作原理稍有不同-您可以运行这些片段以了解获得

NA

的原因将其应用于数据帧，我将返回wo编号5和8。它应返回三个编号，即按以下顺序返回，3,5，8@user1234440-阅读编辑，这是因为行名称中有日期，我假设这是一列注意，如果列中没有匹配项，则此处的答案返回nrow（df）对于那些无法与列以0:1结尾的情况区分开来的列，只有在可以事先保证每个列都有匹配项的情况下，它才真正起作用，尽管它可以用一些额外的代码来修复。这些方法很有趣，可以用于更有趣的模式，但对于这个特殊的p来说，它们看起来非常缓慢问题rollapply方法速度最慢，但regexpr方法是提供的所有解决方案中最快的，至少在问题中的数据上是这样。尝试将数据放大一点，例如，执行几次，然后再次测试-

regexpr

方法的伸缩性不好（任何时候你要把数字转换成字母来做一个基本的数字运算，这不太可能做得很好）嗯？我不知道你做了什么，但在我的电脑上，Rbind在300行

diff

上迎头赶上，从那里开始，

regexpr

@G.Grothendieck我看到@eddi做了什么（regex增加了80%的时间）将基准测试与

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

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

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

> 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
> 

> 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