嵌套类实例 (OOP) 上的 R 方法答案

【问题标题】：R methods on nested class instances (OOP)嵌套类实例 (OOP) 上的 R 方法
【发布时间】：2020-12-26 22:06:34
【问题描述】：

我有我的学生 S3 班级

# a constructor function for the "student" class
student <- function(n,a,g) {
  # we can add our own integrity checks
  if(g>4 || g<0)  stop("GPA must be between 0 and 4")
  value <- list(name = n, age = a, GPA = g)
  # class can be set using class() or attr() function
  attr(value, "class") <- "student"
  value
}

我要定义类groupofstudents：

stud1 <- student("name1", 20, 2.5)
stud2 <- student("name2", 21, 3.5)
groupofstudents <- function(firststud = stud1, secondstud = stud2) {
  value <- list(firststud = stud1, secondstud = stud2)
  attr(value, "class") <- "groupofstudents"
  value
}
gr <- groupofstudents()

但是如果一个类包含来自其他类的数百个其他实例，这似乎不是很有效。

我所追求的是为groupofstudents中的所有学生定义可以修改字段的方法：

getolder <- function(x) UseMethod("getolder")
getolder.groupofstudents <- function(x, years=1) {
  x$firststud$age <- x$firststud$age+year
  x$secondstud$age <- x$secondstud$age+year
  x
}

推荐的方法是什么？

在组的所有学生上编辑以下调用getolder.student，但学生没有被修改。

getolder <- function(x) UseMethod("getolder")
getolder.student <- function(x, years=1) {
  print("getolder.student called")
  x$age <- x$age +1
  x
}
getolder.groupofstudents <- function(x, years=1) {
  y <- lapply(x$slist, getolder.student)
  y
}

getolder(gr) #age increases by 1 
stud1 # unchanged, would need to change
stud2 # unchanged, would need to change

EDIT2 这不会改变gr 和stud1, stud2

groupofstudents <- function(slist=NULL) {
  value <- list(slist)
  attr(value, "class") <- "groupofstudents"
  value
}
getolder.groupofstudents <- function(x, years=1) {
  #x$slist <- lapply(x$slist, function(y) getolder.student(y, years))
  lapply(ls(), function(y) {y1 <- get(y); if(inherits(y1, "student")) assign(y, getolder(y1), envir = .GlobalEnv)})
  x
}
gr <- groupofstudents(slist = list("stud1"=stud1, "stud2"=stud2))
gr <- getolder(gr,years=3)
stud1

干杯

【问题讨论】：

OO 可能不是这里最好的方法。将学生定义为一个 3 列数据框，每行一个学生，一组作为标识行子集的名称的字符向量。

标签： r class oop methods

【解决方案1】：

R6 是我需要的框架。

    # R6 ----------------------------------------------------------------------
student <- R6Class("student", list(
  age = 0,
  initialize = function(age = 20) {
    #stopifnot(is.character(name), length(name) == 1)
    stopifnot(is.numeric(age), length(age) == 1)
    
    #self$name <- name
    self$age <- age
  },
  getolder = function(years = 1) {
    self$age <- self$age + years 
    invisible(self)
  }
  )
)

student$new()
stud1 <- student$new(age = 15)
stud1$getolder(3)
stud1$age #18
stud2 <- student$new(age = 15)

group <- R6Class("group", list(
  s1 = NA,
  s2 = NA,
  initialize = function(s1=NA, s2=NA) {
    if(!all(sapply(list(s1, s2), function(x) inherits(x,"student")))) stop("students not students")
    self$s1 <- s1
    self$s2 <- s2

  },
  getolder = function(stud, years = 1) {
    stud$getolder(years)
    invisible(self)
  }))

gr1 <- group$new(stud1, stud2)
gr1$s1$age #18

gr1$getolder(gr1$s1, years=10)
gr1$s1$age #28

感谢 hadley 的 advanced R book，它预先指定了 R6 对象的可变属性。

【讨论】：