Я собираюсь опровергнуть свой комментарий и привести пример, который потенциально может сработать, но это то, что некоторые (включая меня) назвали бы "ужасным взломом":

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

Если вы используете скобки вместо знаков доллара для ссылки на столбец, это сработает:

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

d[TPT] == d[LBTPT]

Боюсь, однако, что он отвечает всем вашим потребностям.

Я считаю, что вы можете сделать это с помощью R6 и активных привязок.

• Методы R6 относятся к объектам, а не к дженерикам.
• Объекты R6 изменяемы: обычная семантика копирования при изменении не применяется.

Имея это в виду, мы можем создать пример. Здесь мы создаем два представления набора данных радужной оболочки глаза, где мы получаем доступ к одному и тому же столбцу, используя два разных имени столбца. При изменении имени любого столбца будет обновлен общий набор данных частной радужной оболочки глаза.

Я поклонник R6, поскольку он предлагает способ поддерживать (в данном случае) семантику ссылок на фреймы данных, позволяя при этом использовать несколько способов ссылки на набор данных.

nb. Надеюсь, это укажет вам правильное направление.

Пример R6 (здесь мы создаем два представления набора данных радужной оболочки глаза):

require(R6)
data(iris)

dataframe_factory <- R6Class(
  "dataframe_factory",
  portable = FALSE,
  lock_objects = FALSE,
  private = list(
    ..iris_data = iris
  ),
  active = list(
    # add the binding here
    Sepal.Length = function(x, ...) {
      if ( missing(x) ) {
        private$..iris_data$Sepal.Length
      } else {
        private$..iris_data$Sepal.Length[...] <<- x
      }
    },

    another.Sepal.Length = function(x, ...) {
      if ( missing(x) ) {
        private$..iris_data$Sepal.Length
      } else {
        private$..iris_data$Sepal.Length[...] <<- x
      }
    }
    )
)

# Create the DataFrame
my_Dataframe <- dataframe_factory$new()

# Retrieve the alias
my_Dataframe$Sepal.Length
my_Dataframe$another.Sepal.Length

my_Dataframe$Sepal.Length[1] <- 5
my_Dataframe$Sepal.Length[1]

my_Dataframe$another.Sepal.Length[2] <- 8
my_Dataframe$another.Sepal.Length[2]

my_Dataframe$Sepal.Length
my_Dataframe$another.Sepal.Length

head(my_Dataframe$Sepal.Length,2)
my_Dataframe$Sepal.Length[1:2]

identical(my_Dataframe$Sepal.Length, my_Dataframe$another.Sepal.Length)
identical(my_Dataframe$Sepal.Length[1], my_Dataframe$another.Sepal.Length[1])
identical(my_Dataframe$Sepal.Length[1:2], my_Dataframe$another.Sepal.Length[1:2])

Вывод консоли R6 на консоль:

> require(R6)

> data(iris)

