I miss a way to add data to an SO answer in a transparent manner. My experience is that the structure
object from dput()
at times confuses inexperienced users unnecessary. I do however not have the patience to copy/paste it into a simple data frame each time and would like to automate it. Something similar to dput()
, but in a simplified version.
Say I by copy/pasting and some other hos have data like this,
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))
looks like this,
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
Within one integer, one factor and one numeric vector,
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
Now, I would like to share this on SO, but I do not always have the orginal data frame it came from. More often than not I pipe()
it in form SO and the only way I know to get it out is dput()
. Like,
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")
but, as I said at the top, these structure
s can look quite confusing. For that reason I am looking for a way to compress dput()
's output in some way. I imagine an output that looks something like this,
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))
Is that possible? I realize there's other classes, like lists
, tbl
, tbl_df
, etc.
3 solutions :
a wrapper around
dput
(handles standarddata.frames
,tibbles
andlists
)a
read.table
solution (fordata.frames
)a
tibble::tribble
solution (fordata.frames
, returning atibble
)All include
n
andrandom
parameter which allow one to dput only the head of the data or sample it on the fly.
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
This option that gives an output very close to the one proposed in the question. It's quite general because it's actually wrapped around dput
, but applied separately on columns.
multiline
means 'keep dput's default output laid out into multiple lines'.
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
solutionFor data.frames
I find it comfortable however to have the input in a more explicit/tabular format.
This can be reached using read.table
, then reformatting automatically the type of columns that read.table
wouldn't get right. Not as general as first solution but will work smoothly for 95% of the cases found on 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) }
Simplest case
dput_small2(iris,n=6)
will print:
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)
which in turn when executed will return :
# 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" ...
more complex
dummy data:
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)
This:
dput_small2(test,'df2')
will print:
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)
which in turn when executed will return :
# 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
solutionThe read.table
option is very readable but not very general. with tribble
pretty much any data type can be handled (though factors need adhoc fixing).
This solution isn't so useful for OP's example but is great for list columns (see example below). To make use of the output, library tibble
is required.
Just as my first solution, it's a wrapper around dput
, but instead of 'dputting' columns, i'm 'dputting' elements.
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" # )
The package datapasta
won't always work perfectly as it currently doesn't support all types, but it is clean and easy, i.e.,
# 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")) #> )
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With