Question

我找不到关于此的先前问题，但this one非常接近。

我经常创建新对象，并希望它们与其他对象具有相同的dimnames（names，colnames，rownames）。通常情况下，我会使用names或rownames + colnames，但我已经厌倦了这样做，我想要一个更好的解决方案。我还想要一个允许部分匹配的解决方案，所以我需要一个新功能。我的麻烦在于，完全正确地完成它显然并不容易。

首先，辅助函数：

get_dims = function(x) {
  if (is.null(dim(x))) {
    return(length(x))
    } else {
    return(dim(x))
  }
}

这可以获取任何对象的尺寸。 dim()为原子对象（向量和列表）返回NULL，而它实际上应该返回它们的长度。

接下来，我们编制一些最小的测试数据：

t = matrix(1:9, nrow=3)
t2 = t
rownames(t) = LETTERS[1:3]; colnames(t) = letters[1:3]

检查：

> 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

测试是t2应该得到t的dimnames。我打印它们是因为==显然无法处理列表比较（返回logical(0)）。

一个简单的解决方案是接收我想要复制其名称的对象，我想要复制它们的对象，并简单地更改函数中的dimnames并返回该对象。这可以这样做：

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

测试：

> copy_names1(t, t2)
  a b c
A 1 4 7
B 2 5 8
C 3 6 9

所以它工作正常，但返回对象，这意味着必须使用赋值运算符，而普通的* names()函数不需要它。

我们也可以使用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)
}

测试：

> copy_names2(t, t2)
> t2
  a b c
A 1 4 7
B 2 5 8
C 3 6 9

它也有效：它不需要使用赋值运算符并以静默方式返回。但是，它会复制RAM中的对象（我认为），这在使用大对象时是不好的。最好在现有对象上调用dimnames而不复制它。所以我试试看：

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]]
    }
  }
}

测试：

> copy_names3(t, t2)
Error in dimnames(get(y_obj_name, pos = -1))[[dim]] <- dimnames(x)[[dim]] : 
  could not find function "get<-"

一个非常神秘的错误！根据上一个问题，get()不能像这样使用，因为它只获取值，而不是赋值。这些人写信使用assign()代替。但是，在assign()的文档中，我们发现：

assign不调度赋值方法，因此不能用于设置向量，名称，属性等元素。

如何在不使用函数复制对象的情况下复制dimnames？

Answer 1

一种解决方案是在父环境中而不是在函数内部运行dimnames调用。可以这样做：

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

测试它：

> 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

成功！

但它更快吗？

library(microbenchmark)
microbenchmark(copy_names1 = {t2 = copy_names1(t, t2)},
               copy_names2 = copy_names2(t, t2),
               copy_names4 = copy_names4(t, t2))

结果：

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

令人惊讶的是，初始版本更快，大约40-50倍。但是，对于大型对象，最后一个应该更快。让我们尝试更大的测试：

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

结果：

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

现在它们的速度同样快，但前两个仍然稍快一些。

复制dimnames而不复制对象？

1 个答案: