对象创建时间戳

Posted 2023-02-24

【中文标题】对象创建时间戳

【英文标题】：Object creation timestamp

【发布时间】：2011-07-16 16:48:58

【问题描述】：

有没有办法检索对象的创建时间？

【问题讨论】：

邮件列表stat.ethz.ch/pipermail/r-help/2007-November/145016.html有类似问题

【参考方案1】：

一般不会，但您可以为自己创建的对象执行此操作

R> df <- data.frame(a=sample(LETTERS[1:5],10,TRUE),b=runif(10))
R> attr(df, "createdAt") <- Sys.time()
R> df
   a         b
1  B 0.8437021
2  D 0.8683446
3  B 0.5194791
4  B 0.0480405
5  B 0.5604978
6  C 0.1938154
7  A 0.1451077
8  D 0.1785405
9  C 0.3937795
10 B 0.2874135
R> str(df)
'data.frame':   10 obs. of  2 variables:
 $ a: Factor w/ 4 levels "A","B","C","D": 2 4 2 2 2 3 1 4 3 2
 $ b: num  0.844 0.868 0.519 0.048 0.56 ...
 - attr(*, "createdAt")= POSIXct, format: "2011-03-16 10:42:10.137434"
R> 

然后您可以自己编写一些使用该属性的自定义print() 或show() 函数。 Frank Harrell 的rms 及其设计前身早就做了类似的事情。

【参考方案2】：

简短回答：没有。

长答案：是的，您需要做的就是在 R 的 C 核心中重写分配代码，以便在每次更改对象时在某处存储日期戳。我尝试过一次，将数据存储在一个属性中，就像这里的其他答案一样，但它具有使相同对象不同的不幸副作用。 x=1 和 y=1 有不同的时间戳，所以 same(x,y) 是 FALSE 并且以极好的方式破坏了 R 的测试。我放弃了。

【讨论】：

您仍然可以在本地（即在给定环境中）执行此操作，只需在 R 中覆盖 <-。

嗯，这看起来很有趣。我想知道是否可以将时间戳存储在不同的对象中，而不是作为对象本身的属性，例如在哈希表中（通过我的新朋友hash）。

【参考方案3】：

关于 Spacedman 的回答和我的评论，请参见以下示例：

x <- 1
print(x)
# [1] 1

`<-` = function(...) 
  eval.parent(replace(match.call(), c(1, 3), list(base::`<-`, structure(..2, ctime=Sys.time()))))


x <- 2
print(x)
# [1] 2
# attr(,"ctime")
# [1] "2011-03-17 11:33:55 EDT"

您可能不想在 .GlobalEnv 中执行此操作，但它在本地化环境中可能很有用。

【讨论】：

谢谢。我自己在这个方向上尝试了一些东西，但没有运气。

【参考方案4】：

我觉得Charles的功能很好，但是会在全球环境中产生问题。

我建议创建一个新的运算符%c% 来代替<-：

`%c%` = function(...) 
  eval.parent(replace(match.call(), c(1, 3), list(base::`<-`, structure(..2, ctime=Sys.time()))))

## object 1 older than object 2?
`%c<%` = function(x1, x2) 
  if (any(names(attributes(x1))=="ctime") && any(names(attributes(x2))=="ctime")) 
    attr(x1, "ctime") < attr(x2, "ctime")
   else 
    NA
  

## object 1 newer than object 2?
`%c>%` = function(x1, x2) 
  if (any(names(attributes(x1))=="ctime") && any(names(attributes(x2))=="ctime")) 
    attr(x1, "ctime") > attr(x2, "ctime")
   else 
    NA
  

其他两个函数可用于比较时间戳。 （使用后面的这些函数，我可以避免耗时的计算，除非某些参数对象发生了变化。）

> xx %c% 1
> xx
[1] 1
attr(,"ctime")
[1] "2017-09-14 17:01:03 EEST"
> xx + 1
[1] 2
attr(,"ctime")
[1] "2017-09-14 17:01:03 EEST"
> class(xx)
[1] "numeric"
> yy %c% 2
> xx+yy
[1] 3
attr(,"ctime")
[1] "2017-09-14 17:01:03 EEST"
> yy
[1] 2
attr(,"ctime")
[1] "2017-09-14 17:04:27 EEST"
> xx %c<% yy
[1] TRUE
> xx %c>% yy
[1] FALSE

【参考方案5】：

您如何看待不更改对象，而是以与保存历史记录相同的方式保存时间戳？ R 将您的控制台历史记录保存到您正在工作的文件夹中的文件.Rhistory（即getwd()）。

我让 R 将时间戳（以 Unix 格式，自 Epoch = Jan 1st 1970 0:00:00 以来的秒数）保存到 .Rtimestamps，但仅在将其设置为选项时：

#' @export
#' @noRd
`<-` = function(...) 
  if (!is.null(getOption("recordTimestamps"))
      & interactive()
      & environmentName(parent.frame()) == "R_GlobalEnv") 
    # only save timestamp when set in options, in interactive mode and in global env.
    if (getOption("recordTimestamps")) 
      write(
        x = paste(
          as.character(match.call())[2],
          as.double(Sys.time()),
          sep = ","),
        file = ".Rtimestamps",
        append = TRUE)
    
  
  eval.parent(
    replace(
      match.call(),
      1,
      list(base::`<-`)))

用法：

options(recordTimestamps = TRUE) # only first time of course
a <- 123
# wait 5 seconds and change it
a <- 456

现在您只需要获取这些日期，您可以使用一些打印有效 POSIXct 类的辅助函数来完成：

#' @export
#' @noRd
ctime <- function(object) 
  target_object <- deparse(substitute(object))
  get_cmtime(target_object, 1)


#' @export
#' @noRd
mtime <- function(object) 
  target_object <- deparse(substitute(object))
  get_cmtime(target_object, 2)


get_cmtime <- function(target_object, mode) 
  if (!is.null(getOption("recordTimestamps")) & interactive()) 
    # only get dates when set in options and when in interactive mode
    if (getOption("recordTimestamps") & file.exists(".Rtimestamps")) 
      lines <- readLines(con <- file(".Rtimestamps"), warn = FALSE, encoding = "UTF-8")
      close(con)
      target_lines <- lines[grepl(paste0("^(", target_object, "),"), lines)]
      if (length(target_lines) > 0) 
        if (mode == 1) 
          # get first value, second element
          timestamp <- unlist(strsplit(target_lines[1], ","))[2]
         else if (mode == 2) 
          # get last value, second element
          timestamp <- unlist(strsplit(target_lines[length(target_lines)], ","))[2]
        
        ## transform to date
        return(as.POSIXct(origin = "1970-01-01", x = as.double(timestamp)))
       else 
        return(NA)
      
    
  

现在它是这样工作的：

> a
[1] 456
> ctime(a)
[1] "2018-02-07 10:43:03 CET"
> mtime(a)
[1] "2018-02-07 10:43:08 CET"