From 9d6a2e0cf714c269c4277b3792d2a810e84c18ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 31 Jul 2021 16:34:47 +0200 Subject: [PATCH 1/5] Explicit symbol assignment, with conversion to UTF-8 --- R/subsetting.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/subsetting.R b/R/subsetting.R index 8caea8445..b9630e965 100644 --- a/R/subsetting.R +++ b/R/subsetting.R @@ -167,7 +167,9 @@ NULL } # Side effect: check scalar - if (!is.symbol(j)) { + if (is.symbol(j)) { + j <- as_utf8_character(j) + } else { if (!is.vector(j) || length(j) != 1L || is.na(j) || (is.numeric(j) && j < 0) || is.logical(j)) { vectbl_as_col_location2(j, length(x), j_arg = j_arg, assign = TRUE) } From 9be66c02066ff60bd82a996c109a53ce05226092 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 31 Jul 2021 16:33:37 +0200 Subject: [PATCH 2/5] Set names to j --- R/subsetting.R | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/R/subsetting.R b/R/subsetting.R index b9630e965..0d9e1858d 100644 --- a/R/subsetting.R +++ b/R/subsetting.R @@ -419,11 +419,13 @@ tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg) { if (is.null(j)) { j <- seq_along(x) + names(j) <- names2(j) } else if (!is.null(j_arg)) { j <- vectbl_as_new_col_index(j, x, j_arg, names2(value), value_arg) } value <- vectbl_recycle_rhs(value, fast_nrow(x), length(j), i_arg = NULL, value_arg) + xo <- tbl_subassign_col(x, j, value) } else if (is.null(i_arg)) { # x[NULL, ...] <- value @@ -490,7 +492,7 @@ vectbl_as_new_row_index <- function(i, x, i_arg) { vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { # Creates a named index vector # Values: index - # Name: column name (for new columns) + # Name: column name (for all columns) if (is_bare_character(j)) { if (anyNA(j)) { @@ -526,6 +528,7 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { names[new][names[new] == ""] <- paste0("...", j_new) } + names[j <= length(x)] <- names(x)[ j[j <= length(x)] ] j <- set_names(j, names) } else { j <- vectbl_as_col_location(j, length(x), names(x), j_arg = j_arg, assign = TRUE) @@ -533,6 +536,9 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { if (anyNA(j)) { cnd_signal(error_na_column_index(which(is.na(j)))) } + + names[j <= length(x)] <- names(x)[ j[j <= length(x)] ] + j <- set_names(j, names) } if (anyDuplicated(j)) { @@ -594,18 +600,27 @@ is_tight_sequence_at_end <- function(i_new, n) { } tbl_subassign_col <- function(x, j, value) { + # Assertion + stopifnot(!is.null(names(j)) || length(j) == 0) + is_data <- !vapply(value, is.null, NA) nrow <- fast_nrow(x) x <- unclass(x) # Grow, assign new names - new <- which(j > length(x)) + new_pos <- (j > length(x)) + new <- which(new_pos) + + # Grow, assign new names if (has_length(new)) { length(x) <- max(j[new]) names(x)[ j[new] ] <- names2(j)[new] } + # This must work now + names(x)[ j[!new_pos] ] <- names2(j)[!new_pos] + # Update for (jj in which(is_data)) { ji <- j[[jj]] From 52ad45ee1edbf89e5f4eef581b395dbc40eec402 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 31 Jul 2021 17:06:29 +0200 Subject: [PATCH 3/5] Clean up --- R/subsetting.R | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/R/subsetting.R b/R/subsetting.R index 0d9e1858d..c35ffc5fd 100644 --- a/R/subsetting.R +++ b/R/subsetting.R @@ -499,12 +499,13 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { cnd_signal(error_assign_columns_non_na_only()) } - out <- match(j, names(x)) - new <- which(is.na(out)) + names <- j + + j <- match(names, names(x)) + new <- which(is.na(j)) if (has_length(new)) { - out[new] <- seq.int(length(x) + 1L, length.out = length(new)) + j[new] <- seq.int(length(x) + 1L, length.out = length(new)) } - j <- set_names(out, j) } else if (is_bare_numeric(j)) { if (anyNA(j)) { cnd_signal(error_assign_columns_non_na_only()) @@ -512,7 +513,8 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { j <- numtbl_as_col_location_assign(j, length(x), j_arg = j_arg) - new <- which(j > length(x)) + old <- (j <= length(x)) + new <- which(!old) j_new <- j[new] if (length(names) != 1L) { @@ -528,8 +530,7 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { names[new][names[new] == ""] <- paste0("...", j_new) } - names[j <= length(x)] <- names(x)[ j[j <= length(x)] ] - j <- set_names(j, names) + names[old] <- names(x)[ j[old] ] } else { j <- vectbl_as_col_location(j, length(x), names(x), j_arg = j_arg, assign = TRUE) @@ -537,15 +538,15 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) { cnd_signal(error_na_column_index(which(is.na(j)))) } - names[j <= length(x)] <- names(x)[ j[j <= length(x)] ] - j <- set_names(j, names) + old <- (j <= length(x)) + names[old] <- names(x)[ j[old] ] } if (anyDuplicated(j)) { cnd_signal(error_duplicate_column_subscript_for_assignment(j)) } - j + set_names(j, names) } numtbl_as_row_location_assign <- function(i, n, i_arg) { From b3ab924ae8ee4f5a7b97a4ecaab06bba030a53a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 31 Jul 2021 17:19:37 +0200 Subject: [PATCH 4/5] Adapt to rlang 0.4.11 --- R/subsetting.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/subsetting.R b/R/subsetting.R index c35ffc5fd..a7ec62e7d 100644 --- a/R/subsetting.R +++ b/R/subsetting.R @@ -168,7 +168,8 @@ NULL # Side effect: check scalar if (is.symbol(j)) { - j <- as_utf8_character(j) + # FIXME: as_utf8_character() needs rlang > 0.4.11 + j <- chr_unserialise_unicode(as.character(j)) } else { if (!is.vector(j) || length(j) != 1L || is.na(j) || (is.numeric(j) && j < 0) || is.logical(j)) { vectbl_as_col_location2(j, length(x), j_arg = j_arg, assign = TRUE) From 49db3924842a1149849e916ed2733032fcacd1a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 31 Jul 2021 17:37:51 +0200 Subject: [PATCH 5/5] Remove assertions --- R/subsetting.R | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/R/subsetting.R b/R/subsetting.R index a7ec62e7d..f6a4b2d56 100644 --- a/R/subsetting.R +++ b/R/subsetting.R @@ -602,27 +602,18 @@ is_tight_sequence_at_end <- function(i_new, n) { } tbl_subassign_col <- function(x, j, value) { - # Assertion - stopifnot(!is.null(names(j)) || length(j) == 0) - is_data <- !vapply(value, is.null, NA) nrow <- fast_nrow(x) x <- unclass(x) # Grow, assign new names - new_pos <- (j > length(x)) - new <- which(new_pos) - - # Grow, assign new names + new <- which(j > length(x)) if (has_length(new)) { length(x) <- max(j[new]) names(x)[ j[new] ] <- names2(j)[new] } - # This must work now - names(x)[ j[!new_pos] ] <- names2(j)[!new_pos] - # Update for (jj in which(is_data)) { ji <- j[[jj]]