r - shinythemes - tags$div shiny

Dput simplificado() en R (6)

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

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.

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

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.

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.

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

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

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

r - shinythemes - tags$div shiny

Dput simplificado() en R (6)

Envoltura alrededor de la dput

solución de read.table

solución tribble

Envoltura alrededor de la `dput`

solución de `read.table`

solución `tribble`