Упрощенный dput() в R

Я пропускаю способ добавления данных в ответ SO прозрачным образом. Мой опыт заключается в том, что объект structure из dput() иногда смущает неопытных пользователей. Тем не менее, я не испытываю терпения, чтобы копировать/вставлять его в простой фрейм данных каждый раз и хотел бы его автоматизировать. Что-то похожее на dput(), но в упрощенной версии.

Скажем, я копированием/вставкой, а некоторые другие имеют такие данные,

Df <- data.frame(A = c(2, 2, 2, 6, 7, 8),
                 B = c("A", "G", "N", NA, "L", "L"),
                 C = c(1L, 3L, 5L, NA, NA, NA))

выглядит так,

Df
#>   A    B  C
#> 1 2    A  1
#> 2 2    G  3
#> 3 2    N  5
#> 4 6 <NA> NA
#> 5 7    L NA
#> 6 8    L NA

Внутри одного целого, одного фактора и одного числового вектора,

str(Df)
#> 'data.frame':    6 obs. of  3 variables:
#>  $ A: num  2 2 2 6 7 8
#>  $ B: Factor w/ 4 levels "A","G","L","N": 1 2 4 NA 3 3
#>  $ C: int  1 3 5 NA NA NA

Теперь я хотел бы поделиться этим с SO, но у меня не всегда есть исходный кадр данных, из которого он пришел. Чаще всего я pipe() это в форме SO, и единственный способ узнать это - dput(). Подобно,

dput(Df)
#> structure(list(A = c(2, 2, 2, 6, 7, 8), B = structure(c(1L, 2L, 
#> 4L, NA, 3L, 3L), .Label = c("A", "G", "L", "N"), class = "factor"), 
#> C = c(1L, 3L, 5L, NA, NA, NA)), .Names = c("A", "B", "C"), row.names = c(NA, 
#> -6L), class = "data.frame")

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

dput_small(Df)
#> data.frame(A = c(2, 2, 2, 6, 7, 8), B = c("A", "G", "N", NA, "L", "L"),
#> C = c(1L, 3L, 5L, NA, NA, NA))

Это возможно? Я понимаю там другие классы, такие как lists, tbl, tbl_df и т.д.

ОТВЕТЫ

Ответ 1

3 решения:

  • обертка вокруг dput (обрабатывает стандартные data.frames, tibbles и lists)

  • решение read.table (для data.frames)

  • решение для tibble::tribble (для данных. data.frames, возвращающие tibble)

Все они включают n и random параметр, которые позволяют управлять потоком только главы данных или образца.

dput_small1(Df)
# Df <- data.frame(
#   A = c(2, 2, 2, 6, 7, 8),
#   B = structure(c(1L, 2L, 4L, NA, 3L, 3L), .Label = c("A", "G", "L", 
#     "N"), class = "factor"),
#   C = c(1L, 3L, 5L, NA, NA, NA) ,
#   stringsAsFactors=FALSE)

dput_small2(Df,stringsAsFactors=TRUE)
# Df <- read.table(sep="\t", text="
#   A   B   C
#   2   A    1
#   2   G    3
#   2   N    5
#   6   NA  NA
#   7   L   NA
#   8   L   NA", header=TRUE, stringsAsFactors=TRUE)

dput_small3(Df)
# Df <- tibble::tribble(
#   ~A, ~B, ~C,
#   2,           "A",          1L,
#   2,           "G",          3L,
#   2,           "N",          5L,
#   6, NA_character_, NA_integer_,
#   7,           "L", NA_integer_,
#   8,           "L", NA_integer_
# )
# Df$B <- factor(Df$B)

Обертка вокруг dput

Этот параметр дает результат, очень близкий к заданному в вопросе. Это довольно общее, потому что оно фактически обернуто вокруг dput, но применяется отдельно по столбцам.

multiline означает "сохранить вывод dput по умолчанию, выложенный на несколько строк".

