├── .Rbuildignore ├── .gitattributes ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── compat-purrr.R ├── deparse-data-frame.R ├── deparse-factor.R ├── deparse-list.R ├── dp.R └── srcref-call.R ├── README.Rmd ├── README.md ├── appveyor.yml ├── deparse.Rproj ├── man ├── deparse.Rd └── srcref_call.Rd ├── tests ├── testthat.R └── testthat │ ├── helper-check-deparse-identical.R │ ├── out │ ├── iris-tibble.txt │ └── iris-tribble.txt │ ├── test-deparse.R │ └── test-output.R └── vignettes └── calls.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.png$ 5 | ^appveyor\.yml$ 6 | ^.travis\.yml$ 7 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | data/* binary 3 | src/* text=lf 4 | R/* text=lf 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | inst/doc 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: r 4 | cache: packages 5 | r: 6 | - oldrel 7 | - release 8 | - devel 9 | 10 | r_packages: 11 | - covr 12 | 13 | r_github_packages: 14 | - hadley/rlang 15 | 16 | after_success: 17 | - Rscript -e 'covr::codecov()' 18 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: deparse 2 | Title: A Nicer Deparse 3 | Version: 0.0-1 4 | Encoding: UTF-8 5 | Authors@R: c( 6 | person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r@mailbox.org"), 7 | person("Nick", "Kennedy", role = "aut", email = "r@nick-kennedy.com") 8 | ) 9 | Description: A drop-in replacement for 'deparse()' that generates 10 | nicely formatted expressions by default. 11 | Depends: 12 | R (>= 3.3.1) 13 | License: GPL-3 14 | LazyData: true 15 | Date: 2017-06-22 16 | BugReports: https://github.com/krlmlr/deparse/issues/ 17 | URL: http://krlmlr.github.io/deparse 18 | Imports: 19 | rlang 20 | Suggests: 21 | dplyr, 22 | knitr, 23 | rmarkdown, 24 | testthat, 25 | tibble 26 | VignetteBuilder: knitr 27 | RoxygenNote: 6.0.1 28 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.srcref_call,srcfile) 4 | S3method(deparse,"function") 5 | S3method(deparse,Date) 6 | S3method(deparse,POSIXct) 7 | S3method(deparse,POSIXlt) 8 | S3method(deparse,data.frame) 9 | S3method(deparse,default) 10 | S3method(deparse,factor) 11 | S3method(deparse,list) 12 | S3method(deparse,tbl_df) 13 | S3method(print,srcref_call) 14 | export(as.srcref_call) 15 | export(deparse) 16 | export(deparsec) 17 | import(rlang) 18 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | ## deparse 0.0-1 (2017-06-22) 2 | 3 | Initial release. 4 | 5 | - Consistent implementation for `deparse()` to `tibble()` and `tribble()`, and date-times and letters (#4, @NikNakk). 6 | - Fix R CMD check problems, integrate Travis and AppVeyor (#4, @NikNakk). 7 | -------------------------------------------------------------------------------- /R/compat-purrr.R: -------------------------------------------------------------------------------- 1 | # compat-purrr (last updated: rlang 0.0.0.9007) 2 | 3 | # This file serves as a reference for compatibility functions for 4 | # purrr. They are not drop-in replacements but allow a similar style 5 | # of programming. This is useful in cases where purrr is too heavy a 6 | # package to depend on. Please find the most recent version in rlang's 7 | # repository. 8 | 9 | # nocov start 10 | 11 | map <- function(.x, .f, ...) { 12 | lapply(.x, .f, ...) 13 | } 14 | map_mold <- function(.x, .f, .mold, ...) { 15 | out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) 16 | rlang::set_names(out, names(.x)) 17 | } 18 | map_lgl <- function(.x, .f, ...) { 19 | map_mold(.x, .f, logical(1), ...) 20 | } 21 | map_int <- function(.x, .f, ...) { 22 | map_mold(.x, .f, integer(1), ...) 23 | } 24 | map_dbl <- function(.x, .f, ...) { 25 | map_mold(.x, .f, double(1), ...) 26 | } 27 | map_chr <- function(.x, .f, ...) { 28 | map_mold(.x, .f, character(1), ...) 29 | } 30 | map_cpl <- function(.x, .f, ...) { 31 | map_mold(.x, .f, complex(1), ...) 32 | } 33 | 34 | pluck <- function(.x, .f) { 35 | map(.x, `[[`, .f) 36 | } 37 | pluck_lgl <- function(.x, .f) { 38 | map_lgl(.x, `[[`, .f) 39 | } 40 | pluck_int <- function(.x, .f) { 41 | map_int(.x, `[[`, .f) 42 | } 43 | pluck_dbl <- function(.x, .f) { 44 | map_dbl(.x, `[[`, .f) 45 | } 46 | pluck_chr <- function(.x, .f) { 47 | map_chr(.x, `[[`, .f) 48 | } 49 | pluck_cpl <- function(.x, .f) { 50 | map_cpl(.x, `[[`, .f) 51 | } 52 | 53 | map2 <- function(.x, .y, .f, ...) { 54 | Map(.f, .x, .y, ...) 55 | } 56 | map2_lgl <- function(.x, .y, .f, ...) { 57 | as.vector(map2(.x, .y, .f, ...), "logical") 58 | } 59 | map2_int <- function(.x, .y, .f, ...) { 60 | as.vector(map2(.x, .y, .f, ...), "integer") 61 | } 62 | map2_dbl <- function(.x, .y, .f, ...) { 63 | as.vector(map2(.x, .y, .f, ...), "double") 64 | } 65 | map2_chr <- function(.x, .y, .f, ...) { 66 | as.vector(map2(.x, .y, .f, ...), "character") 67 | } 68 | map2_cpl <- function(.x, .y, .f, ...) { 69 | as.vector(map2(.x, .y, .f, ...), "complex") 70 | } 71 | 72 | args_recycle <- function(args) { 73 | lengths <- map_int(args, length) 74 | n <- max(lengths) 75 | 76 | stopifnot(all(lengths == 1L | lengths == n)) 77 | to_recycle <- lengths == 1L 78 | args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) 79 | 80 | args 81 | } 82 | pmap <- function(.l, .f, ...) { 83 | args <- args_recycle(.l) 84 | do.call("mapply", c( 85 | FUN = list(quote(.f)), 86 | args, MoreArgs = quote(list(...)), 87 | SIMPLIFY = FALSE, USE.NAMES = FALSE 88 | )) 89 | } 90 | 91 | probe <- function(.x, .p, ...) { 92 | if (is_logical(.p)) { 93 | stopifnot(length(.p) == length(.x)) 94 | .p 95 | } else { 96 | map_lgl(.x, .p, ...) 97 | } 98 | } 99 | 100 | keep <- function(.x, .f, ...) { 101 | .x[probe(.x, .f, ...)] 102 | } 103 | discard <- function(.x, .p, ...) { 104 | sel <- probe(.x, .p, ...) 105 | .x[is.na(sel) | !sel] 106 | } 107 | map_if <- function(.x, .p, .f, ...) { 108 | matches <- probe(.x, .p) 109 | .x[matches] <- map(.x[matches], .f, ...) 110 | .x 111 | } 112 | 113 | compact <- function(.x) { 114 | Filter(length, .x) 115 | } 116 | 117 | transpose <- function(.l) { 118 | inner_names <- names(.l[[1]]) 119 | if (is.null(inner_names)) { 120 | fields <- seq_along(.l[[1]]) 121 | } else { 122 | fields <- set_names(inner_names) 123 | } 124 | 125 | map(fields, function(i) { 126 | map(.l, .subset2, i) 127 | }) 128 | } 129 | 130 | every <- function(.x, .p, ...) { 131 | for (i in seq_along(.x)) { 132 | if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) 133 | } 134 | TRUE 135 | } 136 | some <- function(.x, .p, ...) { 137 | for (i in seq_along(.x)) { 138 | if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) 139 | } 140 | FALSE 141 | } 142 | negate <- function(.p) { 143 | function(...) !.p(...) 144 | } 145 | 146 | reduce <- function(.x, .f, ..., .init) { 147 | f <- function(x, y) .f(x, y, ...) 148 | Reduce(f, .x, init = .init) 149 | } 150 | reduce_right <- function(.x, .f, ..., .init) { 151 | f <- function(x, y) .f(y, x, ...) 152 | Reduce(f, .x, init = .init, right = TRUE) 153 | } 154 | accumulate <- function(.x, .f, ..., .init) { 155 | f <- function(x, y) .f(x, y, ...) 156 | Reduce(f, .x, init = .init, accumulate = TRUE) 157 | } 158 | accumulate_right <- function(.x, .f, ..., .init) { 159 | f <- function(x, y) .f(y, x, ...) 160 | Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) 161 | } 162 | 163 | # nocov end 164 | -------------------------------------------------------------------------------- /R/deparse-data-frame.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | deparse.data.frame <- function(x, as_tibble = FALSE, as_tribble = FALSE, generate_mutate = TRUE, ...) { 3 | 4 | need_row_names <- tibble::has_rownames(x) 5 | if ((as_tibble || as_tribble) && need_row_names) { 6 | warn("row.names are not supported by `tibble`") 7 | } 8 | 9 | if (as_tribble) { 10 | return(deparse_tribble(x, generate_mutate, ...)) 11 | } 12 | 13 | col_names <- vapply(names(x), function(nm) deparse(as.name(nm)), character(1)) 14 | columns <- sprintf("%s = %s", col_names, vapply(x, deparse, character(1))) 15 | 16 | if (need_row_names && !as_tibble) { 17 | columns <- c(columns, sprintf("row.names = %s", 18 | deparse(attr(x, "row.names")))) 19 | } 20 | 21 | if (as_tibble) { 22 | sprintf("tibble(%s)", 23 | paste(columns, collapse = ", ")) 24 | } else { 25 | sprintf("data.frame(%s, stringsAsFactors = FALSE, check.names = FALSE)", 26 | paste(columns, collapse = ", ")) 27 | } 28 | } 29 | 30 | #' @export 31 | deparse.tbl_df <- function(x, as_tibble = TRUE, as_tribble = FALSE, ...) { 32 | deparse.data.frame(x = x, as_tibble = as_tibble, as_tribble = as_tribble, ...) 33 | } 34 | 35 | deparse_tribble <- function(x, generate_mutate, ...) { 36 | col_names <- names(x) 37 | 38 | row_item_calls <- list(quote(`:`), quote(c), quote(list)) 39 | 40 | # Finds an appropriate vector wrapped in function calls and replaces the 41 | # vector with the column name 42 | # Returns NULL if there is no matching vector 43 | find_and_replace_c <- function(cur_call, col_name, n_rows) { 44 | if ((!is.call(cur_call) && n_rows == 1) || 45 | (is.call(cur_call) && some(row_item_calls, identical, cur_call[[1L]]) && 46 | length(eval(cur_call)) == n_rows)) { 47 | return(list(col_data = cur_call, call = as.symbol(col_name))) 48 | } 49 | if (is.call(cur_call) && length(cur_call) > 1L) { 50 | res <- find_and_replace_c(cur_call[[2L]], col_name, n_rows) 51 | if (!is.null(res)) { 52 | cur_call[[2L]] <- res$call 53 | return(list(col_data = res$col_data, call = cur_call)) 54 | } else { 55 | return(NULL) 56 | } 57 | } 58 | return(NULL) 59 | } 60 | 61 | generate_column_calls <- function(column, col_name) { 62 | col_dp <- deparsec(column) 63 | col_call <- NULL 64 | if (is.call(col_dp)) { 65 | if (!some(row_item_calls, identical, col_dp[[1L]]) && 66 | length(col_dp) > 1L && !identical(col_dp[[1L]], quote(list))) { 67 | res <- find_and_replace_c(col_dp[[2L]], col_name, nrow(x)) 68 | if (!is.null(res)) { 69 | col_call <- col_dp 70 | col_call[[2L]] <- res$call 71 | column <- eval(res$col_data) 72 | } 73 | } 74 | } 75 | return(list(col_data = column, col_call = col_call)) 76 | } 77 | 78 | col_calls <- list() 79 | 80 | output_data <- character(nrow(x) * ncol(x)) 81 | dim(output_data) <- dim(x) 82 | col_widths <- integer(ncol(x)) 83 | col_storage <- character(ncol(x)) 84 | 85 | for (i in seq_along(x)) { 86 | res <- generate_column_calls(x[[i]], col_names[i]) 87 | if (generate_mutate) { 88 | col_data <- res$col_data 89 | } else { 90 | col_data <- x[[i]] 91 | } 92 | output_data[, i] <- map_chr(col_data, deparse, ...) 93 | col_storage[i] <- storage.mode(col_data) 94 | col_widths[i] <- max(nchar(output_data[, i])) 95 | 96 | if (!is.null(res$col_call)) { 97 | col_calls <- c(col_calls, 98 | set_names(list(deparse(res$col_call)), col_names[i])) 99 | } 100 | } 101 | 102 | syntactic_name <- function(x) { 103 | base::deparse(as.symbol(x), backtick = TRUE) 104 | } 105 | output_col_names <- paste0( 106 | "~", 107 | map_chr(col_names, syntactic_name) 108 | ) 109 | 110 | col_widths <- pmax(col_widths, nchar(output_col_names)) + 1 111 | 112 | col_format <- paste0( 113 | "%-", 114 | # ifelse(col_storage %in% c("integer", "double"), "", "-"), 115 | col_widths, 116 | "s" 117 | ) 118 | 119 | for (i in seq_len(ncol(x))) { 120 | output_data[, i] <- sprintf(col_format[i], paste0(output_data[, i], ",")) 121 | output_col_names[i] <- sprintf( 122 | col_format[i], 123 | paste0(output_col_names[i], ",") 124 | ) 125 | } 126 | 127 | output_data[length(output_data)] <- sub( 128 | ", *$", 129 | "", 130 | output_data[length(output_data)] 131 | ) 132 | 133 | output_collapsed <- map_chr( 134 | seq_len(nrow(x)), 135 | function(i) paste(output_data[i, ], collapse = " ") 136 | ) 137 | 138 | output_final <- paste0( 139 | "tribble(\n ", 140 | paste( 141 | c(paste(output_col_names, collapse = " "), output_collapsed), 142 | collapse = "\n " 143 | ), 144 | "\n)" 145 | ) 146 | 147 | if (length(col_calls) > 0L) { 148 | if (generate_mutate) { 149 | output_final <- paste0( 150 | output_final, 151 | " %>%\n", 152 | " mutate(\n", 153 | paste( 154 | sprintf(" %s = %s", names(col_calls), col_calls), 155 | collapse = ",\n" 156 | ), 157 | "\n )" 158 | ) 159 | } else { 160 | warn("Without `generate_mutate`, deparsed code may not function correctly on types such as factors") 161 | } 162 | } 163 | output_final 164 | } 165 | -------------------------------------------------------------------------------- /R/deparse-factor.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | deparse.factor <- function(x, ...) { 3 | fac_items <- as.character(x) 4 | fac_items_dp <- deparse(fac_items) 5 | if (!identical(levels(x), levels(factor(fac_items)))) { 6 | fac_items_dp <- sprintf("%s, levels = %s", fac_items_dp, deparse(levels(x))) 7 | } 8 | if (is.ordered(x)) { 9 | func_name <- "ordered" 10 | } else { 11 | func_name <- "factor" 12 | } 13 | sprintf("%s(%s)", func_name, fac_items_dp) 14 | } 15 | -------------------------------------------------------------------------------- /R/deparse-list.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | deparse.list <- function(x, ...) { 3 | create_list_item <- function(name, item) { 4 | if (name != "") { 5 | name <- paste0(name, " = ") 6 | } 7 | paste0(name, deparse(item, ...)) 8 | } 9 | if (is.null(names(x))) { 10 | list_names <- character(length(x)) 11 | } else { 12 | list_names <- names(x) 13 | } 14 | output <- map2_chr(list_names, x, create_list_item) 15 | output <- paste0( 16 | "list(", 17 | paste(output, collapse = ", "), 18 | ")" 19 | ) 20 | wrap_structure(x, output, "list") 21 | } 22 | 23 | wrap_structure <- function(x, deparsed, current_class, exclude_attrs = NULL) { 24 | x_attrs <- attributes(x) 25 | exclude_attrs <- union(c("names", "class"), exclude_attrs) 26 | if (!identical(class(x), current_class)) { 27 | add_class <- sprintf(", class = %s", deparse(class(x))) 28 | } else { 29 | add_class <- "" 30 | } 31 | add_attr_names <- setdiff(names2(x_attrs), exclude_attrs) 32 | add_attr_labels <- set_names(add_attr_names, add_attr_names) 33 | to_replace <- match(c("dim", "dimnames", "tsp", "levels"), add_attr_names) 34 | if (any(!is.na(to_replace))) { 35 | add_attr_labels[na.omit(to_replace)] <- 36 | c(".Dim", ".Dimnames", ".Tsp", ".Label")[!is.na(to_replace)] 37 | } 38 | make_attr_text <- function(attrib) { 39 | sprintf("%s = %s", add_attr_labels[[attrib]], deparse(x_attrs[[attrib]])) 40 | } 41 | add_attrs <- paste(map_chr(add_attr_names, make_attr_text), 42 | collapse = ", ") 43 | if (add_attrs != "") { 44 | add_attrs <- paste0(", ", add_attrs) 45 | } 46 | if (add_attrs != "" || add_class != "") { 47 | sprintf("structure(%s%s%s)", deparsed, add_class, add_attrs) 48 | } else { 49 | deparsed 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /R/dp.R: -------------------------------------------------------------------------------- 1 | #' A nicer deparse 2 | #' 3 | #' \code{deparse} is a reimplementation of \code{\link[base]{dput}} and related 4 | #' functions. It tries its best to produce output that is easy to read 5 | #' (for humans), yet produces (almost) identical results to the input 6 | #' (for machines). This function is a generic, so other packages can easily 7 | #' provide implementations for the objects they define. 8 | #' 9 | #' @param x object to deparse 10 | #' @param ... passed to other methods 11 | #' 12 | #' @import rlang 13 | #' @export 14 | deparse <- function(x, ...) { 15 | UseMethod("deparse") 16 | } 17 | 18 | #' @export 19 | deparse.default <- function(x, ...) { 20 | if (is.list(x)) { 21 | deparse.list(x, ...) 22 | } else { 23 | paste(base::deparse(x, 500L, backtick = TRUE), collapse = "") 24 | } 25 | } 26 | 27 | #' @export 28 | deparse.Date <- function(x, ...) { 29 | deparse_call("as.Date", format(x)) 30 | } 31 | 32 | #' @export 33 | deparse.POSIXct <- function(x, ...) { 34 | deparse_call("as.POSIXct", format(x, usetz = TRUE)) 35 | } 36 | 37 | #' @export 38 | deparse.POSIXlt <- function(x, ...) { 39 | deparse_call("as.POSIXlt", format(x, usetz = TRUE)) 40 | } 41 | 42 | deparse_call <- function(call, argument) { 43 | paste0(call, "(", deparse(argument), ")") 44 | } 45 | 46 | #' @export 47 | deparse.function <- function(x, ...) { 48 | fun_in_namespace <- find_function_in_namespace(x) 49 | if (is.null(fun_in_namespace)) 50 | NextMethod() 51 | else { 52 | paste0(deparse(as.name(fun_in_namespace$ns)), "::", deparse(as.name(fun_in_namespace$fun))) 53 | } 54 | } 55 | 56 | find_function_in_namespace <- function(fun) { 57 | env <- environment(fun) 58 | if (!isNamespace(env)) 59 | return(NULL) 60 | 61 | namespace_funs <- as.list(env) 62 | namespace_funs <- namespace_funs[order(names(namespace_funs))] 63 | 64 | same <- vapply(namespace_funs, identical, fun, FUN.VALUE = logical(1L)) 65 | same_name <- names(which(same)) 66 | if (length(same_name) == 0L) 67 | return(NULL) 68 | 69 | list(ns = getNamespaceName(env), fun = same_name[[1L]]) 70 | } 71 | 72 | #' @rdname deparse 73 | #' 74 | #' @description 75 | #' The \code{deparsec} function leverages \code{deparse} by creating 76 | #' a \code{call} object which can be evaluated but retains formatting 77 | #' (in the form of a \code{\link[base]{srcref}} attribute). 78 | #' @export 79 | deparsec <- function(x, ...) { 80 | text <- deparse(x, ...) 81 | as.srcref_call(srcfilecopy("", text)) 82 | } 83 | -------------------------------------------------------------------------------- /R/srcref-call.R: -------------------------------------------------------------------------------- 1 | #' Calls with attached srcrefs 2 | #' 3 | #' As of R 2.10.0, \code{\link[base]{call}} objects don't use a 4 | #' \code{\link[base]{srcref}} attribute 5 | #' even if it's attached, see \code{vignette("calls", package = "deparse")} for 6 | #' details. This class provides call objects that use their \code{srcref} 7 | #' attribute for printing. 8 | #' 9 | #' @param call call 10 | #' @param srcref srcref 11 | srcref_call <- function(call, srcref) { 12 | stop("NYI") 13 | } 14 | 15 | #' @param x object 16 | #' @param ... passed to other methods 17 | #' 18 | #' @rdname srcref_call 19 | #' @export 20 | as.srcref_call <- function(x, ...) { 21 | UseMethod("as.srcref_call") 22 | } 23 | 24 | #' @export 25 | as.srcref_call.srcfile <- function(x, ...) { 26 | ex <- parse_srcfile(x) 27 | cl <- ex[[1L]] 28 | if (!is.null(cl)) { 29 | class(cl) <- "srcref_call" 30 | attr(cl, "srcref") <- attr(ex, "srcref")[[1]] 31 | } 32 | cl 33 | } 34 | 35 | #' @export 36 | print.srcref_call <- function(x, ..., useSource = TRUE) { 37 | if (!useSource || is.null(srcref <- utils::getSrcref(x))) 38 | NextMethod() 39 | else 40 | print(srcref, ...) 41 | invisible(x) 42 | } 43 | 44 | parse_srcfile <- function(x) { 45 | parse(text = read_srcfile(x), keep.source = TRUE, srcfile = x) 46 | } 47 | 48 | read_srcfile <- function(x) { 49 | # Can't pass conn to parse() for some reason, results are garbled 50 | conn <- open(x, 1L) 51 | on.exit(close(conn), add = TRUE) 52 | readLines(conn) 53 | } 54 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "README-" 12 | ) 13 | ``` 14 | 15 | # deparse 16 | 17 | [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/krlmlr/deparse?branch=master&svg=true)](https://ci.appveyor.com/project/krlmlr/deparse) 18 | 19 | [![Travis Build Status](https://www.travis-ci.org/krlmlr/deparse.svg?branch=master)](https://www.travis-ci.org/krlmlr/deparse) 20 | 21 | The goal of the `deparse` package is to provide an extensible deparsing function for R. 22 | Like `base::deparse()` and others, the output is intended to produce results that are (almost) identical to the input when evaluated. 23 | Unlike the `base` equivalents, `deparse` aims at making the output as human-friendly as possible. 24 | 25 | The `deparse()` function is rougly equivalent to `deparse()`, but with nicer defaults. 26 | The `deparsec()` function returns an object which can be passed to `eval()` but also retains the desired formatting---a better `dput()`. 27 | 28 | 29 | ## Examples 30 | 31 | ```{r echo=FALSE, message=FALSE} 32 | devtools::load_all() 33 | ``` 34 | 35 | ```{r} 36 | deparse(1) 37 | deparsec(1L) 38 | deparsec(Sys.time()) 39 | deparsec(print) 40 | 41 | eval(deparsec(print)) 42 | ``` 43 | 44 | Compare this to the `dput()` output: 45 | 46 | ```{r} 47 | deparse(1) 48 | dput(1L) 49 | dput(Sys.time()) 50 | dput(print) 51 | 52 | eval(parse(text = deparse(print))) 53 | ``` 54 | 55 | 56 | ## Installation 57 | 58 | Install via 59 | 60 | ```r 61 | devtools::install_github("krlmlr/deparse") 62 | ``` 63 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | deparse 4 | == 5 | 6 | The goal of the `deparse` package is to provide an extensible deparsing function for R. Like `base::deparse()` and others, the output is intended to produce results that are (almost) identical to the input when evaluated. Unlike the `base` equivalents, `deparse` aims at making the output as human-friendly as possible. 7 | 8 | The `deparse()` function is rougly equivalent to `deparse()`, but with nicer defaults. The `deparsec()` function returns an object which can be passed to `eval()` but also retains the desired formatting---a better `dput()`. 9 | 10 | Examples 11 | -------- 12 | 13 | ``` r 14 | deparse(1) 15 | #> [1] "1" 16 | deparsec(1L) 17 | #> 1L 18 | deparsec(Sys.time()) 19 | #> as.POSIXct("2016-08-16 17:11:32 CEST") 20 | deparsec(print) 21 | #> base::print 22 | 23 | eval(deparsec(print)) 24 | #> function (x, ...) 25 | #> UseMethod("print") 26 | #> 27 | #> 28 | ``` 29 | 30 | Compare this to the `dput()` output: 31 | 32 | ``` r 33 | deparse(1) 34 | #> [1] "1" 35 | dput(1L) 36 | #> 1L 37 | dput(Sys.time()) 38 | #> structure(1471360292.17246, class = c("POSIXct", "POSIXt")) 39 | dput(print) 40 | #> function (x, ...) 41 | #> UseMethod("print") 42 | 43 | eval(parse(text = deparse(print))) 44 | #> function (x, ...) 45 | #> UseMethod("print") 46 | ``` 47 | 48 | Installation 49 | ------------ 50 | 51 | Install via 52 | 53 | ``` r 54 | devtools::install_github("krlmlr/deparse") 55 | ``` 56 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | 10 | install: 11 | ps: Bootstrap 12 | 13 | environment: 14 | global: 15 | USE_RTOOLS: true 16 | 17 | # Adapt as necessary starting from here 18 | 19 | build_script: 20 | - travis-tool.sh install_github hadley/rlang 21 | - travis-tool.sh install_deps 22 | 23 | 24 | test_script: 25 | - travis-tool.sh run_tests 26 | 27 | on_failure: 28 | - 7z a failure.zip *.Rcheck\* 29 | - appveyor PushArtifact failure.zip 30 | 31 | artifacts: 32 | - path: '*.Rcheck\**\*.log' 33 | name: Logs 34 | 35 | - path: '*.Rcheck\**\*.out' 36 | name: Logs 37 | 38 | - path: '*.Rcheck\**\*.fail' 39 | name: Logs 40 | 41 | - path: '*.Rcheck\**\*.Rout' 42 | name: Logs 43 | 44 | - path: '\*_*.tar.gz' 45 | name: Bits 46 | 47 | - path: '\*_*.zip' 48 | name: Bits 49 | -------------------------------------------------------------------------------- /deparse.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/deparse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dp.R 3 | \name{deparse} 4 | \alias{deparse} 5 | \alias{deparsec} 6 | \title{A nicer deparse} 7 | \usage{ 8 | deparse(x, ...) 9 | 10 | deparsec(x, ...) 11 | } 12 | \arguments{ 13 | \item{x}{object to deparse} 14 | 15 | \item{...}{passed to other methods} 16 | } 17 | \description{ 18 | \code{deparse} is a reimplementation of \code{\link[base]{dput}} and related 19 | functions. It tries its best to produce output that is easy to read 20 | (for humans), yet produces (almost) identical results to the input 21 | (for machines). This function is a generic, so other packages can easily 22 | provide implementations for the objects they define. 23 | 24 | The \code{deparsec} function leverages \code{deparse} by creating 25 | a \code{call} object which can be evaluated but retains formatting 26 | (in the form of a \code{\link[base]{srcref}} attribute). 27 | } 28 | -------------------------------------------------------------------------------- /man/srcref_call.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/srcref-call.R 3 | \name{srcref_call} 4 | \alias{srcref_call} 5 | \alias{as.srcref_call} 6 | \title{Calls with attached srcrefs} 7 | \usage{ 8 | srcref_call(call, srcref) 9 | 10 | as.srcref_call(x, ...) 11 | } 12 | \arguments{ 13 | \item{call}{call} 14 | 15 | \item{srcref}{srcref} 16 | 17 | \item{x}{object} 18 | 19 | \item{...}{passed to other methods} 20 | } 21 | \description{ 22 | As of R 2.10.0, \code{\link[base]{call}} objects don't use a 23 | \code{\link[base]{srcref}} attribute 24 | even if it's attached, see \code{vignette("calls", package = "deparse")} for 25 | details. This class provides call objects that use their \code{srcref} 26 | attribute for printing. 27 | } 28 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(deparse) 3 | 4 | test_check("deparse") 5 | -------------------------------------------------------------------------------- /tests/testthat/helper-check-deparse-identical.R: -------------------------------------------------------------------------------- 1 | check_deparse_identical <- function(x, ...) { 2 | tibble <- tibble::tibble 3 | tribble <- tibble::tribble 4 | mutate <- dplyr::mutate 5 | expect_identical(x, eval(deparsec(x, ...))) 6 | } 7 | 8 | check_deparse_equal <- function(x, ...) { 9 | tibble <- tibble::tibble 10 | tribble <- tibble::tribble 11 | mutate <- dplyr::mutate 12 | expect_equal(x, eval(deparsec(x, ...))) 13 | } 14 | -------------------------------------------------------------------------------- /tests/testthat/out/iris-tibble.txt: -------------------------------------------------------------------------------- 1 | tibble(Sepal.Length = c(5.1, 4.9, 4.7, 4.6, 5, 5.4, 4.6, 5, 4.4, 4.9, 5.4, 4.8, 4.8, 4.3, 5.8, 5.7, 5.4, 5.1, 5.7, 5.1, 5.4, 5.1, 4.6, 5.1, 4.8, 5, 5, 5.2, 5.2, 4.7, 4.8, 5.4, 5.2, 5.5, 4.9, 5, 5.5, 4.9, 4.4, 5.1, 5, 4.5, 4.4, 5, 5.1, 4.8, 5.1, 4.6, 5.3, 5, 7, 6.4, 6.9, 5.5, 6.5, 5.7, 6.3, 4.9, 6.6, 5.2, 5, 5.9, 6, 6.1, 5.6, 6.7, 5.6, 5.8, 6.2, 5.6, 5.9, 6.1, 6.3, 6.1, 6.4, 6.6, 6.8, 6.7, 6, 5.7, 5.5, 5.5, 5.8, 6, 5.4, 6, 6.7, 6.3, 5.6, 5.5, 5.5, 6.1, 5.8, 5, 5.6, 5.7, 5.7, 6.2, 5.1, 5.7, 6.3, 5.8, 7.1, 6.3, 6.5, 7.6, 4.9, 7.3, 6.7, 7.2, 6.5, 6.4, 6.8, 5.7, 5.8, 6.4, 6.5, 7.7, 7.7, 6, 6.9, 5.6, 7.7, 6.3, 6.7, 7.2, 6.2, 6.1, 6.4, 7.2, 7.4, 7.9, 6.4, 6.3, 6.1, 7.7, 6.3, 6.4, 6, 6.9, 6.7, 6.9, 5.8, 6.8, 6.7, 6.7, 6.3, 6.5, 6.2, 5.9), Sepal.Width = c(3.5, 3, 3.2, 3.1, 3.6, 3.9, 3.4, 3.4, 2.9, 3.1, 3.7, 3.4, 3, 3, 4, 4.4, 3.9, 3.5, 3.8, 3.8, 3.4, 3.7, 3.6, 3.3, 3.4, 3, 3.4, 3.5, 3.4, 3.2, 3.1, 3.4, 4.1, 4.2, 3.1, 3.2, 3.5, 3.6, 3, 3.4, 3.5, 2.3, 3.2, 3.5, 3.8, 3, 3.8, 3.2, 3.7, 3.3, 3.2, 3.2, 3.1, 2.3, 2.8, 2.8, 3.3, 2.4, 2.9, 2.7, 2, 3, 2.2, 2.9, 2.9, 3.1, 3, 2.7, 2.2, 2.5, 3.2, 2.8, 2.5, 2.8, 2.9, 3, 2.8, 3, 2.9, 2.6, 2.4, 2.4, 2.7, 2.7, 3, 3.4, 3.1, 2.3, 3, 2.5, 2.6, 3, 2.6, 2.3, 2.7, 3, 2.9, 2.9, 2.5, 2.8, 3.3, 2.7, 3, 2.9, 3, 3, 2.5, 2.9, 2.5, 3.6, 3.2, 2.7, 3, 2.5, 2.8, 3.2, 3, 3.8, 2.6, 2.2, 3.2, 2.8, 2.8, 2.7, 3.3, 3.2, 2.8, 3, 2.8, 3, 2.8, 3.8, 2.8, 2.8, 2.6, 3, 3.4, 3.1, 3, 3.1, 3.1, 3.1, 2.7, 3.2, 3.3, 3, 2.5, 3, 3.4, 3), Petal.Length = c(1.4, 1.4, 1.3, 1.5, 1.4, 1.7, 1.4, 1.5, 1.4, 1.5, 1.5, 1.6, 1.4, 1.1, 1.2, 1.5, 1.3, 1.4, 1.7, 1.5, 1.7, 1.5, 1, 1.7, 1.9, 1.6, 1.6, 1.5, 1.4, 1.6, 1.6, 1.5, 1.5, 1.4, 1.5, 1.2, 1.3, 1.4, 1.3, 1.5, 1.3, 1.3, 1.3, 1.6, 1.9, 1.4, 1.6, 1.4, 1.5, 1.4, 4.7, 4.5, 4.9, 4, 4.6, 4.5, 4.7, 3.3, 4.6, 3.9, 3.5, 4.2, 4, 4.7, 3.6, 4.4, 4.5, 4.1, 4.5, 3.9, 4.8, 4, 4.9, 4.7, 4.3, 4.4, 4.8, 5, 4.5, 3.5, 3.8, 3.7, 3.9, 5.1, 4.5, 4.5, 4.7, 4.4, 4.1, 4, 4.4, 4.6, 4, 3.3, 4.2, 4.2, 4.2, 4.3, 3, 4.1, 6, 5.1, 5.9, 5.6, 5.8, 6.6, 4.5, 6.3, 5.8, 6.1, 5.1, 5.3, 5.5, 5, 5.1, 5.3, 5.5, 6.7, 6.9, 5, 5.7, 4.9, 6.7, 4.9, 5.7, 6, 4.8, 4.9, 5.6, 5.8, 6.1, 6.4, 5.6, 5.1, 5.6, 6.1, 5.6, 5.5, 4.8, 5.4, 5.6, 5.1, 5.1, 5.9, 5.7, 5.2, 5, 5.2, 5.4, 5.1), Petal.Width = c(0.2, 0.2, 0.2, 0.2, 0.2, 0.4, 0.3, 0.2, 0.2, 0.1, 0.2, 0.2, 0.1, 0.1, 0.2, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.4, 0.2, 0.5, 0.2, 0.2, 0.4, 0.2, 0.2, 0.2, 0.2, 0.4, 0.1, 0.2, 0.2, 0.2, 0.2, 0.1, 0.2, 0.2, 0.3, 0.3, 0.2, 0.6, 0.4, 0.3, 0.2, 0.2, 0.2, 0.2, 1.4, 1.5, 1.5, 1.3, 1.5, 1.3, 1.6, 1, 1.3, 1.4, 1, 1.5, 1, 1.4, 1.3, 1.4, 1.5, 1, 1.5, 1.1, 1.8, 1.3, 1.5, 1.2, 1.3, 1.4, 1.4, 1.7, 1.5, 1, 1.1, 1, 1.2, 1.6, 1.5, 1.6, 1.5, 1.3, 1.3, 1.3, 1.2, 1.4, 1.2, 1, 1.3, 1.2, 1.3, 1.3, 1.1, 1.3, 2.5, 1.9, 2.1, 1.8, 2.2, 2.1, 1.7, 1.8, 1.8, 2.5, 2, 1.9, 2.1, 2, 2.4, 2.3, 1.8, 2.2, 2.3, 1.5, 2.3, 2, 2, 1.8, 2.1, 1.8, 1.8, 1.8, 2.1, 1.6, 1.9, 2, 2.2, 1.5, 1.4, 2.3, 2.4, 1.8, 1.8, 2.1, 2.4, 2.3, 1.9, 2.3, 2.5, 2.3, 1.9, 2, 2.3, 1.8), Species = factor(c("setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "versicolor", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica", "virginica"))) 2 | -------------------------------------------------------------------------------- /tests/testthat/out/iris-tribble.txt: -------------------------------------------------------------------------------- 1 | tribble( 2 | ~Sepal.Length, ~Sepal.Width, ~Petal.Length, ~Petal.Width, ~Species, 3 | 5.1, 3.5, 1.4, 0.2, "setosa", 4 | 4.9, 3, 1.4, 0.2, "setosa", 5 | 4.7, 3.2, 1.3, 0.2, "setosa", 6 | 4.6, 3.1, 1.5, 0.2, "setosa", 7 | 5, 3.6, 1.4, 0.2, "setosa", 8 | 5.4, 3.9, 1.7, 0.4, "setosa", 9 | 4.6, 3.4, 1.4, 0.3, "setosa", 10 | 5, 3.4, 1.5, 0.2, "setosa", 11 | 4.4, 2.9, 1.4, 0.2, "setosa", 12 | 4.9, 3.1, 1.5, 0.1, "setosa", 13 | 5.4, 3.7, 1.5, 0.2, "setosa", 14 | 4.8, 3.4, 1.6, 0.2, "setosa", 15 | 4.8, 3, 1.4, 0.1, "setosa", 16 | 4.3, 3, 1.1, 0.1, "setosa", 17 | 5.8, 4, 1.2, 0.2, "setosa", 18 | 5.7, 4.4, 1.5, 0.4, "setosa", 19 | 5.4, 3.9, 1.3, 0.4, "setosa", 20 | 5.1, 3.5, 1.4, 0.3, "setosa", 21 | 5.7, 3.8, 1.7, 0.3, "setosa", 22 | 5.1, 3.8, 1.5, 0.3, "setosa", 23 | 5.4, 3.4, 1.7, 0.2, "setosa", 24 | 5.1, 3.7, 1.5, 0.4, "setosa", 25 | 4.6, 3.6, 1, 0.2, "setosa", 26 | 5.1, 3.3, 1.7, 0.5, "setosa", 27 | 4.8, 3.4, 1.9, 0.2, "setosa", 28 | 5, 3, 1.6, 0.2, "setosa", 29 | 5, 3.4, 1.6, 0.4, "setosa", 30 | 5.2, 3.5, 1.5, 0.2, "setosa", 31 | 5.2, 3.4, 1.4, 0.2, "setosa", 32 | 4.7, 3.2, 1.6, 0.2, "setosa", 33 | 4.8, 3.1, 1.6, 0.2, "setosa", 34 | 5.4, 3.4, 1.5, 0.4, "setosa", 35 | 5.2, 4.1, 1.5, 0.1, "setosa", 36 | 5.5, 4.2, 1.4, 0.2, "setosa", 37 | 4.9, 3.1, 1.5, 0.2, "setosa", 38 | 5, 3.2, 1.2, 0.2, "setosa", 39 | 5.5, 3.5, 1.3, 0.2, "setosa", 40 | 4.9, 3.6, 1.4, 0.1, "setosa", 41 | 4.4, 3, 1.3, 0.2, "setosa", 42 | 5.1, 3.4, 1.5, 0.2, "setosa", 43 | 5, 3.5, 1.3, 0.3, "setosa", 44 | 4.5, 2.3, 1.3, 0.3, "setosa", 45 | 4.4, 3.2, 1.3, 0.2, "setosa", 46 | 5, 3.5, 1.6, 0.6, "setosa", 47 | 5.1, 3.8, 1.9, 0.4, "setosa", 48 | 4.8, 3, 1.4, 0.3, "setosa", 49 | 5.1, 3.8, 1.6, 0.2, "setosa", 50 | 4.6, 3.2, 1.4, 0.2, "setosa", 51 | 5.3, 3.7, 1.5, 0.2, "setosa", 52 | 5, 3.3, 1.4, 0.2, "setosa", 53 | 7, 3.2, 4.7, 1.4, "versicolor", 54 | 6.4, 3.2, 4.5, 1.5, "versicolor", 55 | 6.9, 3.1, 4.9, 1.5, "versicolor", 56 | 5.5, 2.3, 4, 1.3, "versicolor", 57 | 6.5, 2.8, 4.6, 1.5, "versicolor", 58 | 5.7, 2.8, 4.5, 1.3, "versicolor", 59 | 6.3, 3.3, 4.7, 1.6, "versicolor", 60 | 4.9, 2.4, 3.3, 1, "versicolor", 61 | 6.6, 2.9, 4.6, 1.3, "versicolor", 62 | 5.2, 2.7, 3.9, 1.4, "versicolor", 63 | 5, 2, 3.5, 1, "versicolor", 64 | 5.9, 3, 4.2, 1.5, "versicolor", 65 | 6, 2.2, 4, 1, "versicolor", 66 | 6.1, 2.9, 4.7, 1.4, "versicolor", 67 | 5.6, 2.9, 3.6, 1.3, "versicolor", 68 | 6.7, 3.1, 4.4, 1.4, "versicolor", 69 | 5.6, 3, 4.5, 1.5, "versicolor", 70 | 5.8, 2.7, 4.1, 1, "versicolor", 71 | 6.2, 2.2, 4.5, 1.5, "versicolor", 72 | 5.6, 2.5, 3.9, 1.1, "versicolor", 73 | 5.9, 3.2, 4.8, 1.8, "versicolor", 74 | 6.1, 2.8, 4, 1.3, "versicolor", 75 | 6.3, 2.5, 4.9, 1.5, "versicolor", 76 | 6.1, 2.8, 4.7, 1.2, "versicolor", 77 | 6.4, 2.9, 4.3, 1.3, "versicolor", 78 | 6.6, 3, 4.4, 1.4, "versicolor", 79 | 6.8, 2.8, 4.8, 1.4, "versicolor", 80 | 6.7, 3, 5, 1.7, "versicolor", 81 | 6, 2.9, 4.5, 1.5, "versicolor", 82 | 5.7, 2.6, 3.5, 1, "versicolor", 83 | 5.5, 2.4, 3.8, 1.1, "versicolor", 84 | 5.5, 2.4, 3.7, 1, "versicolor", 85 | 5.8, 2.7, 3.9, 1.2, "versicolor", 86 | 6, 2.7, 5.1, 1.6, "versicolor", 87 | 5.4, 3, 4.5, 1.5, "versicolor", 88 | 6, 3.4, 4.5, 1.6, "versicolor", 89 | 6.7, 3.1, 4.7, 1.5, "versicolor", 90 | 6.3, 2.3, 4.4, 1.3, "versicolor", 91 | 5.6, 3, 4.1, 1.3, "versicolor", 92 | 5.5, 2.5, 4, 1.3, "versicolor", 93 | 5.5, 2.6, 4.4, 1.2, "versicolor", 94 | 6.1, 3, 4.6, 1.4, "versicolor", 95 | 5.8, 2.6, 4, 1.2, "versicolor", 96 | 5, 2.3, 3.3, 1, "versicolor", 97 | 5.6, 2.7, 4.2, 1.3, "versicolor", 98 | 5.7, 3, 4.2, 1.2, "versicolor", 99 | 5.7, 2.9, 4.2, 1.3, "versicolor", 100 | 6.2, 2.9, 4.3, 1.3, "versicolor", 101 | 5.1, 2.5, 3, 1.1, "versicolor", 102 | 5.7, 2.8, 4.1, 1.3, "versicolor", 103 | 6.3, 3.3, 6, 2.5, "virginica", 104 | 5.8, 2.7, 5.1, 1.9, "virginica", 105 | 7.1, 3, 5.9, 2.1, "virginica", 106 | 6.3, 2.9, 5.6, 1.8, "virginica", 107 | 6.5, 3, 5.8, 2.2, "virginica", 108 | 7.6, 3, 6.6, 2.1, "virginica", 109 | 4.9, 2.5, 4.5, 1.7, "virginica", 110 | 7.3, 2.9, 6.3, 1.8, "virginica", 111 | 6.7, 2.5, 5.8, 1.8, "virginica", 112 | 7.2, 3.6, 6.1, 2.5, "virginica", 113 | 6.5, 3.2, 5.1, 2, "virginica", 114 | 6.4, 2.7, 5.3, 1.9, "virginica", 115 | 6.8, 3, 5.5, 2.1, "virginica", 116 | 5.7, 2.5, 5, 2, "virginica", 117 | 5.8, 2.8, 5.1, 2.4, "virginica", 118 | 6.4, 3.2, 5.3, 2.3, "virginica", 119 | 6.5, 3, 5.5, 1.8, "virginica", 120 | 7.7, 3.8, 6.7, 2.2, "virginica", 121 | 7.7, 2.6, 6.9, 2.3, "virginica", 122 | 6, 2.2, 5, 1.5, "virginica", 123 | 6.9, 3.2, 5.7, 2.3, "virginica", 124 | 5.6, 2.8, 4.9, 2, "virginica", 125 | 7.7, 2.8, 6.7, 2, "virginica", 126 | 6.3, 2.7, 4.9, 1.8, "virginica", 127 | 6.7, 3.3, 5.7, 2.1, "virginica", 128 | 7.2, 3.2, 6, 1.8, "virginica", 129 | 6.2, 2.8, 4.8, 1.8, "virginica", 130 | 6.1, 3, 4.9, 1.8, "virginica", 131 | 6.4, 2.8, 5.6, 2.1, "virginica", 132 | 7.2, 3, 5.8, 1.6, "virginica", 133 | 7.4, 2.8, 6.1, 1.9, "virginica", 134 | 7.9, 3.8, 6.4, 2, "virginica", 135 | 6.4, 2.8, 5.6, 2.2, "virginica", 136 | 6.3, 2.8, 5.1, 1.5, "virginica", 137 | 6.1, 2.6, 5.6, 1.4, "virginica", 138 | 7.7, 3, 6.1, 2.3, "virginica", 139 | 6.3, 3.4, 5.6, 2.4, "virginica", 140 | 6.4, 3.1, 5.5, 1.8, "virginica", 141 | 6, 3, 4.8, 1.8, "virginica", 142 | 6.9, 3.1, 5.4, 2.1, "virginica", 143 | 6.7, 3.1, 5.6, 2.4, "virginica", 144 | 6.9, 3.1, 5.1, 2.3, "virginica", 145 | 5.8, 2.7, 5.1, 1.9, "virginica", 146 | 6.8, 3.2, 5.9, 2.3, "virginica", 147 | 6.7, 3.3, 5.7, 2.5, "virginica", 148 | 6.7, 3, 5.2, 2.3, "virginica", 149 | 6.3, 2.5, 5, 1.9, "virginica", 150 | 6.5, 3, 5.2, 2, "virginica", 151 | 6.2, 3.4, 5.4, 2.3, "virginica", 152 | 5.9, 3, 5.1, 1.8, "virginica" 153 | ) %>% 154 | mutate( 155 | Species = factor(Species) 156 | ) 157 | -------------------------------------------------------------------------------- /tests/testthat/test-deparse.R: -------------------------------------------------------------------------------- 1 | context("deparse()") 2 | 3 | test_that("deparse handles lists appropriately", { 4 | check_deparse_identical(list(LETTERS)) 5 | check_deparse_identical(list(x = 1:4)) 6 | check_deparse_identical(list(list(list(1:4), y = 1:5))) 7 | 8 | my_list <- list(x = 1:4) 9 | attr(my_list, "my_attr") <- "test" 10 | 11 | check_deparse_identical(my_list) 12 | 13 | my_classed_list <- my_list 14 | class(my_classed_list) <- "test_class" 15 | 16 | check_deparse_identical(my_classed_list) 17 | }) 18 | 19 | test_that("deparse handles basic types", { 20 | check_deparse_identical(1:5) 21 | check_deparse_identical(LETTERS) 22 | check_deparse_identical(c(TRUE, FALSE)) 23 | check_deparse_identical(NULL) 24 | }) 25 | 26 | test_that("deparse handles dates", { 27 | check_deparse_identical(Sys.Date()) 28 | check_deparse_identical(as.POSIXct("2003-04-05 06:07:08 UTC")) 29 | check_deparse_identical(as.POSIXlt("2003-04-05 06:07:08 UTC")) 30 | }) 31 | 32 | test_that("deparse handles functions", { 33 | check_deparse_equal(function(x) x + 1) 34 | check_deparse_equal(mean) 35 | expect_output( 36 | print(deparsec(function(x) x + 1)), 37 | "function (x) x + 1", 38 | fixed = TRUE) 39 | expect_output( 40 | print(deparsec(function(x) x + 1), useSource = FALSE), 41 | "srcref_call", 42 | fixed = TRUE) 43 | }) 44 | 45 | test_that("deparse handles factors", { 46 | check_deparse_identical(factor(1:5)) 47 | check_deparse_identical(factor(1:5, levels = c(3:1))) 48 | check_deparse_identical(ordered(LETTERS)) 49 | }) 50 | 51 | test_that("deparse handles data.frames", { 52 | check_deparse_identical(data.frame(x = 1:5, y = 4, z = LETTERS[1:5])) 53 | check_deparse_identical( 54 | data.frame( 55 | x = 1:5, y = 4, z = LETTERS[1:5], row.names = 6:10 56 | ) 57 | ) 58 | check_deparse_identical(tibble::tibble(x = 1:5, y = 4, z = LETTERS[1:5])) 59 | 60 | # Check as_tribble works ok 61 | check_deparse_identical(tibble::tibble(x = 1:5, y = 4, z = LETTERS[1:5]), as_tribble = TRUE) 62 | check_deparse_identical(tibble::tibble(x = 1:3, y = list(4:6, 7:9, 10:15))) 63 | 64 | # Check as_tribble works ok for more complex types 65 | 66 | test_tbl <- tibble::tibble( 67 | x = as.Date(c("2013-01-02", "2014-02-03")), 68 | y = factor(c("A", "B"), levels = c("B", "A")) 69 | ) 70 | check_deparse_identical(test_tbl, as_tribble = TRUE) 71 | expect_warning( 72 | deparse(test_tbl, as_tribble = TRUE, generate_mutate = FALSE), 73 | "deparsed code may not function correctly" 74 | ) 75 | 76 | # Check as_tibble warns appropriately for row.names 77 | expect_warning( 78 | deparse(data.frame(x = 1, row.names = "A"), as_tibble = TRUE), 79 | "row.names are not supported by `tibble`", 80 | fixed = TRUE 81 | ) 82 | }) 83 | -------------------------------------------------------------------------------- /tests/testthat/test-output.R: -------------------------------------------------------------------------------- 1 | context("output") 2 | 3 | test_that("known output", { 4 | expect_output_file(cat(deparse(iris, as_tibble = TRUE), sep = "\n"), "out/iris-tibble.txt", update = TRUE) 5 | expect_output_file(cat(deparse(iris, as_tribble = TRUE), sep = "\n"), "out/iris-tribble.txt", update = TRUE) 6 | }) 7 | -------------------------------------------------------------------------------- /vignettes/calls.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Pretty calls" 3 | author: "Kirill Müller" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Pretty calls} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | The default `print()` method prints the source if available (from a srcref attribute) for expression objects, but not for calls. See below for an example (run in R 3.3.1). 13 | 14 | It looks like this change has been introduced in R 2.10.0, in [revision r48366](https://github.com/wch/r-source/commit/107f16133e3db7#diff-12de104c9320556f0e99da345c6fb259L650) [2], but it hasn't been documented explicitly. I'm wondering if calls should use an attached srcref for printing. For now, `deparse` uses the class `"srcref_call"` with an overridden `print()` method. 15 | 16 | 17 | ## Construct and parse a simple call 18 | 19 | ```{r } 20 | text <- "a(\n)" 21 | text 22 | 23 | ex <- parse(text = text, srcfile = srcfilecopy("dump.R", text)) 24 | ``` 25 | 26 | Returns an "expression", it uses the srcref for printing 27 | 28 | ```{r } 29 | ex 30 | attributes(ex) 31 | ``` 32 | 33 | ## Extract the call, attach srcref attributes 34 | 35 | ```{r } 36 | cl <- ex[[1]] 37 | attr(cl, "srcref") <- attr(ex, "srcref")[[1]] 38 | attr(cl, "srcfile") <- attr(ex, "srcfile") 39 | attr(cl, "wholeSrcref") <- attr(ex, "wholeSrcref") 40 | ``` 41 | 42 | The call does *not* use the srcref for printing 43 | 44 | ```{r } 45 | cl 46 | ``` 47 | 48 | ## Hack around it 49 | 50 | ```{r } 51 | print.call <- function(x, ..., useSource = TRUE) { 52 | print(attr(x, "wholeSrcref"), ...) 53 | } 54 | ``` 55 | 56 | Now works as expected 57 | 58 | ```{r } 59 | print(cl) 60 | ``` 61 | --------------------------------------------------------------------------------