From 602b285a43310e065d317adc12ea81f7da522d1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 3 May 2019 13:00:09 +0200 Subject: [PATCH] Remove type_sum() specializations Use qualified access to vctrs functions vec_is() requires vctrs > 0.1.0 --- NAMESPACE | 7 --- R/type-sum.R | 62 +++++++++------------- R/zzz.R | 6 +++ tests/testthat/bw-out/list-narrow.txt | 2 +- tests/testthat/bw-out/lubridate.txt | 8 +-- tests/testthat/bw-out/time-digits-secs.txt | 2 +- tests/testthat/bw-out/time-posix.txt | 2 +- tests/testthat/out/list-narrow.txt | 2 +- tests/testthat/out/lubridate.txt | 8 +-- tests/testthat/out/time-digits-secs.txt | 2 +- tests/testthat/out/time-posix.txt | 2 +- tests/testthat/test-obj-sum.R | 20 +++---- 12 files changed, 52 insertions(+), 71 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a0bc52302..bf71d3c78 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -43,14 +43,7 @@ S3method(print,pillar_vertical) S3method(print,rif_shaft) S3method(print,spark) S3method(print,squeezed_colonnade) -S3method(type_sum,AsIs) -S3method(type_sum,Date) -S3method(type_sum,POSIXct) -S3method(type_sum,data.frame) S3method(type_sum,default) -S3method(type_sum,difftime) -S3method(type_sum,factor) -S3method(type_sum,ordered) export(colonnade) export(dim_desc) export(expect_known_display) diff --git a/R/type-sum.R b/R/type-sum.R index 96d62c8e3..feb3b978c 100644 --- a/R/type-sum.R +++ b/R/type-sum.R @@ -10,46 +10,32 @@ #' @export type_sum <- function(x) UseMethod("type_sum") -#' @export -type_sum.ordered <- function(x) "ord" -#' @export -type_sum.factor <- function(x) "fctr" -#' @export -type_sum.POSIXct <- function(x) "dttm" -#' @export -type_sum.difftime <- function(x) "drtn" -#' @export -type_sum.Date <- function(x) "date" -#' @export -type_sum.data.frame <- function(x) class(x)[[1]] -#' @export -type_sum.AsIs <- function(x) paste0("I<", type_sum(remove_as_is_class(x)), ">") #' @export type_sum.default <- function(x) { - if (!is.object(x)) { - switch(typeof(x), - logical = "lgl", - integer = "int", - double = "dbl", - character = "chr", - complex = "cpl", - builtin = , - special = , - closure = "fn", - environment = "env", - symbol = - if (is_missing(x)) { - "missing" - } else { - "sym" - }, - typeof(x) - ) - } else if (!isS4(x)) { - paste0("S3: ", class(x)[[1]]) - } else { - paste0("S4: ", methods::is(x)[[1]]) - } + if (is.object(x) || vec_is(x)) return(vctrs::vec_ptype_abbr(x)) + + switch(typeof(x), + builtin = , + special = , + closure = "fn", + environment = "env", + symbol = + if (is_missing(x)) { + "missing" + } else { + "sym" + }, + + typeof(x) + ) +} + +# vec_is() needs vctrs > 0.1.0 +# Defined in .onLoad() +vec_is <- NULL + +compat_vec_is <- function(x) { + is_vector(x) } #' @description diff --git a/R/zzz.R b/R/zzz.R index 6474daf0e..a1c399a17 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -16,6 +16,12 @@ NULL rm("strrep", inherits = TRUE) } + if (utils::packageVersion("vctrs") > "0.1.0") { + vec_is <<- get("vec_is", asNamespace("vctrs")) + } else { + vec_is <<- compat_vec_is + } + compat_lengths() invisible() diff --git a/tests/testthat/bw-out/list-narrow.txt b/tests/testthat/bw-out/list-narrow.txt index 73b568810..1640bba42 100644 --- a/tests/testthat/bw-out/list-narrow.txt +++ b/tests/testthat/bw-out/list-narrow.txt @@ -1,2 +1,2 @@ - -1s -2s -3s + +1s +2s +3s diff --git a/tests/testthat/bw-out/time-digits-secs.txt b/tests/testthat/bw-out/time-digits-secs.txt index c90de72b5..ad00f336a 100644 --- a/tests/testthat/bw-out/time-digits-secs.txt +++ b/tests/testthat/bw-out/time-digits-secs.txt @@ -1,3 +1,3 @@ - + 2017-07-28 18:04:35.0000 NA diff --git a/tests/testthat/bw-out/time-posix.txt b/tests/testthat/bw-out/time-posix.txt index 54def4c68..671c38e9e 100644 --- a/tests/testthat/bw-out/time-posix.txt +++ b/tests/testthat/bw-out/time-posix.txt @@ -1,3 +1,3 @@ - + 2017-07-28 18:04:35 NA diff --git a/tests/testthat/out/list-narrow.txt b/tests/testthat/out/list-narrow.txt index cbfd6f96c..648c7cf9b 100644 --- a/tests/testthat/out/list-narrow.txt +++ b/tests/testthat/out/list-narrow.txt @@ -1,2 +1,2 @@  - -1s -2s -3s + +1s +2s +3s diff --git a/tests/testthat/out/time-digits-secs.txt b/tests/testthat/out/time-digits-secs.txt index f89fc6456..33852aa7f 100644 --- a/tests/testthat/out/time-digits-secs.txt +++ b/tests/testthat/out/time-digits-secs.txt @@ -1,3 +1,3 @@ - + 2017-07-28 18:04:35.0000 NA diff --git a/tests/testthat/out/time-posix.txt b/tests/testthat/out/time-posix.txt index 20c5c848c..208c456d7 100644 --- a/tests/testthat/out/time-posix.txt +++ b/tests/testthat/out/time-posix.txt @@ -1,3 +1,3 @@ - + 2017-07-28 18:04:35 NA diff --git a/tests/testthat/test-obj-sum.R b/tests/testthat/test-obj-sum.R index 7274d98bd..f0d3407b1 100644 --- a/tests/testthat/test-obj-sum.R +++ b/tests/testthat/test-obj-sum.R @@ -2,32 +2,29 @@ context("obj_sum") # obj_sum ---------------------------------------------------------------- -test_that("shows only first class name for S4", { - A <- methods::setClass("A") - expect_equal(obj_sum(A), "S4: classGeneratorFunction") +test_that("forwards to vec_ptype_abbr() for S4", { + x <- methods::setClass("A") + expect_equal(obj_sum(x), vctrs::vec_ptype_abbr(x)) }) -test_that("shows only first class name for S3", { +test_that("forwards to vec_ptype_abbr() for S3", { x <- structure(list(), class = c("a", "b", "c")) - expect_equal(obj_sum(x), "S3: a") + expect_equal(obj_sum(x), vctrs::vec_ptype_abbr(x)) }) test_that("NULL handled specially", { expect_equal(obj_sum(NULL), "NULL") }) -test_that("data frame and tibbles include rows and cols", { - expect_equal(obj_sum(mtcars), paste0("data.frame [32 ", mult_sign(), " 11]")) -}) - -test_that("common data vectors treated as atomic", { +test_that("data frames and common data vectors have size summary", { expect_obj_sum_is_ptype <- function(x) { obj_sum <- obj_sum(x) - ptype <- vec_ptype_abbr(x) + ptype <- vctrs::vec_ptype_abbr(x) expect_equal(obj_sum, !! paste0(ptype, size_sum(x))) } + expect_obj_sum_is_ptype(mtcars) expect_obj_sum_is_ptype(factor(1:3)) expect_obj_sum_is_ptype(ordered(1:3)) expect_obj_sum_is_ptype(Sys.Date() + 1:3) @@ -42,7 +39,6 @@ test_that("less common objects get abbreviations", { expect_equal(type_sum(environment()), "env") expect_equal(type_sum(environment), "fn") expect_equal(type_sum(list), "fn") - expect_equal(type_sum(1i), "cpl") expect_equal(type_sum(quote(foo)), "sym") expect_equal(type_sum(expr()), "missing") })