> dataframe_factory <- R6Class(
+   "dataframe_factory",
+   portable = FALSE,
+   lock_objects = FALSE,
+   private = list(
+     ..iris_data = iris
 .... [TRUNCATED] 

> # Create the DataFrame
> my_Dataframe <- dataframe_factory$new()

> # Retrieve the alias
> my_Dataframe$Sepal.Length
  [1] 5.1 4.9 4.7 4.6 5.0 5.4 4.6 5.0 4.4 4.9 5.4 4.8 4.8 4.3 5.8 5.7 5.4 5.1 5.7 5.1
 [21] 5.4 5.1 4.6 5.1 4.8 5.0 5.0 5.2 5.2 4.7 4.8 5.4 5.2 5.5 4.9 5.0 5.5 4.9 4.4 5.1
 [41] 5.0 4.5 4.4 5.0 5.1 4.8 5.1 4.6 5.3 5.0 7.0 6.4 6.9 5.5 6.5 5.7 6.3 4.9 6.6 5.2
 [61] 5.0 5.9 6.0 6.1 5.6 6.7 5.6 5.8 6.2 5.6 5.9 6.1 6.3 6.1 6.4 6.6 6.8 6.7 6.0 5.7
 [81] 5.5 5.5 5.8 6.0 5.4 6.0 6.7 6.3 5.6 5.5 5.5 6.1 5.8 5.0 5.6 5.7 5.7 6.2 5.1 5.7
[101] 6.3 5.8 7.1 6.3 6.5 7.6 4.9 7.3 6.7 7.2 6.5 6.4 6.8 5.7 5.8 6.4 6.5 7.7 7.7 6.0
[121] 6.9 5.6 7.7 6.3 6.7 7.2 6.2 6.1 6.4 7.2 7.4 7.9 6.4 6.3 6.1 7.7 6.3 6.4 6.0 6.9
[141] 6.7 6.9 5.8 6.8 6.7 6.7 6.3 6.5 6.2 5.9

> my_Dataframe$another.Sepal.Length
  [1] 5.1 4.9 4.7 4.6 5.0 5.4 4.6 5.0 4.4 4.9 5.4 4.8 4.8 4.3 5.8 5.7 5.4 5.1 5.7 5.1
 [21] 5.4 5.1 4.6 5.1 4.8 5.0 5.0 5.2 5.2 4.7 4.8 5.4 5.2 5.5 4.9 5.0 5.5 4.9 4.4 5.1
 [41] 5.0 4.5 4.4 5.0 5.1 4.8 5.1 4.6 5.3 5.0 7.0 6.4 6.9 5.5 6.5 5.7 6.3 4.9 6.6 5.2
 [61] 5.0 5.9 6.0 6.1 5.6 6.7 5.6 5.8 6.2 5.6 5.9 6.1 6.3 6.1 6.4 6.6 6.8 6.7 6.0 5.7
 [81] 5.5 5.5 5.8 6.0 5.4 6.0 6.7 6.3 5.6 5.5 5.5 6.1 5.8 5.0 5.6 5.7 5.7 6.2 5.1 5.7
[101] 6.3 5.8 7.1 6.3 6.5 7.6 4.9 7.3 6.7 7.2 6.5 6.4 6.8 5.7 5.8 6.4 6.5 7.7 7.7 6.0
[121] 6.9 5.6 7.7 6.3 6.7 7.2 6.2 6.1 6.4 7.2 7.4 7.9 6.4 6.3 6.1 7.7 6.3 6.4 6.0 6.9
[141] 6.7 6.9 5.8 6.8 6.7 6.7 6.3 6.5 6.2 5.9

> my_Dataframe$Sepal.Length[1] <- 5

> my_Dataframe$Sepal.Length[1]
[1] 5

> my_Dataframe$another.Sepal.Length[2] <- 8

> my_Dataframe$another.Sepal.Length[2]
[1] 8

> my_Dataframe$Sepal.Length
  [1] 5.0 8.0 4.7 4.6 5.0 5.4 4.6 5.0 4.4 4.9 5.4 4.8 4.8 4.3 5.8 5.7 5.4 5.1 5.7 5.1
 [21] 5.4 5.1 4.6 5.1 4.8 5.0 5.0 5.2 5.2 4.7 4.8 5.4 5.2 5.5 4.9 5.0 5.5 4.9 4.4 5.1
 [41] 5.0 4.5 4.4 5.0 5.1 4.8 5.1 4.6 5.3 5.0 7.0 6.4 6.9 5.5 6.5 5.7 6.3 4.9 6.6 5.2
 [61] 5.0 5.9 6.0 6.1 5.6 6.7 5.6 5.8 6.2 5.6 5.9 6.1 6.3 6.1 6.4 6.6 6.8 6.7 6.0 5.7
 [81] 5.5 5.5 5.8 6.0 5.4 6.0 6.7 6.3 5.6 5.5 5.5 6.1 5.8 5.0 5.6 5.7 5.7 6.2 5.1 5.7
[101] 6.3 5.8 7.1 6.3 6.5 7.6 4.9 7.3 6.7 7.2 6.5 6.4 6.8 5.7 5.8 6.4 6.5 7.7 7.7 6.0
[121] 6.9 5.6 7.7 6.3 6.7 7.2 6.2 6.1 6.4 7.2 7.4 7.9 6.4 6.3 6.1 7.7 6.3 6.4 6.0 6.9
[141] 6.7 6.9 5.8 6.8 6.7 6.7 6.3 6.5 6.2 5.9

> my_Dataframe$another.Sepal.Length
  [1] 5.0 8.0 4.7 4.6 5.0 5.4 4.6 5.0 4.4 4.9 5.4 4.8 4.8 4.3 5.8 5.7 5.4 5.1 5.7 5.1
 [21] 5.4 5.1 4.6 5.1 4.8 5.0 5.0 5.2 5.2 4.7 4.8 5.4 5.2 5.5 4.9 5.0 5.5 4.9 4.4 5.1
 [41] 5.0 4.5 4.4 5.0 5.1 4.8 5.1 4.6 5.3 5.0 7.0 6.4 6.9 5.5 6.5 5.7 6.3 4.9 6.6 5.2
 [61] 5.0 5.9 6.0 6.1 5.6 6.7 5.6 5.8 6.2 5.6 5.9 6.1 6.3 6.1 6.4 6.6 6.8 6.7 6.0 5.7
 [81] 5.5 5.5 5.8 6.0 5.4 6.0 6.7 6.3 5.6 5.5 5.5 6.1 5.8 5.0 5.6 5.7 5.7 6.2 5.1 5.7
[101] 6.3 5.8 7.1 6.3 6.5 7.6 4.9 7.3 6.7 7.2 6.5 6.4 6.8 5.7 5.8 6.4 6.5 7.7 7.7 6.0
[121] 6.9 5.6 7.7 6.3 6.7 7.2 6.2 6.1 6.4 7.2 7.4 7.9 6.4 6.3 6.1 7.7 6.3 6.4 6.0 6.9
[141] 6.7 6.9 5.8 6.8 6.7 6.7 6.3 6.5 6.2 5.9

> head(my_Dataframe$Sepal.Length,2)
[1] 5 8

> my_Dataframe$Sepal.Length[1:2]
[1] 5 8

> identical(my_Dataframe$Sepal.Length, my_Dataframe$another.Sepal.Length)
[1] TRUE

> identical(my_Dataframe$Sepal.Length[1], my_Dataframe$another.Sepal.Length[1])
[1] TRUE

> identical(my_Dataframe$Sepal.Length[1:2], my_Dataframe$another.Sepal.Length[1:2])
[1] TRUE

В итоге я использовал комбинацию стратегий из @ 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")

Редактировать

$.data.frame был удален из R между R 3.5 и R 3.6, поэтому вот новое решение:

df <- head(iris)
comment(df) <- c(SL = "Sepal.Length",SW = "Sepal.Width")

`$.data.frame` <- function(e1,e2) {
  if (e2 %in% names(comment(e1)))
     e2 <- comment(e1)[e2]
  eval.parent(substitute(as.list(e1)$e2))
}

df$SL
# [1] 5.1 4.9 4.7 4.6 5.0 5.4

identical(df$SL,df$Sepal.Length)
# [1] TRUE 

предыдущее решение

Вот действительно быстрый трюк с использованием функций / атрибутов comment и comment<- и функции trace:

df <- head(iris)
comment(df) <- c(SL = "Sepal.Length",SW = "Sepal.Width")
trace(`$.data.frame`,quote(if (name %in% names(comment(df)))
  name <- comment(df)[name]),print=FALSE)

df$SL
# [1] 5.1 4.9 4.7 4.6 5.0 5.4

identical(df$SL,df$Sepal.Length)
# [1] TRUE

атрибут комментария не печатается по умолчанию, как это делали бы другие, чтобы увидеть его, вызовите:

comment(df)

Отмените вызов trace с помощью:

 untrace(`$.data.frame`)

Пример из @ Technophobe01 хорош, но не очень практичен. Вы всегда должны писать для каждого псевдонима новую функцию и новое определение класса. Много работы!

Исходя из Лиспа, я думал о вашей проблеме. В Лиспе в таких случаях можно определить макросы для поиска псевдонимов. Самая крутая вещь - reader-macros. С помощью макросов-читателей вы можете изменить способ, которым интерпретатор Лиспа «видит» код. Чаще всего макросы читателя начинаются с #.

Однако мы не на Лиспе. Мы находимся в R. У нас нет этих возможностей.

Единственный способ в R позволить R "читать" выражение с другими правилами - это - либо переопределить метод $ (возможно, однажды я предложу это решение - или кто-то другой ... - но есть одно большое препятствие, что $ примитивный - нам не повезло ...), либо тогда: вы использовать функцию (в моем случае: with.alias() сокращено до: a() для alias), внутри которой изменяются правила. Я пошел по этому пути.

С моим решением вы можете сделать что-то вроде этого:

Как это будет работать

# your normal data frame definition
df <- data.frame(LBTPT = 1:3)

# now df contains:
df
##   LBTPT
## 1     1
## 2     2
## 3     3


# define your aliases for each data frame in this form:
define.alias(df, list("LBTPT" = "TPT"))
# within the `define.alias()` function, you give as the first argument
# the data frame symbol, for which aliases should be defined.
# the second argument is a list of "original name" = "alias" definitions.

# This is how you call your data frame with the alias name:
a(df$TPT) # returns what d$LBTPT returns  
         ## actually `with.alias` but shortened to: `a`
# call within `a()` or `with.alias()` the data frame with the aliased column name.
# the function then looks up in the attributes `aliases` of the data frame 
# the original name of the alias for the column and
# returns the value of the originally named column.

Определите всего три функции

Вот как вы определяете функции define.alias() и with.alias() и краткую форму a():

define.alias <- function(df, alias.list) {
  # revert definition list
  l <- names(alias.list)
  names(l) <- alias.list
  l <- as.list(l)

  # metaprogrammatically assign "aliases" attribute to data frame
  df <- substitute(df)
  alias.list <- substitute(l)
  eval(bquote(attr(.(df), "aliases") <- .(alias.list)), env = parent.env(environment()))
}

.with.alias <- function(df.expr) {
  exp <- df.expr
  df <- exp[[2]]
  l <- eval(bquote(attr(.(exp[[2]]), "aliases")), env = parent.env(environment()))
  eval(bquote(substitute(.(exp), l)))
} 

with.alias <- function(df.expr) {
  exp <- substitute(df.expr)
  l <- eval(bquote(attr(.(exp[[2]]), "aliases")), env = parent.env(environment()))
  if (exp[[1]] == "<-") {
    l <- eval(bquote(attr(.(exp[[2]][[2]]), "aliases")), env = parent.env(environment()))
    eval(eval(bquote(substitute(.(.with.alias(exp[[2]])) <- .(exp[[3]])))), env = parent.env(environment()))
  } else {
    df <- exp[[2]]
    eval(eval(bquote(substitute(.(exp), l))), env = parent.env(environment()))
  }
} # that's it! works!

Совет: вы можете сэкономить на вводе, определив:

# make `with.aliases` shorter:
a <- with.aliases

## and now:
a(df$TPT) # works, too!

Что ж, но мне нужно еще поработать над методами '<-'. Однако простое назначение в a работает.

a(df$TPT <- new.vetor)  # assigns correctly
a(df$TPT[3] <- 3)       # but this not yet ...

Если вы используете data.table, тогда есть встроенный псевдоним. Вы можете

• Используйте data.table
• Создайте список исходных имен столбцов
• Измените нужные вам столбцы, это будет просто указатель, а не копия.
• Подключите эту таблицу к своим функциям.
• Поменять имена обратно.

a <- data.table::as.data.table(survival::bladder)
originalNames <- data.table::copy(names(a))   # Create a copy of the original names
originalNames
b <- a  # Allias the data.table.  Not really needed.
data.table::setnames(b, old = 'event', new = "LBTPT")
dplyr::glimpse(b)  #  names in both data tables are changed
dplyr::glimpse(a)  #  names in both data tables are changed
data.table::setnames(a, old = names(b), new = originalNames)  # Change back to old names when you are done
dplyr::glimpse(a)  # Back to original