对象创建时间戳

发布于 2024-10-22 17:15:56 字数 22 浏览 3 评论 0原文

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

Is there a way to retrieve the time an object was created at?

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(5

装纯掩盖桑 2024-10-29 17:15:56

通常不会,但您可以对自己创建的对象执行此操作

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 及其设计前身长期以来一直在做类似的事情。

Not generally but you can do it for objects you create yourself via

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> 

and you can then write yourself some custom print() or show() functions that use the attribute. Frank Harrell's rms and its Design predecessor have done something like that for a long time.

苦行僧 2024-10-29 17:15:56

简短回答:否。

详细回答:是的,您所需要做的就是重写 R 的 C 核心中的赋值代码,以便在每次更改对象时在某处存储日期戳。我尝试过一次,将数据存储在一个属性中,就像这里的其他答案一样,但它有一个不幸的副作用,即使相同的对象变得不同。 x=1 和 y=1 具有不同的时间戳,因此 Sametime(x,y) 为 FALSE,这极大地破坏了 R 的测试。我放弃了。

Short answer: No.

Long answer: Yes, all you need to do is rewrite the assignment code in R's C core to store a datestamp somewhere every time an object is changed. I tried this once, storing the data in an attribute much like other answers here, but it had the unfortunate side-effect of making identical objects different. x=1 and y=1 had different timestamps, so identical(x,y) was FALSE and that broke R's tests in magnificent ways. I gave up.

月朦胧 2024-10-29 17:15:56

除了 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 中执行此操作,但它在本地化环境中可能很有用。

Further to Spacedman's answer, and my comment there, see this example:

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"

You probably wouldn't want to do this in .GlobalEnv, but it could be useful within a localized environment.

独自唱情﹋歌 2024-10-29 17:15:56

我认为查尔斯的功能很棒,但它可能会在全球环境中产生问题。

我建议创建一个新的运算符 %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

I think that Charles' function is great, but it can create problems in global environment.

I suggest to create a new operator %c% to be used instead of <-:

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

The other two functions can be used to compare the time stamps. (With these latter functions I can avoid time-consuming calculations unless some argument objects have changed.)

> 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
凝望流年 2024-10-29 17:15:56

您认为不改变对象,而是以与保存历史记录相同的方式保存时间戳怎么样? 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"

What do you think of not altering the objects, but instead save the timestamps the same way as history is being saved? R saves your console history to a file .Rhistory in the folder you're working in (i.e. getwd()).

I let R save timestamps (in Unix format, amount of seconds since Epoch = Jan 1st 1970 0:00:00) to .Rtimestamps, but only when this is set as an option:

#' @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::`<-`)))
}

Usage:

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

Now you only need to get those dates, which you can do with some helper functions that print valid POSIXct classes:

#' @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)
      }
    }
  }
}

And now it works like this:

> a
[1] 456
> ctime(a)
[1] "2018-02-07 10:43:03 CET"
> mtime(a)
[1] "2018-02-07 10:43:08 CET"
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文