R语言S4系统 #

setClass("Person",
  slots = list(
    name = "character",
    age = "numeric"
  )
)

p <- new("Person", name = "张三", age = 25)
print(p)

setClass("Student",
  slots = list(
    name = "character",
    age = "numeric",
    score = "numeric"
  ),
  prototype = list(
    name = NA_character_,
    age = NA_real_,
    score = 0
  )
)

s <- new("Student", name = "李四", age = 20)
print(s)

setClass("PositiveNumber",
  slots = list(
    value = "numeric"
  ),
  prototype = list(value = 1)
)

setValidity("PositiveNumber", function(object) {
  if (object@value <= 0) {
    return("值必须为正数")
  }
  TRUE
})

new("PositiveNumber", value = 10)
new("PositiveNumber", value = -5)

p <- new("Person", name = "张三", age = 25)

p@name
p@age

slot(p, "name")
slot(p, "age")

p@age <- 26
print(p)

setMethod("show", "Person",
  function(object) {
    cat("姓名:", object@name, "\n")
    cat("年龄:", object@age, "\n")
  }
)

p <- new("Person", name = "张三", age = 25)
show(p)

setGeneric("greet", function(object) standardGeneric("greet"))

setMethod("greet", "Person",
  function(object) {
    cat("你好，我是", object@name, "\n")
  }
)

greet(p)

setGeneric("compare", function(x, y) standardGeneric("compare"))

setMethod("compare", c("Person", "Person"),
  function(x, y) {
    if (x@age > y@age) {
      paste(x@name, "比", y@name, "大")
    } else {
      paste(x@name, "比", y@name, "小或同龄")
    }
  }
)

p1 <- new("Person", name = "张三", age = 25)
p2 <- new("Person", name = "李四", age = 30)

compare(p1, p2)

setClass("Employee",
  slots = list(
    department = "character",
    salary = "numeric"
  ),
  contains = "Person"
)

e <- new("Employee", 
         name = "王五", 
         age = 30, 
         department = "技术部", 
         salary = 10000)

print(e)

setMethod("show", "Employee",
  function(object) {
    callNextMethod()
    cat("部门:", object@department, "\n")
    cat("薪资:", object@salary, "\n")
  }
)

show(e)

setClass("LinearModel",
  slots = list(
    formula = "formula",
    data = "data.frame",
    coefficients = "numeric",
    fitted = "numeric",
    residuals = "numeric"
  )
)

setMethod("show", "LinearModel",
  function(object) {
    cat("线性模型\n")
    cat("公式:", deparse(object@formula), "\n")
    cat("系数:\n")
    print(object@coefficients)
  }
)

setMethod("summary", "LinearModel",
  function(object) {
    cat("模型摘要\n")
    cat("R-squared:", 1 - var(object@residuals) / var(object@data[[1]]), "\n")
  }
)

setClass("DataContainer",
  slots = list(
    data = "ANY",
    metadata = "list",
    created = "POSIXt"
  ),
  prototype = list(
    data = NULL,
    metadata = list(),
    created = Sys.time()
  )
)

setMethod("show", "DataContainer",
  function(object) {
    cat("数据容器\n")
    cat("创建时间:", format(object@created), "\n")
    cat("数据类型:", class(object@data), "\n")
    cat("元数据:", length(object@metadata), "项\n")
  }
)