Невозможно использовать dput для data.table в R

У меня есть следующий data.table, для которого я не могу использовать вывод команды dput, чтобы воссоздать его:

> ddt
   Unit Anything index new
1:    A      3.4     1   1
2:    A      6.9     2   1
3:   A1      1.1     1   2
4:   A1      2.2     2   2
5:    B      2.0     1   3
6:    B      3.0     2   3
> 
> 
> str(ddt)
Classes ‘data.table and 'data.frame':  6 obs. of  4 variables:
 $ Unit    : Factor w/ 3 levels "A","A1","B": 1 1 2 2 3 3
 $ Anything: num  3.4 6.9 1.1 2.2 2 3
 $ index   : num  1 2 1 2 1 2
 $ new     : int  1 1 2 2 3 3
 - attr(*, ".internal.selfref")=<externalptr> 
 - attr(*, "sorted")= chr  "Unit" "Anything"
> 
> 
> dput(ddt)
structure(list(Unit = structure(c(1L, 1L, 2L, 2L, 3L, 3L), .Label = c("A", 
"A1", "B"), class = "factor"), Anything = c(3.4, 6.9, 1.1, 2.2, 
2, 3), index = c(1, 2, 1, 2, 1, 2), new = c(1L, 1L, 2L, 2L, 3L, 
3L)), .Names = c("Unit", "Anything", "index", "new"), row.names = c(NA, 
-6L), class = c("data.table", "data.frame"), .internal.selfref = <pointer: 0x8948f68>, sorted = c("Unit", 
"Anything"))
> 

При вставке я получаю следующую ошибку:

> dt = structure(list(Unit = structure(c(1L, 1L, 2L, 2L, 3L, 3L), .Label = c("A", 
+ "A1", "B"), class = "factor"), Anything = c(3.4, 6.9, 1.1, 2.2, 
+ 2, 3), index = c(1, 2, 1, 2, 1, 2), new = c(1L, 1L, 2L, 2L, 3L, 
+ 3L)), .Names = c("Unit", "Anything", "index", "new"), row.names = c(NA, 
+ -6L), class = c("data.table", "data.frame"), .internal.selfref = <pointer: 0x8948f68>, sorted = c("Unit", 
Error: unexpected '<' in:
"3L)), .Names = c("Unit", "Anything", "index", "new"), row.names = c(NA, 
-6L), class = c("data.table", "data.frame"), .internal.selfref = <"
> "Anything"))
Error: unexpected ')' in ""Anything")"

Где проблема и как ее можно исправить? Спасибо за вашу помощь.

Ответ 1

Проблема заключается в том, что dput выводит внешний адрес указателя (это то, что data.table использует внутренне и будет восстанавливать, когда это необходимо), который вы действительно не можете использовать.

Если вы вручную вырезаете часть .internal.selfref, она будет работать нормально, за исключением одноразовой жалобы от data.table для некоторых операций.

Вы можете добавить FR к data.table об этом, но для этого потребуется изменить базовую функцию из data.table, аналогично тому, как обрабатывается rbind.

Ответ 2

Я также нашел это поведение довольно раздражающим. Поэтому я создал свою собственную функцию dput, которая игнорирует атрибут .internal.selfref.

dput <- function (x, file = "", control = c("keepNA", "keepInteger", 
                                    "showAttributes")) 
{
  if (is.character(file)) 
    if (nzchar(file)) {
      file <- file(file, "wt")
      on.exit(close(file))
    }
  else file <- stdout()
  opts <- .deparseOpts(control)
  # adding these three lines for data.tables
  if (is.data.table(x)) {
    setattr(x, '.internal.selfref', NULL)
  }
  if (isS4(x)) {
    clx <- class(x)
    cat("new(\"", clx, "\"\n", file = file, sep = "")
    for (n in .slotNames(clx)) {
      cat("    ,", n, "= ", file = file)
      dput(slot(x, n), file = file, control = control)
    }
    cat(")\n", file = file)
    invisible()
  }
  else .Internal(dput(x, file, opts))
}

Ответ 3

Если у вас уже есть файл dput, и вы не очень любите вручную редактировать до dget, вы можете использовать следующие

data.table.parse<-function (file = "", n = NULL, text = NULL, prompt = "?", keep.source = getOption("keep.source"), 
                            srcfile = NULL, encoding = "unknown") 
{
  keep.source <- isTRUE(keep.source)
  if (!is.null(text)) {
    if (length(text) == 0L) 
      return(expression())
    if (missing(srcfile)) {
      srcfile <- "<text>"
      if (keep.source) 
        srcfile <- srcfilecopy(srcfile, text)
    }
    file <- stdin()
  }
  else {
    if (is.character(file)) {
      if (file == "") {
        file <- stdin()
        if (missing(srcfile)) 
          srcfile <- "<stdin>"
      }
      else {
        filename <- file
        file <- file(filename, "r")
        if (missing(srcfile)) 
          srcfile <- filename
        if (keep.source) {
          text <- readLines(file, warn = FALSE)
          if (!length(text)) 
            text <- ""
          close(file)
          file <- stdin()
          srcfile <- srcfilecopy(filename, text, file.mtime(filename), 
                                 isFile = TRUE)
        }
        else {
          text <- readLines(file, warn = FALSE)
          if (!length(text)) {
            text <- ""
          } else {
            text <- gsub("(, .internal.selfref = <pointer: 0x[0-9A-Fa-f]+>)","",text,perl=TRUE)
          }
          on.exit(close(file))
        }
      }
    }
  }
  #  text <- gsub("(, .internal.selfref = <pointer: 0x[0-9A-F]+>)","",text)
  .Internal(parse(file, n, text, prompt, srcfile, encoding))
}
data.table.get <- function(file, keep.source = FALSE)
  eval(data.table.parse(file = file, keep.source = keep.source))
dtget <- data.table.get

затем измените ваши вызовы dget на dtget. Обратите внимание, что из-за встроенного синтаксического анализа это сделает dtget медленнее, чем dget, поэтому используйте его только в тех случаях, когда вы можете получить объект типа data.table.