1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
#' Tibble constructor and validator
#'
#' @description
#' Creates or validates a subclass of a tibble.
#' These function is mostly useful for package authors that implement subclasses
#' of a tibble, like \pkg{sf} or \pkg{tsibble}.
#'
#' `new_tibble()` creates a new object as a subclass of `tbl_df`, `tbl` and `data.frame`.
#' This function is optimized for performance, checks are reduced to a minimum.
#' See [vctrs::new_data_frame()] for details.
#'
#' @param x A tibble-like object.
#' @param ... Name-value pairs of additional attributes.
#' @param nrow The number of rows, inferred from `x` if omitted.
#' @param class Subclasses to assign to the new object, default: none.
#' @param subclass Deprecated, retained for compatibility. Please use the `class` argument.
#'
#' @seealso
#' [tibble()] and [as_tibble()] for ways to construct a tibble
#' with recycling of scalars and automatic name repair,
#' and [vctrs::df_list()] and [vctrs::new_data_frame()]
#' for lower-level implementations.
#'
#' @export
#' @examples
#' # The nrow argument is always required:
#' new_tibble(list(a = 1:3, b = 4:6), nrow = 3)
#'
#' # Existing row.names attributes are ignored:
#' try(validate_tibble(new_tibble(trees, nrow = 3)))
#'
#' # The length of all columns must be compatible with the nrow argument:
#' try(validate_tibble(new_tibble(list(a = 1:3, b = 4:6), nrow = 2)))
new_tibble <- function(x, ..., nrow = NULL, class = NULL, subclass = NULL) {
# For compatibility with tibble < 2.0.0
if (is.null(class) && !is.null(subclass)) {
deprecate_soft("2.0.0", "tibble::new_tibble(subclass = )", "new_tibble(class = )")
class <- subclass
}
#' @section Construction:
#'
#' For `new_tibble()`, `x` must be a list.
x <- unclass(x)
if (!is.list(x)) {
cnd_signal(error_new_tibble_must_be_list())
}
#' The `nrow` argument may be omitted as of tibble 3.1.4.
#' If present, every element of the list `x` should have [vctrs::vec_size()]
#' equal to this value.
#' (But this is not checked by the constructor).
#' This takes the place of the "row.names" attribute in a data frame.
if (!is.null(nrow)) {
if (!is.numeric(nrow) || length(nrow) != 1 || nrow < 0 || !is_integerish(nrow, 1) || nrow >= 2147483648) {
cnd_signal(error_new_tibble_nrow_must_be_nonnegative())
}
nrow <- as.integer(nrow)
}
args <- attributes(x)
if (is.null(args)) {
args <- list()
}
new_attrs <- pairlist2(...)
nms <- names(new_attrs)
for (i in seq_along(nms)) {
nm <- nms[[i]]
if (nm == "") {
next
}
args[[nm]] <- new_attrs[[i]]
}
#' `x` must have names (or be empty),
#' but the names are not checked for correctness.
if (length(x) == 0) {
# Leaving this because creating a named list of length zero seems difficult
args[["names"]] <- character()
} else if (is.null(args[["names"]])) {
cnd_signal(error_names_must_be_non_null())
}
if (is.null(class)) {
class <- tibble_class_no_data_frame
} else {
class <- c(class[!class %in% tibble_class], tibble_class_no_data_frame)
}
slots <- c("x", "n", "class")
args[slots] <- list(x, nrow, class)
# `new_data_frame()` restores compact row names
# Can't add to the assignment above, a literal NULL would be inserted otherwise
args[["row.names"]] <- NULL
# need exec() to avoid evaluating language attributes (e.g. rsample)
exec(new_data_frame, !!!args)
}
#' @description
#' `validate_tibble()` checks a tibble for internal consistency.
#' Correct behavior can be guaranteed only if this function
#' runs without raising an error.
#'
#' @rdname new_tibble
#' @export
validate_tibble <- function(x) {
#' @section Validation:
#' `validate_tibble()` checks for "minimal" names
check_minimal_names(x)
#' and that all columns are vectors, data frames or matrices.
check_valid_cols(unclass(x))
#' It also makes sure that all columns have the same length,
#' and that [vctrs::vec_size()] is consistent with the data.
validate_nrow(names(x), col_lengths(x), vec_size(x))
x
}
cnd_signal_if <- function(x) {
if (!is.null(x)) {
cnd_signal(x)
}
}
check_minimal <- function(name) {
cnd_signal_if(cnd_names_non_null(name))
cnd_signal_if(cnd_names_non_na(name))
}
check_minimal_names <- function(x) {
check_minimal(names(x))
invisible(x)
}
col_lengths <- function(x) {
map_int(x, vec_size)
}
validate_nrow <- function(names, lengths, nrow) {
# Validate column lengths, don't recycle
bad_len <- which(lengths != nrow)
if (has_length(bad_len)) {
cnd_signal(error_incompatible_size(nrow, names, lengths, "Requested with `nrow` argument"))
}
}
tibble_class <- c("tbl_df", "tbl", "data.frame")
tibble_class_no_data_frame <- c("tbl_df", "tbl")
# Errors ------------------------------------------------------------------
error_new_tibble_must_be_list <- function() {
tibble_error("`x` must be a list.")
}
error_new_tibble_nrow_must_be_nonnegative <- function() {
tibble_error("`nrow` must be a nonnegative whole number smaller than 2^31.")
}
|
