Copying dimnames without copying objects? - r

Question

I could not find a prior question about this, but this one is fairly close.
Often I make new objects and want them to have the same dimnames (names, colnames, rownames) as some other object. Normally, I would use names, or rownames + colnames, but I'm tired of doing this and I want a better solution. I also want a solution that allows for partial matching, so I need a new function. My trouble is that it is apparently not quite easy to get it exactly right.
First, a helper function:
get_dims = function(x) {
if (is.null(dim(x))) {
return(length(x))
} else {
return(dim(x))
}
}
This gets the dimensions of any object. dim() returns NULL for atomic objects (vectors and lists), whereas it really should just return their length.
Next, we make up some minimal test data:
t = matrix(1:9, nrow=3)
t2 = t
rownames(t) = LETTERS[1:3]; colnames(t) = letters[1:3]
Inspect:
> t
a b c
A 1 4 7
B 2 5 8
C 3 6 9
> t2
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
The test is that t2 should get the dimnames of t. I print them because == apparently cannot handle list comparison (returns logical(0)).
A simple solution is to take in the object whose names I want to copy, the object where I want to copy them to, and simply change the dimnames in the function and return the object back. This can be done like this:
copy_names1 = function(x, y, partialmatching = T) {
#find object dimensions
x_dims = get_dims(x)
y_dims = get_dims(y)
#set names if matching dims
if (all(x_dims == y_dims)) {
#loop over each dimension
for (dim in 1:length(dimnames(x))) {
dimnames(y)[[dim]] <- dimnames(x)[[dim]]
}
}
return(y)
}
Test:
> copy_names1(t, t2)
a b c
A 1 4 7
B 2 5 8
C 3 6 9
So it works fine, but returns the object, which means one has to use the assignment operator, which is not needed with the normal *names() functions.
We can also assign from within the function using assign():
copy_names2 = function(x, y, partialmatching = T) {
#find object dimensions
x_dims = get_dims(x)
y_dims = get_dims(y)
#what is the object in y parameter?
y_obj_name = deparse(substitute(y))
#set names if matching dims
if (all(x_dims == y_dims)) {
#loop over each dimension
for (dim in 1:length(dimnames(x))) {
dimnames(y)[[dim]] <- dimnames(x)[[dim]]
}
}
#assign in the outer envir
assign(y_obj_name, pos = 1, value = y)
}
Test:
> copy_names2(t, t2)
> t2
a b c
A 1 4 7
B 2 5 8
C 3 6 9
It also works: it does not require using the assignment operator and returns silently. However, it does copy the object in RAM (I think) which is bad when using large objects. It would be better to call dimnames on the existing object without copying it. So I try that:
copy_names3 = function(x, y, partialmatching = T) {
#find object dimensions
x_dims = get_dims(x)
y_dims = get_dims(y)
#what is the object in y parameter?
y_obj_name = deparse(substitute(y))
get(y_obj_name, pos = -1) #test that it works
#set names if matching dims
if (all(x_dims == y_dims)) {
#loop over each dimension
for (dim in 1:length(dimnames(x))) {
dimnames(get(y_obj_name, pos = -1))[[dim]] <- dimnames(x)[[dim]]
}
}
}
Test:
> copy_names3(t, t2)
Error in dimnames(get(y_obj_name, pos = -1))[[dim]] <- dimnames(x)[[dim]] :
could not find function "get<-"
A very cryptic error! According to the previous question, get() cannot be used like this because it only fetches values, not assigns them. The persons writes to use assign() instead. However, in the documentation for assign() we find:
assign does not dispatch assignment methods, so it cannot be used to
set elements of vectors, names, attributes, etc.
How does one copy dimnames without copying objects with a function?

Answer 1

I'm not sure how the "partial matching" is supposed to work, but maybe this:
t = matrix(1:9, nrow=3)
t2 = t
t2 <- rbind(t2, 11:13)
rownames(t) = LETTERS[1:3]; colnames(t) = letters[1:3]
d <- dim(t) == dim(t2)
dimnames(t2)[d] <- dimnames(t)[d]
t2
# a b c
#[1,] 1 4 7
#[2,] 2 5 8
#[3,] 3 6 9
#[4,] 11 12 13
Edit:
Here is how you can do this from inside a "setter" function without eval(parse(...)):
t = matrix(1:9, nrow=3)
t2 = t
t2 <- rbind(t2, 11:13)
rownames(t) = LETTERS[1:3]; colnames(t) = letters[1:3]
fun <- function(x, template, ...) {
y <- substitute(x)
z <- substitute(template)
d <- dim(x) == dim(template)
expr <- bquote(dimnames(.(y))[.(d)] <- dimnames(.(z))[.(d)])
eval(expr, ...)
invisible(NULL)
}
fun(t2, t, .GlobalEnv)
t2
# a b c
#[1,] 1 4 7
#[2,] 2 5 8
#[3,] 3 6 9
#[4,] 11 12 13
Of course, if you need something really fast, you need to implement it in C (as was done with the dimnames<- function).

Answer 2

One solution is to run the dimnames call in the parent environment instead of inside the function. It can be done like this:
copy_names4 = function(x, y, partialmatching = T) {
library(stringr)
#find object dimensions
x_dims = get_dims(x)
y_dims = get_dims(y)
#what is the object in y parameter?
x_obj_name = deparse(substitute(x))
y_obj_name = deparse(substitute(y))
#set names if matching dims
if (all(x_dims == y_dims)) {
#loop over each dimension
for (dim in 1:length(dimnames(x))) {
str_call = str_c("dimnames(", y_obj_name, ")[[", dim, "]] <- dimnames(" ,x_obj_name, ")[[", dim, "]]")
eval(parse(text = str_call), parent.frame(1))
}
}
}
Test it:
> t2
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> copy_names4(t, t2)
> t2
a b c
A 1 4 7
B 2 5 8
C 3 6 9
Success!
But is it faster?
library(microbenchmark)
microbenchmark(copy_names1 = {t2 = copy_names1(t, t2)},
copy_names2 = copy_names2(t, t2),
copy_names4 = copy_names4(t, t2))
Results:
Unit: microseconds
expr min lq mean median uq max neval
copy_names1 8.778 10.6795 14.57945 11.9960 15.653 46.812 100
copy_names2 24.869 27.7950 38.62004 33.7925 39.937 202.168 100
copy_names4 466.067 478.9405 507.48058 494.4460 514.488 840.559 100
Surprisingly, the initial version was much faster, by about 40-50 times. However, the last one should be faster for large objects. Let's try a larger test:
#larger test
t = matrix(1:9000000, nrow=3000)
t2 = t
rownames(t) = sample(LETTERS[1:26], size = 3000, replace = T); colnames(t) = sample(letters[1:26], size = 3000, replace = T)
t[1:5, 1:5]
t2[1:5, 1:5]
microbenchmark(copy_names1 = {t2 = copy_names1(t, t2)},
copy_names2 = copy_names2(t, t2),
copy_names4 = copy_names4(t, t2))
Results:
Unit: milliseconds
expr min lq mean median uq max neval
copy_names1 4.146032 4.442115 33.09852 12.14201 13.00495 242.2970 100
copy_names2 4.229708 4.553877 41.39389 12.23739 20.12995 229.4899 100
copy_names4 5.104497 5.499469 44.42764 13.24267 21.41507 228.7731 100
Now they are about equally fast, though the first two are still slightly faster.