dput_small1<- function(x,
                       name=as.character(substitute(x)),
                       multiline = TRUE,
                       n=if ('list' %in% class(x)) length(x) else nrow(x),
                       random=FALSE,
                       seed = 1){
  name
  if('tbl_df' %in% class(x)) create_fun <- "tibble::tibble" else
    if('list' %in% class(x)) create_fun <- "list" else
      if('data.table' %in% class(x)) create_fun <- "data.table::data.table" else
        create_fun <- "data.frame"

    if(random) {
      set.seed(seed)
      if(create_fun == "list") x <- x[sample(1:length(x),n)] else 
        x <- x[sample(1:nrow(x),n),]
    } else {
      x <- head(x,n)
    }

    line_sep <- if (multiline) "\n    " else ""
    cat(sep='',name," <- ",create_fun,"(\n  ",
        paste0(unlist(
          Map(function(item,nm) paste0(nm,if(nm=="") "" else " = ",paste(capture.output(dput(item)),collapse=line_sep)),
              x,if(is.null(names(x))) rep("",length(x)) else names(x))),
          collapse=",\n  "),
        if(create_fun == "data.frame") ",\n  stringsAsFactors = FALSE)" else "\n)")
}

dput_small1(list(1,2,c=3,d=4),"my_list",random=TRUE,n=3)
# my_list <- list(
#   2,
#   d = 4,
#   c = 3
# )

Решение read.table

Для data.frames я считаю удобным, однако, иметь ввод в более явном/табличном формате.

Это можно сделать, используя read.table, а затем автоматически переформатирует тип столбцов, которые read.table не получится. Не так общее, как первое решение, но будет работать гладко для 95% случаев, обнаруженных на SO.

dput_small2 <- function(df,
                        name=as.character(substitute(df)),
                        sep='\t',
                        header=TRUE,
                        stringsAsFactors = FALSE,
                        n= nrow(df),
                        random=FALSE,
                        seed = 1){
    name
    if(random) {
      set.seed(seed)
      df <- df[sample(1:nrow(df),n),]
    } else {
      df <- head(df,n)
    }
  cat(sep='',name,' <- read.table(sep="',sub('\t','\\\\t',sep),'", text="\n  ',
      paste(colnames(df),collapse=sep))
  df <- head(df,n)
  apply(df,1,function(x) cat(sep='','\n  ',paste(x,collapse=sep)))
  cat(sep='','", header=',header,', stringsAsFactors=',stringsAsFactors,')')

  sapply(names(df), function(x){
    if(is.character(df[[x]]) & suppressWarnings(identical(as.character(as.numeric(df[[x]])),df[[x]]))){ # if it a character column containing numbers
      cat(sep='','\n',name,'$',x,' <- as.character(', name,'$',x,')')
    } else if(is.factor(df[[x]]) & !stringsAsFactors) { # if it a factor and conversion is not automated
      cat(sep='','\n',name,'$',x,' <- factor(', name,'$',x,')')
    } else if(inherits(df[[x]], "POSIXct")){
      cat(sep='','\n',name,'$',x,' <- as.POSIXct(', name,'$',x,')')
    } else if(inherits(df[[x]], "Date")){
      cat(sep='','\n',name,'$',x,' <- as.Date(', name,'$',x,')')
    }})
  invisible(NULL)
}

Простейший случай

dput_small2(iris,n=6)

будет печатать:

