【问题标题】:Object creation timestamp对象创建时间戳
【发布时间】:2011-07-16 16:48:58
【问题描述】:

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

【问题讨论】:

标签: r object timestamp


【解决方案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 中覆盖 &lt;-
    • 嗯,这看起来很有趣。我想知道是否可以将时间戳存储在不同的对象中,而不是作为对象本身的属性,例如在哈希表中(通过我的新朋友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% 来代替&lt;-

    `%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"
      

      【讨论】:

        猜你喜欢
        • 2014-03-03
        • 1970-01-01
        • 2011-11-12
        • 2018-12-29
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2017-01-18
        相关资源
        最近更新 更多