嵌套类实例 (OOP) 上的 R 方法 [英] R methods on nested class instances (OOP)

问题描述

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

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

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

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

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
}

推荐的方法是什么?

编辑下面对组内所有学生的调用 getolder.student，但学生没有被修改.

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 这不会改变 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

干杯

推荐答案

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 书 大喊大叫，它预先指定了 <的可变属性code>R6 对象.

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

这篇关于嵌套类实例 (OOP) 上的 R 方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！