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

Question

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

Say I путем копирования/вставки и некоторые другие шлюшка имеют такие данные,

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 

Теперь я хотел бы поделиться этим с этим, но у меня не всегда есть orgin al данные фрейм из этого. Чаще всего я 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 s могут выглядеть довольно запутанными. По этой причине я ищу способ сжать 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 и т.д.

Answer 1

3 решения:

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

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

• tibble::tribble раствор (для data.frames, возвращая tibble)

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

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's a character column containing numbers 
     cat(sep='','\n',name,'$',x,' <- as.character(', name,'$',x,')') 
    } else if(is.factor(df[[x]]) & !stringsAsFactors) { # if it's 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 очень читаемый, но не очень вообще. с 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" 
#) 

Answer 2

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

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

И читать его обратно в:

load('foo.Rda') 

Смотрите этот вопрос для немного больше информации и кредит, где кредит должен: How to save a data.frame in R?

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

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

Answer 3

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

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

Answer 4

Может быть, стоит упомянуть 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 

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

Answer 5

Мы могли бы установить управления к 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)) 

---

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

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

Answer 6

Пакет 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")) 
#>)