Skip to content

Commit cc8acfa

Browse files
haniyakonainhaniyakonain
authored
Update data.table.R
1 parent 17fb438 commit cc8acfa

File tree

1 file changed

+144
-111
lines changed

1 file changed

+144
-111
lines changed

‎R/data.table.R‎

Lines changed: 144 additions & 111 deletions
Original file line numberDiff line numberDiff line change
@@ -1146,80 +1146,84 @@ replace_dot_alias = function(e) {
11461146
names(jsub)=""
11471147
jsub[[1L]]=as.name("list")
11481148
}
1149-
av = all.vars(jsub,TRUE)
1150-
if (!is.atomic(lhs)) stopf("LHS of := must be a symbol, or an atomic vector (column names or positions).")
1151-
if (is.character(lhs)) {
1152-
m = chmatch(lhs, names_x)
1153-
} else if (is.numeric(lhs)) {
1154-
m = as.integer(lhs)
1155-
if (any(m<1L | ncol(x)<m)) stopf("LHS of := appears to be column positions but are outside [1,ncol] range. New columns can only be added by name.")
1156-
lhs = names_x[m]
1157-
} else
1158-
stopf("LHS of := isn't column names ('character') or positions ('integer' or 'numeric')")
1159-
if (!anyNA(m)) {
1160-
# updates by reference to existing columns
1161-
cols = as.integer(m)
1162-
newnames=NULL
1163-
if (identical(irows, integer())) {
1164-
# Empty integer() means no rows e.g. logical i with only FALSE and NA
1165-
# got converted to empty integer() by the which() above
1166-
# Short circuit and do-nothing since columns already exist. If some don't
1167-
# exist then for consistency with cases where irows is non-empty, we need to create
1168-
# them of the right type and populate with NA. Which will happen via the regular
1169-
# alternative branches below, to cover #759.
1170-
# We need this short circuit at all just for convenience. Otherwise users may need to
1171-
# fix errors in their RHS when called on empty edge cases, even when the result won't be
1172-
# used anyway (so it would be annoying to have to fix it.)
1173-
if (verbose) {
1174-
catf("No rows match i. No new columns to add so not evaluating RHS of :=\nAssigning to 0 row subset of %d rows\n", nrow(x))
1175-
}
1176-
.Call(Cassign, x, irows, NULL, NULL, NULL) # only purpose is to write 0 to .Last.updated
1177-
.global$print = address(x)
1178-
return(invisible(x))
1179-
}
1180-
} else {
1181-
# Adding new column(s). TO DO: move after the first eval in case the jsub has an error.
1182-
newnames=setdiff(lhs, names_x)
1183-
m[is.na(m)] = ncol(x)+seq_along(newnames)
1184-
cols = as.integer(m)
1185-
# don't pass verbose to selfrefok here -- only activated when
1186-
# ok=-1 which will trigger setalloccol with verbose in the next
1187-
# branch, which again calls _selfrefok and returns the message then
1188-
if ((ok<-selfrefok(x, verbose=FALSE))==0L) # ok==0 so no warning when loaded from disk (-1) [-1 considered TRUE by R]
1189-
if (is.data.table(x)) warningf("A shallow copy of this data.table was taken so that := can add or remove %d columns by reference. At an earlier point, this data.table was copied by R (or was created manually using structure() or similar). Avoid names<- and attr<- which in R currently (and oddly) may copy the whole data.table. Use set* syntax instead to avoid copying: ?set, ?setnames and ?setattr. It's also not unusual for data.table-agnostic packages to produce tables affected by this issue. If this message doesn't help, please report your use case to the data.table issue tracker so the root cause can be fixed or this message improved.", length(newnames))
1190-
# !is.data.table for DF |> DT(,:=) tests 2212.16-19 (#5113) where a shallow copy is routine for data.frame
1191-
if ((ok<1L) || (truelength(x) < ncol(x)+length(newnames))) {
1192-
DT = x # in case getOption contains "ncol(DT)" as it used to. TODO: warn and then remove
1193-
n = length(newnames) + eval(getOption("datatable.alloccol")) # TODO: warn about expressions and then drop the eval()
1194-
# i.e. reallocate at the size as if the new columns were added followed by setalloccol().
1195-
name = substitute(x)
1196-
if (is.name(name) && ok && verbose) { # && NAMED(x)>0 (TO DO) # ok here includes -1 (loaded from disk)
1197-
catf("Growing vector of column pointers from truelength %d to %d. A shallow copy has been taken, see ?setalloccol. Only a potential issue if two variables point to the same data (we can't yet detect that well) and if not you can safely ignore this. To avoid this message you could setalloccol() first, deep copy first using copy(), wrap with suppressWarnings() or increase the 'datatable.alloccol' option.\n", truelength(x), n)
1198-
# #1729 -- copying to the wrong environment here can cause some confusion
1199-
if (ok == -1L) catf("Note that the shallow copy will assign to the environment from which := was called. That means for example that if := was called within a function, the original table may be unaffected.\n")
1200-
1201-
# Verbosity should not issue warnings, so cat rather than warning.
1202-
# TO DO: Add option 'datatable.pedantic' to turn on warnings like this.
1203-
1204-
# TO DO ... comments moved up from C ...
1205-
# Note that the NAMED(dt)>1 doesn't work because .Call
1206-
# always sets to 2 (see R-ints), it seems. Work around
1207-
# may be possible but not yet working. When the NAMED test works, we can drop allocwarn argument too
1208-
# because that's just passed in as FALSE from [<- where we know `*tmp*` isn't really NAMED=2.
1209-
# Note also that this growing will happen for missing columns assigned NULL, too. But so rare, we
1210-
# don't mind.
1211-
}
1212-
setalloccol(x, n, verbose=verbose) # always assigns to calling scope; i.e. this scope
1213-
if (is.name(name)) {
1214-
assign(as.character(name),x,parent.frame(),inherits=TRUE)
1215-
} else if (.is_simple_extraction(name)) {
1216-
assign_to_extracted_target(name, x, parent.frame())
1217-
}
1218-
}
1149+
1150+
av = all.vars(jsub, TRUE)
1151+
if (!is.atomic(lhs)) stopf("LHS of := must be a symbol, or an atomic vector (column names or positions).")
1152+
if (is.character(lhs)) {
1153+
m = chmatch(lhs, names_x)
1154+
} else if (is.numeric(lhs)) {
1155+
m = as.integer(lhs)
1156+
if (any(m<1L | ncol(x)<m)) stopf("LHS of := appears to be column positions but are outside [1,ncol] range. New columns can only be added by name.")
1157+
lhs = names_x[m]
1158+
} else
1159+
stopf("LHS of := isn't column names ('character') or positions ('integer' or 'numeric')")
1160+
1161+
if (!anyNA(m)) {
1162+
# updates by reference to existing columns
1163+
cols = as.integer(m)
1164+
newnames = NULL
1165+
if (identical(irows, integer())) {
1166+
# Empty integer() means no rows e.g. logical i with only FALSE and NA
1167+
# got converted to empty integer() by the which() above
1168+
# Short circuit and do-nothing since columns already exist. If some don't
1169+
# exist then for consistency with cases where irows is non-empty, we need to create
1170+
# them of the right type and populate with NA. Which will happen via the regular
1171+
# alternative branches below, to cover #759.
1172+
# We need this short circuit at all just for convenience. Otherwise users may need to
1173+
# fix errors in their RHS when called on empty edge cases, even when the result won't be
1174+
# used anyway (so it would be annoying to have to fix it.)
1175+
if (verbose) {
1176+
catf("No rows match i. No new columns to add so not evaluating RHS of :=\nAssigning to 0 row subset of %d rows\n", nrow(x))
1177+
}
1178+
.Call(Cassign, x, irows, NULL, NULL, NULL) # only purpose is to write 0 to .Last.updated
1179+
.global$print = address(x)
1180+
return(invisible(x))
1181+
}
1182+
} else {
1183+
# Adding new column(s). TO DO: move after the first eval in case the jsub has an error.
1184+
newnames = setdiff(lhs, names_x)
1185+
m[is.na(m)] = ncol(x) + seq_along(newnames)
1186+
cols = as.integer(m)
1187+
# don't pass verbose to selfrefok here -- only activated when
1188+
# ok=-1 which will trigger setalloccol with verbose in the next
1189+
# branch, which again calls _selfrefok and returns the message then
1190+
if ((ok <- selfrefok(x, verbose=FALSE)) == 0L) { # ok==0 so no warning when loaded from disk (-1) [-1 considered TRUE by R]
1191+
if (is.data.table(x)) warningf("A shallow copy of this data.table was taken so that := can add or remove %d columns by reference. At an earlier point, this data.table was copied by R (or was created manually using structure() or similar). Avoid names<- and attr<- which in R currently (and oddly) may copy the whole data.table. Use set* syntax instead to avoid copying: ?set, ?setnames and ?setattr. It's also not unusual for data.table-agnostic packages to produce tables affected by this issue. If this message doesn't help, please report your use case to the data.table issue tracker so the root cause can be fixed or this message improved.", length(newnames))
1192+
# !is.data.table for DF |> DT(,:=) tests 2212.16-19 (#5113) where a shallow copy is routine for data.frame
1193+
}
1194+
if ((ok < 1L) || (truelength(x) < ncol(x) + length(newnames))) {
1195+
DT = x # in case getOption contains "ncol(DT)" as it used to. TODO: warn and then remove
1196+
n = length(newnames) + eval(getOption("datatable.alloccol")) # TODO: warn about expressions and then drop the eval()
1197+
# i.e. reallocate at the size as if the new columns were added followed by setalloccol().
1198+
name = substitute(x)
1199+
if (is.name(name) && ok && verbose) { # && NAMED(x)>0 (TO DO) # ok here includes -1 (loaded from disk)
1200+
catf("Growing vector of column pointers from truelength %d to %d. A shallow copy has been taken, see ?setalloccol. Only a potential issue if two variables point to the same data (we can't yet detect that well) and if not you can safely ignore this. To avoid this message you could setalloccol() first, deep copy first using copy(), wrap with suppressWarnings() or increase the 'datatable.alloccol' option.\n", truelength(x), n)
1201+
# #1729 -- copying to the wrong environment here can cause some confusion
1202+
if (ok == -1L) catf("Note that the shallow copy will assign to the environment from which := was called. That means for example that if := was called within a function, the original table may be unaffected.\n")
1203+
# Verbosity should not issue warnings, so cat rather than warning.
1204+
# TO DO: Add option 'datatable.pedantic' to turn on warnings like this.
1205+
# TO DO ... comments moved up from C ...
1206+
# Note that the NAMED(dt)>1 doesn't work because .Call
1207+
# always sets to 2 (see R-ints), it seems. Work around
1208+
# may be possible but not yet working. When the NAMED test works, we can drop allocwarn argument too
1209+
# because that's just passed in as FALSE from [<- where we know `*tmp*` isn't really NAMED=2.
1210+
# Note also that this growing will happen for missing columns assigned NULL, too. But so rare, we
1211+
# don't mind.
1212+
}
1213+
setalloccol(x, n, verbose=verbose) # always assigns to calling scope; i.e. this scope
1214+
if (is.name(name)) {
1215+
assign(as.character(name), x, parent.frame(), inherits=TRUE)
1216+
} else if (.is_simple_extraction(name)) { # TODO(#6702): use a helper here as the code is very similar to setDT().
1217+
if (!handle_list_env_assign(name, x, error_on_missing = FALSE, check_length = TRUE)) {
1218+
# Handle the S4 case which isn't in the helper function
1219+
k = eval(name[[2L]], parent.frame(), parent.frame())
1220+
if (isS4(k)) {
1221+
.Call(CsetS4elt, k, as.character(name[[3L]]), x)
12191222
}
12201223
}
1221-
}
1222-
1224+
} # TO DO: else if env$<- or list$<- what to remove and add
1225+
}
1226+
}
12231227
if (length(ansvars)) {
12241228
w = ansvals
12251229
if (length(rightcols) && missingby) {
@@ -2915,53 +2919,48 @@ setDT = function(x, keep.rownames=FALSE, key=NULL, check.names=FALSE) {
29152919
}
29162920
}
29172921

2918-
rn = if (!identical(keep.rownames, FALSE)) rownames(x) else NULL
2919-
setattr(x, "row.names", .set_row_names(nrow(x)))
2920-
if (check.names) setattr(x, "names", make.names(names(x), unique=TRUE))
2921-
# fix for #1078 and #1128, see .resetclass() for explanation.
2922-
setattr(x, "class", .resetclass(x, 'data.frame'))
2923-
setalloccol(x)
2924-
if (!is.null(rn)) {
2925-
nm = c(if (is.character(keep.rownames)) keep.rownames[1L] else "rn", names(x))
2926-
x[, (nm[1L]) := rn]
2927-
setcolorder(x, nm)
2928-
}
2929-
} else if (is.list(x) && length(x)==1L && is.matrix(x[[1L]])) {
2930-
# a single list(matrix) is unambiguous and depended on by some revdeps, #3581
2931-
x = as.data.table.matrix(x[[1L]])
2932-
} else if (is.null(x) || (is.list(x) && !length(x))) {
2933-
x = null.data.table()
2934-
} else if (is.list(x)) {
2935-
# copied from as.data.table.list - except removed the copy
2936-
nrow = .Call(Csetdt_nrows, x)
2937-
2938-
xn = names(x)
2939-
if (is.null(xn)) {
2940-
setattr(x, "names", paste0("V", seq_along(x)))
2941-
} else {
2942-
idx = !nzchar(xn) # NB: keepNA=FALSE intentionally, see test 1006
2943-
if (any(idx)) {
2944-
xn[idx] = paste0("V", seq_along(which(idx)))
2945-
setattr(x, "names", xn)
2946-
}
2947-
if (check.names) setattr(x, "names", make.names(xn, unique=TRUE))
2948-
}
2949-
setattr(x, "row.names", .set_row_names(nrow))
2950-
setattr(x, "class", c("data.table", "data.frame"))
2951-
setalloccol(x)
2922+
rn = if (!identical(keep.rownames, FALSE)) rownames(x) else NULL
2923+
setattr(x, "row.names", .set_row_names(nrow(x)))
2924+
if (check.names) setattr(x, "names", make.names(names(x), unique=TRUE))
2925+
# fix for #1078 and #1128, see .resetclass() for explanation.
2926+
setattr(x, "class", .resetclass(x, 'data.frame'))
2927+
setalloccol(x)
2928+
if (!is.null(rn)) {
2929+
nm = c(if (is.character(keep.rownames)) keep.rownames[1L] else "rn", names(x))
2930+
x[, (nm[1L]) := rn]
2931+
setcolorder(x, nm)
2932+
} else if (is.list(x) && length(x)==1L && is.matrix(x[[1L]])) {
2933+
# a single list(matrix) is unambiguous and depended on by some revdeps, #3581
2934+
x = as.data.table.matrix(x[[1L]])
2935+
} else if (is.null(x) || (is.list(x) && !length(x))) {
2936+
x = null.data.table()
2937+
} else if (is.list(x)) {
2938+
# copied from as.data.table.list - except removed the copy
2939+
nrow = .Call(Csetdt_nrows, x)
2940+
xn = names(x)
2941+
if (is.null(xn)) {
2942+
setattr(x, "names", paste0("V", seq_along(x)))
29522943
} else {
2953-
stopf("Argument 'x' to 'setDT' should be a 'list', 'data.frame' or 'data.table'")
2944+
idx = !nzchar(xn) # NB: keepNA=FALSE intentionally, see test 1006
2945+
if (any(idx)) {
2946+
xn[idx] = paste0("V", seq_along(which(idx)))
2947+
setattr(x, "names", xn)
2948+
}
2949+
if (check.names) setattr(x, "names", make.names(xn, unique=TRUE))
29542950
}
2951+
setattr(x, "row.names", .set_row_names(nrow))
2952+
setattr(x, "class", c("data.table", "data.frame"))
2953+
setalloccol(x)
2954+
} else {
2955+
stopf("Argument 'x' to 'setDT' should be a 'list', 'data.frame' or 'data.table'")
2956+
}
29552957
if (!is.null(key)) setkeyv(x, key)
29562958
if (is.name(name)) {
29572959
name = as.character(name)
29582960
assign(name, x, parent.frame(), inherits = TRUE)
29592961
} else if (.is_simple_extraction(name)) {
2962+
# Use the helper function we created earlier
29602963
assign_to_extracted_target(name, x, parent.frame())
2961-
} else if (is.environment(k) && exists(as.character(name[[3L]]), k)) {
2962-
assign(as.character(name[[3L]]), x, k, inherits = FALSE)
2963-
} else if (isS4(k)) {
2964-
.Call(CsetS4elt, k, as.character(name[[3L]]), x)
29652964
} else if (name %iscall% "get") { # #6725
29662965
# edit 'get(nm, env)' call to be 'assign(nm, x, envir=env)'
29672966
name = match.call(get, name)
@@ -3445,3 +3444,37 @@ assign_to_extracted_target <- function(name, x, parent_env=parent.frame()) {
34453444
.Call(CsetS4elt, k, as.character(name[[3L]]), x)
34463445
}
34473446
}
3447+
# Helper function to handle $ and [[ indexing in list/environment assignments
3448+
handle_list_env_assign <- function(name, x, error_on_missing = TRUE, check_length = TRUE) {
3449+
if (name %iscall% c('$', '[[') && is.name(name[[2L]])) {
3450+
k = eval(name[[2L]], parent.frame(2), parent.frame(2))
3451+
3452+
if (is.list(k)) {
3453+
origj = j = if (name[[1L]] == "$") as.character(name[[3L]])
3454+
else eval(name[[3L]], parent.frame(2), parent.frame(2))
3455+
3456+
if (is.character(j)) {
3457+
if (check_length && length(j) != 1L) {
3458+
stopf("Cannot assign to an under-allocated recursively indexed list -- L[[i]][,:=] syntax is only valid when i is length 1, but its length is %d", length(j))
3459+
}
3460+
3461+
j = match(j, names(k))
3462+
if (is.na(j)) {
3463+
if (error_on_missing) {
3464+
stopf("Item '%s' not found in names of input list", origj)
3465+
} else {
3466+
internal_error("item '%s' not found in names of list", origj) # nocov
3467+
}
3468+
}
3469+
}
3470+
3471+
.Call(Csetlistelt, k, as.integer(j), x)
3472+
return(TRUE)
3473+
} else if (is.environment(k) && exists(as.character(name[[3L]]), k)) {
3474+
assign(as.character(name[[3L]]), x, k, inherits=FALSE)
3475+
return(TRUE)
3476+
}
3477+
}
3478+
3479+
return(FALSE)
3480+
}

0 commit comments

Comments
 (0)