r - shinythemes - tags$div shiny

Dput simplificado() en R

Question

Extraño una forma de agregar datos a una respuesta de SO de manera transparente. Mi experiencia es que el objeto de structure de dput() a veces confunde a los usuarios inexpertos innecesarios. Sin embargo, no tengo la paciencia de copiarlo / pegarlo en un marco de datos simple cada vez y me gustaría automatizarlo. Algo similar a dput() , pero en una versión simplificada.

Digo que por copiar / pegar y algunos otros hos tienen datos como este,

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))

Se ve como esto,

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

Dentro de un entero, un factor y un vector numérico,

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

Ahora, me gustaría compartir esto en SO, pero no siempre tengo el marco de datos original del que proviene. En la mayoría de los casos, dput() en forma SO y la única forma que conozco para sacarlo es dput() . Me gusta,

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")

pero, como dije en la parte superior, estas structure pueden parecer bastante confusas. Por esa razón, estoy buscando una manera de comprimir la dput() de alguna manera. Me imagino una salida que se parece a esto,

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))

¿Es eso posible? Me doy cuenta de que hay otras clases, como lists , tbl , tbl_df , etc.

Answer 1

3 soluciones:

• una envoltura alrededor de dput (maneja data.frames , tibbles y lists estándar)

• read.table solución de data.frames de data.frames (para data.frames )

• una solución tibble::tribble (para data.frames , devolver un tibble )

Todos incluyen n y random parámetro random que le permite a uno colocar solo el encabezado de los datos o muestrearlos sobre la marcha.

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)

Envoltura alrededor de la dput

Esta opción que da una salida muy cercana a la propuesta en la pregunta. Es bastante general porque en realidad está envuelto alrededor de la dput , pero se aplica por separado en las columnas.

multiline significa ''mantener la salida por defecto de dput distribuida en múltiples líneas'' .

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
# )

solución de read.table

Para data.frames me parece cómodo tener la entrada en un formato más explícito / tabular.

Se puede alcanzar esto utilizando read.table , y luego reformateando automáticamente el tipo de columnas que read.table no saldría bien. No es tan general como la primera solución, pero funcionará sin problemas en el 95% de los casos encontrados en 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)
}

Caso mas simple

dput_small2(iris,n=6)

imprimirá:

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)

que a su vez, cuando se ejecute, volverá:

# 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" ...

mas complejo

datos ficticios:

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)

Esta:

dput_small2(test,''df2'')

imprimirá:

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)

que a su vez, cuando se ejecute, volverá:

# 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

solución tribble

La opción read.table es muy legible pero no muy general. Con tribble se puede manejar prácticamente cualquier tipo de datos (aunque los factores necesitan una solución ad hoc).

Esta solución no es tan útil para el ejemplo de OP, pero es excelente para las columnas de la lista (vea el ejemplo a continuación). Para hacer uso de la salida, se requiere biblioteca tibble .

Al igual que mi primera solución, es una envoltura alrededor de dput , pero en lugar de "dputting" columnas, estoy "dputting" elementos.

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

El paquete datapasta no siempre funcionará perfectamente ya que actualmente no admite todos los tipos, pero es limpio y fácil, es decir,

# 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"))
#> )

Answer 3

En general, es difícil lidiar con una gran dput , en SO o de otra manera. En su lugar, simplemente puede guardar la estructura directamente en un archivo Rda :

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

Y leerlo de nuevo en:

load(''foo.Rda'')

Vea esta pregunta para obtener un poco más de información y crédito donde se debe el crédito: ¿Cómo guardar un data.frame en R?

También puedes mirar la función de sink ...

Si me he perdido el propósito de su pregunta, siéntase libre de ampliar las razones por las cuales el dput es el único mecanismo para usted.

Answer 4

Podría valer la pena mencionar memCompress y memDecompress aquí. Para los objetos en memoria, puede reducir el tamaño de los objetos grandes al comprimirlos como se especifica. Y este último invierte la compresión. En realidad son bastante útiles para empaquetar objetos.

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

No he determinado del todo si el marco de datos se puede volver a montar fácilmente, pero estoy seguro de que puede serlo.

Answer 5

Podríamos poner el control a NULL para simplificar:

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))

Luego envuélvalo con data.frame :

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

Edición: para evitar que las columnas de factores se conviertan en números, podríamos convertirlos en caracteres antes de llamar a dput:

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

Answer 6

Usted podría simplemente escribir en una conexión comprimida.

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