diff --git a/R/onLoad.R b/R/onLoad.R index ef06327..778f231 100644 --- a/R/onLoad.R +++ b/R/onLoad.R @@ -828,6 +828,8 @@ register_S3_method("vctrs", "vec_ptype_abbr", "declared") register_S3_method("vctrs", "vec_ptype_full", "declared") + register_S3_method("vctrs", "vec_proxy", "declared") + register_S3_method("vctrs", "vec_restore", "declared") # register_S3_method("vctrs", "vec_ptype2", "declared") register_S3_method("vroom", "output_column", "declared") diff --git a/R/vctrs.R b/R/vctrs.R index bc2599a..4de4d03 100644 --- a/R/vctrs.R +++ b/R/vctrs.R @@ -3,6 +3,43 @@ # labelled and pillar these functions will be registered when or if the package # vctrs is loaded +`vec_proxy.declared` <- function (x, ...) { + return (undeclare(x, drop=TRUE)) +} + +`vec_restore.declared` <- function(x, to, ...) { + new_attrs <- attributes(to) + + misvals <- all_missing_values ( + x, + new_attrs$na_values, + new_attrs$na_range, + new_attrs$labels + ) + + na_index <- which(is.element(x, misvals)) + + if (length(na_index) > 0) { + declared_nas <- x[na_index] + + if (new_attrs$date) { + declared_nas <- as.numeric (declared_nas) + } + + x[na_index] <- NA + names(na_index) <- declared_nas + } + else { + na_index <- NULL + } + + new_attrs$na_index <- na_index + + attributes(x) <- new_attrs + + return (x) +} + `vec_ptype_abbr.declared` <- function (x, ...) { command <- "vctrs::vec_ptype_abbr(vctrs::vec_data(unclass (undeclare (x))))" return (