Add col_spec coercion method for data.frames

Also a as.character method for col_spec

Fixes #895

NEWS.md

@@ -8,6 +8,21 @@
   than signaling an error when given a connection for the `file` argument that
   contains no data. This makes the behavior consistent as when called with an
   empty file (@pralitp, #963).
+* It is now possible to generate a column specification from any tibble (or
+  data.frame) with `as.col_spec()` and convert any column specification to a
+  short representation with `as.character()`
+
+    s <- as.col_spec(iris)
+    s
+    #> cols(
+    #>   Sepal.Length = col_double(),
+    #>   Sepal.Width = col_double(),
+    #>   Petal.Length = col_double(),
+    #>   Petal.Width = col_double(),
+    #>   Species = col_factor(levels = c("setosa", "versicolor", "virginica"), ordered = FALSE, include_na = FALSE)
+    #> )
+    as.character(s)
+    #> [1] "ddddf"
 
 # readr 1.3.1
 

R/col_types.R

@@ -127,6 +127,77 @@ as.col_spec.default <- function(x) {
   stop("`col_types` must be NULL, a list or a string", call. = FALSE)
 }
 
+type_to_col <- function(x, ...) {
+  UseMethod("type_to_col")
+}
+
+#' @export
+type_to_col.default <- function(x, ...) {
+  col_character()
+}
+
+#' @export
+type_to_col.logical <- function(x, ...) {
+  col_logical()
+}
+
+#' @export
+type_to_col.integer <- function(x, ...) {
+  col_integer()
+}
+
+#' @export
+type_to_col.double <- function(x, ...) {
+  col_double()
+}
+
+#' @export
+type_to_col.factor <- function(x, ...) {
+  col_factor(levels = levels(x), ordered = is.ordered(x), include_na = any(is.na(levels(x))))
+}
+
+#' @export
+type_to_col.Date <- function(x, ...) {
+  col_date()
+}
+
+#' @export
+type_to_col.POSIXct <- function(x, ...) {
+  col_datetime()
+}
+
+#' @export
+type_to_col.hms <- function(x, ...) {
+  col_time()
+}
+
+#' @export
+as.col_spec.data.frame <- function(x) {
+  as.col_spec(lapply(x, type_to_col))
+}
+
+col_to_short <- function(x, ...) {
+  switch(class(x)[[1]],
+    collector_skip = "-",
+    collector_guess = "?",
+    collector_character = "c",
+    collector_factor = "f",
+    collector_double = "d",
+    collector_integer = "i",
+    collector_number = "n",
+    collector_date = "D",
+    collector_datetime = "T",
+    collector_time = "t"
+  )
+}
+
+#' @export
+as.character.col_spec <- function(x, ...) {
+  paste0(collapse = "",
+    vapply(x$cols, col_to_short, character(1))
+  )
+}
+
 #' @export
 print.col_spec <- function(x, n = Inf, condense = NULL, colour = crayon::has_color(), ...) {
   cat(format.col_spec(x, n = n, condense = condense, colour = colour, ...))

tests/testthat/test-col-spec.R

@@ -259,3 +259,20 @@ test_that("check_guess_max errors on invalid inputs", {
 test_that("as.col_types can handle named character input", {
   expect_equal(as.col_spec(c(a = "c")), cols(a = col_character()))
 })
+
+test_that("as.col_types can convert data.frame", {
+  spec <- as.col_spec(iris)
+  exp <- cols(
+    Sepal.Length = col_double(),
+    Sepal.Width = col_double(),
+    Petal.Length = col_double(),
+    Petal.Width = col_double(),
+    Species = col_factor(levels = c("setosa", "versicolor", "virginica"), ordered = FALSE, include_na = FALSE)
+  )
+  expect_equal(spec, exp)
+})
+
+test_that("as.character() works on col_spec objects", {
+  spec <- as.col_spec(iris)
+  expect_equal(as.character(spec), "ddddf")
+})