Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
174 views
in Technique[技术] by (71.8m points)

r - Copying dimnames without copying objects?

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?

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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).


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...