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

Question

我有我的学生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
}

建议的方法是什么？

---

EDIT下面对该组的所有学生调用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

干杯

Answer 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的高级R书喊话，该书预先指定了R6对象的可变属性。