是否可以在R中为data.frame名称添加别名

Question

在使用某些数据标准时，使用多种方式查看data.frame的列会更简单。作为一个具体的例子，当使用SDTM数据进行临床试验时，每种数据类型(如实验室或生命体征)都有一个用于时间点的列，用于实验室的名为"LBTPT“，用于生命体征的名为"VSTPT”。在加载数据时，理想情况下，我希望能够将该列称为"LBTPT“或"TPT”。

具体地说，我希望找到一种方法来完成以下工作：

d <- data.frame(LBTPT=1:3)
d <- alias_column(d, TPT="LBTPT")
d$TPT == d$LBTPT

但是，我希望数据只存储一次--它只是一个别名，而不是副本。

而且，对于加分，在与merge、names<-、bind_rows等函数交互时，它将以“按我的意思做”的方式工作。

Answer 1

我将反驳我自己的评论，并给你一个可能可行的例子，但这是一些人(包括我自己)会称之为“可怕的黑客”：

setClass("aliased.data.frame", contains="data.frame")

make_alias <- function(original_name, alias) {
  # make sure lazy evaluation doesn't bite us
  force(original_name)
  force(alias)

  setMethod("$", signature(x="aliased.data.frame"), function(x, name) {
    if (name == alias) name <- original_name
    x[[name]]
  })
}

在这个例子中，我本质上是隐藏$方法来应用“反走样”。您必须以类似的方式定义任何支持您的别名的泛型。举个例子，现在可以这样做了：

> make_alias("a", "b")
> adf <- new("aliased.data.frame", data.frame(a=1:2))
> adf$b
[1] 1 2
> adf$a == adf$b
[1] TRUE TRUE

会有一些棘手的方面需要考虑。例如，数据帧的默认$方法执行部分匹配：

> data.frame(aa=1:2)$a
[1] 1 2

Answer 2

如果您使用括号而不是美元符号来引用列，则可以这样做：

d <- data.frame(LBTPT=1:3)
LBTPT = "LBTPT"
TPT = "LBTPT"

d[TPT] == d[LBTPT]

然而，我恐怕它确实解决了你所有的必需品。

Answer 3

我最终使用了@Technophobe01和@Alexis的组合策略来生成以下解决方案：

library(methods)

setClass("dataframe_alias", representation=representation(data="data.frame", aliases="list"))

as.dataframe_alias <- function(x, aliases=list()) {
  new("dataframe_alias", data=as.data.frame(x), aliases=aliases)
}

as.data.frame.dataframe_alias <- function(x, ...) {
  x@data
}

`$.dataframe_alias` <- function(x, name) {
  x[[name]]
}

`[[.dataframe_alias` <- function(x, name, ...) {
  if (name %in% names(x@data)) {
    x@data[[name, ...]]
  } else if (name %in% names(x@aliases)) {
    x@data[[x@aliases[[name]], ...]]
  } else {
    stop(name, " is not a name or alias for the dataframe_alias.")
  }
}

names.dataframe_alias <- function(x) {
  ret <- names(x@data)
  attr(ret, "aliases") <- x@aliases
  ret
}

alias_or_name_to_name <- function(object, alias) {
  ret <- rep(NA_character_, length(alias))
  mask_original_name <- alias %in% names(object@data)
  mask_aliased_name <-
    !mask_original_name &
    alias %in% names(object@aliases)
  mask_no_name <- !(mask_original_name | mask_aliased_name)
  if (any(mask_no_name)) {
    stop("Some aliases are not recognized as an original or aliased name: ",
         paste(alias[mask_no_name], collapse=", "))
  }
  ret[mask_original_name] <- alias[mask_original_name]
  ret[mask_aliased_name] <- unlist(object@aliases[alias])
  ret
}

#' Add an alias to a dataframe_alias
#' 
#' @param object A dataframe_alias object
#' @param ... named aliases to add in the form \code{alias=original_name}
#' @param rm Remove the alias(es)?
#' @return The updated \code{object}
#' @export
alias.dataframe_alias <- function(object, ..., rm=FALSE) {
  args <- list(...)
  if (is.null(names(args))) {
    stop("Arguments must be named")
  } else if (any(names(args) %in% "")) {
    stop("All arguments must be named")
  } else if (!all(unlist(args) %in% names(object))) {
    # all arguments must map to actual data names (indirect alises are not
    # currently permitted)
    browser()
    stop("All arguments must map to original data names")
  }
  for (nm in names(args)) {
    object@aliases[[nm]] <- args[[nm]]
  }
  object
}

foo <- as.dataframe_alias(iris, aliases=list(foo="Sepal.Length"))
foo2 <- alias(foo, bar="Sepal.Length")