For example:
dt <- data.table()
x=1:5
> dt[,list(2,3,x)]
V1 V2 x
1: 2 3 1
2: 2 3 2
3: 2 3 3
4: 2 3 4
5: 2 3 5
The resulting data.table has column x
For some reason, I would like to create a function to simplify data.table construction.
tt <- function(a, b, ...){
list(a=sum(a), b=sum(b), ...)
}
> dt[,tt(1:2,1:3,x)]
a b V3
1: 3 6 1
2: 3 6 2
3: 3 6 3
4: 3 6 4
5: 3 6 5
So whenever I call list
, I use tt
instead, so it auto inserts predefined columns for me.
However, now it doesn't recognize the shortcut naming for x
.
How to improve tt
to auto name column like list
in data.table if it is not too hard?
Aim
dt[,tt(1:2,1:3,x)]
Returns
a b x
1: 3 6 1
2: 3 6 2
3: 3 6 3
4: 3 6 4
5: 3 6 5
Solution
tt <- function(a, b, ...){
dots <- list(...)
inferred <- sapply(substitute(list(...)), function(x) deparse(x)[1])[-1]
if(is.null(names(inferred))){
names(dots) <- inferred
} else {
names(dots)[names(inferred) == ""] <- inferred[names(inferred) == ""]
}
c(a=sum(a), b=sum(b), dots)
}
dt <- data.table(c=1:5)
x=1:5
> dt[,tt(1:2,1:3,x,c+1)]
a b x c + 1
1: 3 6 1 2
2: 3 6 2 3
3: 3 6 3 4
4: 3 6 4 5
5: 3 6 5 6
> dt[,tt(1:2,1:3,x, z=c+1)]
a b x z
1: 3 6 1 2
2: 3 6 2 3
3: 3 6 3 4
4: 3 6 4 5
5: 3 6 5 6
Update
Recently I found that there was some bug in page 46 of S Programming from Venables & Ripley. I made some modifications and put it here. Hopefully it would be useful to some people.
# Get the best names vector for arguments like what data.frame does.
# Modified from page 46 of S Programming from Venables & Ripley.
# http://stackoverflow.com/questions/20545476/how-does-data-table-get-the-column-name-from-j
name.args <- function(...){
# Get a list of arguments.
dots <- as.list(substitute(list(...)))[-1]
# Get names of the members if they have, otherwise "".
# If a list have no named members, it returns NULL.
nm <- names(dots)
# If all arguments are named, return the names directly.
# Otherwise it would cause a problem when do nm[logic(0)] <- list().
if (!is.null(nm) && all(nm != ""))
return(nm)
# Handle empty argument list case.
if (length(dots) == 0)
return(character(0))
# Get positions of arguments without names.
fixup <-
if (is.null(nm))
seq(along=dots)
else
nm == ""
dep <- sapply(dots[fixup], function(x) deparse(x)[1])
if (is.null(nm))
dep
else {
nm[fixup] <- dep
nm
}
}
# Example
# x <- 1:2
# name.args(x, y=3, 5:6)
# name.args(x=x, y=3)
# name.args()