R methods on nested class instances (OOP)

问题

I have my student S3 class

# 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
}

I want to define the class 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()

But this doesn't seem to be very efficient in case a class contains hundreds of other instances from other classes.

What I am after is to define methods that can modify fields for all students in the 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
}

What is the recommended way to do this?

EDIT the below calls getolder.student on all students of the group, but the students are not modified.

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 This does not change neither gr nor 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

Cheers

回答1:

R6 is the framework that I needed.

    # 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

Shout out to hadley's advanced R book which specified upfront the mutable property of R6 objects.

来源：https://stackoverflow.com/questions/65461117/r-methods-on-nested-class-instances-oop

标签

class

oop

methods