iris <- read.table(sep="\t", text="
  Sepal.Length  Sepal.Width Petal.Length    Petal.Width Species
  5.1   3.5 1.4 0.2  setosa
  4.9   3.0 1.4 0.2  setosa
  4.7   3.2 1.3 0.2  setosa
  4.6   3.1 1.5 0.2  setosa
  5.0   3.6 1.4 0.2  setosa
  5.4   3.9 1.7 0.4  setosa", header=TRUE, stringsAsFactors=FALSE)

который, в свою очередь, когда будет выполнен, вернется:

#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1          5.1         3.5          1.4         0.2  setosa
# 2          4.9         3.0          1.4         0.2  setosa
# 3          4.7         3.2          1.3         0.2  setosa
# 4          4.6         3.1          1.5         0.2  setosa
# 5          5.0         3.6          1.4         0.2  setosa
# 6          5.4         3.9          1.7         0.4  setosa

str(iris)
# 'data.frame': 6 obs. of  5 variables:
# $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4
# $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9
# $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7
# $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4
# $ Species     : chr  " setosa" " setosa" " setosa" " setosa" ...

более сложный

фиктивные данные:

test <- data.frame(a=1:5,
                   b=as.character(6:10),
                   c=letters[1:5],
                   d=factor(letters[6:10]),
                   e=Sys.time()+(1:5),
                   stringsAsFactors = FALSE)

Эта:

dput_small2(test,'df2')

будет печатать:

df2 <- read.table(sep="\t", text="
  a b   c   d   e
  1 6   a   f   2018-02-15 11:53:17
  2 7   b   g   2018-02-15 11:53:18
  3 8   c   h   2018-02-15 11:53:19
  4 9   d   i   2018-02-15 11:53:20
  5 10  e   j   2018-02-15 11:53:21", header=TRUE, stringsAsFactors=FALSE)
df2$b <- as.character(df2$b)
df2$d <- factor(df2$d)
df2$e <- as.POSIXct(df2$e)

который, в свою очередь, когда будет выполнен, вернется:

#   a  b c d                   e
# 1 1  6 a f 2018-02-15 11:53:17
# 2 2  7 b g 2018-02-15 11:53:18
# 3 3  8 c h 2018-02-15 11:53:19
# 4 4  9 d i 2018-02-15 11:53:20
# 5 5 10 e j 2018-02-15 11:53:21

str(df2)    
# 'data.frame': 5 obs. of  5 variables:
# $ a: int  1 2 3 4 5
# $ b: chr  "6" "7" "8" "9" ...
# $ c: chr  "a" "b" "c" "d" ...
# $ d: Factor w/ 5 levels "f","g","h","i",..: 1 2 3 4 5
# $ e: POSIXct, format: "2018-02-15 11:53:17" "2018-02-15 11:53:18" "2018-02-15 11:53:19" "2018-02-15 11:53:20" ...

all.equal(df2,test)
# [1] "Component "e": Mean absolute difference: 0.4574251" # only some rounding error

решение tribble

Опция read.table очень read.table но не очень общая. с tribble почти любой тип данных может быть обработан (хотя факторы нуждаются в фиксации adhoc).

Это решение не так полезно для примера OP, но отлично подходит для столбцов списка (см. Пример ниже). Для того, чтобы использовать выход, библиотека tibble требуется.

Так же, как мое первое решение, это оболочка вокруг dput, но вместо столбцов "dputting" я использую элементы "dputting".

dput_small3 <- function(df,
                        name=as.character(substitute(df)),
                        n= nrow(df),
                        random=FALSE,
                        seed = 1){
  name
  if(random) {
    set.seed(seed)
    df <- df[sample(1:nrow(df),n),]
  } else {
    df <- head(df,n)
  }
  df1 <- lapply(df,function(col) if(is.factor(col)) as.character(col) else col)
  dputs   <- sapply(df1,function(col){
    col_dputs <- sapply(col,function(elt) paste(capture.output(dput(elt)),collapse=""))
    max_char <- max(nchar(unlist(col_dputs)))
    sapply(col_dputs,function(elt) paste(c(rep(" ",max_char-nchar(elt)),elt),collapse=""))
  })
  lines   <- paste(apply(dputs,1,paste,collapse=", "),collapse=",\n  ")
  output  <- paste0(name," <- tibble::tribble(\n  ",
                    paste0("~",names(df),collapse=", "),
                    ",\n  ",lines,"\n)")
  cat(output)
  sapply(names(df), function(x) if(is.factor(df[[x]])) cat(sep='','\n',name,'$',x,' <- factor(', name,'$',x,')'))
  invisible(NULL)
}

dput_small3(dplyr::starwars[c(1:3,11)],"sw",n=6,random=TRUE)
# sw <- tibble::tribble(
#   ~name, ~height, ~mass, ~films,
#   "Lando Calrissian", 177L,       79,                     c("Return of the Jedi", "The Empire Strikes Back"),
#      "Finis Valorum", 170L, NA_real_,                                                   "The Phantom Menace",
#       "Ki-Adi-Mundi", 198L,       82, c("Attack of the Clones", "The Phantom Menace", "Revenge of the Sith"),
#           "Grievous", 216L,      159,                                                  "Revenge of the Sith",
#     "Wedge Antilles", 170L,       77,       c("Return of the Jedi", "The Empire Strikes Back", "A New Hope"),
#         "Wat Tambor", 193L,       48,                                                 "Attack of the Clones"
# )

Ответ 2

Вы можете просто написать сжатое соединение.

gz <- gzfile("foo.gz", open="wt")
dput(Df, gz)
close(gz)

Ответ 3

Мы могли бы установить управление NULL для упрощения:

dput(Df, control = NULL)
# list(A = c(2, 2, 2, 6, 7, 8), B = c(NA, NA, NA, NA, 7, 9), C = c(1, 3, 5, NA, NA, NA))

Затем заверните его в data.frame:

data.frame(dput(Df, control = NULL))

Изменить: Чтобы избежать преобразования столбцов факторов в числа, мы могли бы преобразовать их в символ перед вызовом dput:

dput_small <- function(d){
  ix <- sapply(d, is.factor)
  d[ix] <- lapply(d[ix], as.character)
  dput(d, control = NULL)
  }

Ответ 4

Пакет datapasta не всегда будет работать отлично, поскольку в настоящее время он не поддерживает все типы, но он чист и прост,

# install.packages(c("datapasta"), dependencies = TRUE)    
datapasta::dpasta(Df)
#> data.frame(
#>            A = c(2, 2, 2, 6, 7, 8),
#>            C = c(1L, 3L, 5L, NA, NA, NA),
#>            B = as.factor(c("A", "G", "N", NA, "L", "L"))
#> )

Ответ 5

Как правило, с большой dput сложно справиться, на SO или иначе. Вместо этого вы можете просто сохранить структуру непосредственно в файле Rda:

save(Df, file='foo.Rda')

И прочитал это еще раз:

load('foo.Rda')

См. Этот вопрос для получения дополнительной информации и кредита, в котором должен быть предоставлен кредит: как сохранить файл data.frame в R?

Вы также можете посмотреть на функцию sink...

Если я пропустил цель вашего вопроса, пожалуйста, не стесняйтесь раскрывать причины, по которым dput - единственный механизм для вас.

Ответ 6

Здесь можно упомянуть memCompress и memDecompress. Для объектов in-memory он может уменьшить размер больших объектов, сжимая их, как указано. И последнее меняет сжатие. Они действительно полезны для объектов пакета.

sum(nchar(dput(DF)))
# [1] 64
( mDF <- memCompress(as.character(DF)) )
# [1] 78 9c 4b d6 30 d2 51 80 20 33 1d 05 73 1d 05 0b 4d ae 64 0d 3f 47 1d 05 64 0c 14 b7 04 89 1b ea 28 18 eb 28 98 22 4b 6a 02 00 a8 ba 0c d2
length(mDF)
# [1] 46
cat(mdDF <- memDecompress(mDF, "gzip", TRUE))
# c(2, 2, 2, 6, 7, 8)
# c(NA, NA, NA, NA, 7, 9)
# c(1, 3, 5, NA, NA, NA)
nchar(mdDF)
# [1] 66

Я не совсем понял, можно ли легко собрать набор данных, но я уверен, что это возможно.