R语言如何实现data.frame作为多类对象容器并按行保留自定义类

需求为使用data.frame作为容器存储多个不同自定义类的对象，每一行对应一个独立对象，按行取子集时返回对应类的对象，预期行为参考如下代码：

a <- constructor_a(x=1, y=2, z='t')
b <- constructor_b(x=3, y=5)
c <- constructor_c(y=11, u=TRUE, w = 'st')

mycontainer <- make_container(a, b, c)
mycontainer
##  x    y    z    u    w
##1 1    2    't'  NA   NA
##2 3    5    NA   NA   NA
##3 NA   11   NA   TRUE 'st'

class(mycontainer)
## "data.frame"

class(mycontainer[1, ])
## "class_a"

class(mycontainer[2, ])
## "class_b"

class(mycontainer[3, ])
## "class_c"

初始实现的make_container如下，但运行后所有行取子集的类均为第一个输入对象的类，无法达到预期：

make_container <- function(...) {
    dots <- list(...)
    out <- rbind(...)
    for (i in seq_along(dots)) {
        class(out[i, ]) <- class(dots[[i]])
    }
    out
}

已知data.frame底层类型为list，理论上可作为通用对象容器，但直接给存储多类对象的list设置data.frame类无法正常运行，需要可行修复方案及不限制输入为data.frame的通用实现。

原生data.frame的设计以列为存储单元，没有预留行级元数据（比如每行的自定义类）的存储位置，初始代码存在两个核心问题：

1. 循环中class(out[i, ]) <- class(dots[[i]])操作的是out[i, ]生成的临时副本，修改不会生效到原对象上；
2. 原生[.data.frame子集方法会统一给返回结果设置data.frame类，没有逻辑读取每行的自定义类，即使强行修改行属性也会在子集时被覆盖。

核心思路是：将每行对应的类作为特殊属性存储在容器对象中，给容器增加自定义S3子类，重写行子集方法，在取单行时自动给返回结果挂载对应类。

针对data.frame输入的修复版 #

该版本兼容输入为data.frame子类的场景，自动对齐所有输入的列，缺失列填充NA：

make_container <- function(...) {
  dots <- list(...)
  # 收集所有输入的列名，补全缺失列
  all_cols <- unique(unlist(lapply(dots, names)))
  filled_dots <- lapply(dots, function(obj) {
    miss_cols <- setdiff(all_cols, names(obj))
    obj[miss_cols] <- NA
    obj[, all_cols]
  })
  # 转为普通data.frame后再合并，避免rbind继承第一个输入的自定义类
  out <- do.call(rbind, lapply(filled_dots, as.data.frame))
  rownames(out) <- NULL
  # 存储每行对应的原始类
  attr(out, "row_classes") <- lapply(dots, class)
  # 挂载自定义子类，优先触发自定义子集方法
  class(out) <- c("row_class_df", "data.frame")
  out
}

# 重写子集方法
`[.row_class_df` <- function(x, i, j, ..., drop = FALSE) {
  res <- NextMethod()
  # 仅在取整行（单行）时设置对应自定义类
  if (!missing(i) && length(i) == 1 && (missing(j) || length(j) == ncol(x))) {
    class(res) <- attr(x, "row_classes")[[i]]
  }
  res
}

测试验证：

# 构造测试对象
a <- data.frame(x=1, y=1.5)
class(a) <- c('class_a', 'data.frame')
b <- data.frame(x=2, y=2.2)
class(b) <- c('class_b', 'data.frame')
c <- data.frame(x=2, y=2.2)
class(c) <- c('class_c', 'data.frame')

mycontainer <- make_container(a,b,c)
class(mycontainer[1, ]) # 返回 c("class_a", "data.frame")
class(mycontainer[2, ]) # 返回 c("class_b", "data.frame")
class(mycontainer[3, ]) # 返回 c("class_c", "data.frame")

通用版实现（不限制输入类型） #

该版本支持任意S3对象作为输入，自动提取对象的公共字段作为列，额外新增.raw_obj列表列存储原始对象，避免字段类型不一致导致的异常：

make_container_generic <- function(...) {
  dots <- list(...)
  # 收集所有对象的字段名
  all_fields <- unique(unlist(lapply(dots, function(obj) names(as.list(obj)))))
  
  # 构造列数据
  col_list <- lapply(all_fields, function(f) {
    lapply(dots, function(obj) {
      val <- tryCatch(as.list(obj)[[f]], error = function(e) NA)
      if (is.null(val)) NA else val
    })
  })
  names(col_list) <- all_fields
  # 新增列存储原始对象
  col_list$.raw_obj <- dots

  # 原子类型列自动转为向量，非原子类型用list列存储
  out <- as.data.frame(lapply(col_list, function(col) {
    if (all(vapply(col, is.atomic, logical(1)))) {
      unlist(col)
    } else {
      I(col)
    }
  }))
  
  # 挂载行类属性和自定义子类
  attr(out, "row_classes") <- lapply(dots, class)
  class(out) <- c("row_class_df", "data.frame")
  out
}

使用时既可以像普通data.frame一样访问各字段列，也可以通过.raw_obj列直接获取原始对象，按行取子集时同样会返回对应自定义类的对象。

• data.frame本身不支持行级属性存储，所有行级自定义逻辑都需要通过重写S3方法+挂载特殊属性实现，不要试图直接修改行的类；
• 如果需要更稳定的打印、子集行为，可以基于tibble替换基础data.frame实现，逻辑完全一致，tibble默认不会自动丢弃维度，行为更可预测。

内容的提问来源于stack exchange，提问作者englealuze