R语言面向对象_S4

setClass(class,representation,prototype,contains=character(),
  validity,access,where,version,sealed,package,
  S3methods=FALSE,slots)

# 定义对象
# 使用list将参数传递给slots
setClass("Person",slots=list(name="character",age="numeric"))

# 实例化对象

father <- new("Person",name="F",age=44)


father

# 显示创建了一个person的实例化对象father，其中
# father有两个属性，姓名和年龄
## An object of class "Person"
## Slot "name":
## [1] "F"
## 
## Slot "age":
## [1] 44

class(father)
## [1] "Person"
## attr(,"package")
## [1] ".GlobalEnv"
# 查看father对象为S4的对象
otype(father)# 此函数需要pryr包
## [1] "S4"

# 创建一个S4对象Person
setClass("Person",slots=list(name="character",age="numeric"))

# 创建Person的子类定义属性father和mother
# contains表示并继承person
setClass("Son",slots=list(father="Person",mother="Person"),contains = "Person")

# 实例化Person对象，建立father和mother

father <- new("Person",name="F",age=44)
mother <- new("Person",name="M",age=39)

# 实例化一个Son对象命名为son
# 年龄为16，属性为father和mother
# son的类中其实并没有定义age和name，但是可以使用person的属性，也就是继承
son <- new("Son",name="S",age=16,father=father,mother=mother)

# 查看son对象的name属性
son@name
## [1] "S"
# 查看son对象的age属性
son@age
## [1] 16
# 查看son对象的father属性
son@father
## An object of class "Person"
## Slot "name":
## [1] "F"
## 
## Slot "age":
## [1] 44
# 查看son对象的mother属性
son@mother
## An object of class "Person"
## Slot "name":
## [1] "M"
## 
## Slot "age":
## [1] 39
# 查看son类型
otype(son)
## [1] "S4"
# 查看son@name的属性
otype(son@name)
## [1] "base"
#  查看son@mother的属性
otype(son@mother)
## [1] "S4"
# 用isS4()检查S4对象的类型
isS4(son)
## [1] TRUE
isS4(son@name)
## [1] FALSE
isS4(son@mother)
## [1] TRUE

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

# 属性age为空
a <- new("Person",name="a")
a
## An object of class "Person"
## Slot "name":
## [1] "a"
## 
## Slot "age":
## numeric(0)
# 设置属性age的默认值为20

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

# 初始化b对象
b <- new("Person",name="b")

# 属性age的默认值是20
b 
## An object of class "Person"
## Slot "name":
## [1] "b"
## 
## Slot "age":
## [1] 20

setClass("Person",slots=list(name="character",age="numeric"))
#传入错误age类型
# numeric 为数字类型
bad <- new("Person",name="bad",age="abc")

###
#Error in validObject(.Object) : 类别为“Person”的对象不对: invalid object for slot "age" in class "Person": got class "character", should be or extend class "numeric"       
# 设置age的非负检查
setValidity("Person",function(object){
  if(object@age <= 0) stop("Age is negative.")
})

# 传入小于0的年龄
bad2 <- new("Person",name="bad",age=-1)

###
Error in validityMethod(object) : Age is negative.

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

# 创建一个对象实例n1

n1 <- new("Person",name="n1",age=19)
n1
## An object of class "Person"
## Slot "name":
## [1] "n1"
## 
## Slot "age":
## [1] 19

# 从实例n1中，创建实例n2，并修改name的属性值
n2 <- initialize(n1,name="n2")
n2
## An object of class "Person"
## Slot "name":
## [1] "n2"
## 
## Slot "age":
## [1] 19

setClass("Person",slots=list(name="character",age="numeric"))
a <- new("Person",name="a")

# 访问S4对象的属性

a@name
## [1] "a"
slot(a,"name")
## [1] "a"
# 错误的访问
#a$name
#a[1]

work <- function(x) cat(x,"is working")
work("Conan")
## Conan is working

# 定义数据对象类型
setClass("Person",slots=list(name="character",age="numeric"))
# 定义接口函数
setGeneric("work",function(object) standardGeneric("work"))
## [1] "work"
# 定义实现函数
setMethod("work",signature(object="Person"),function(object) cat(object@name,"is working"))
## [1] "work"
# 实例化对象person
a <- new("Person",name="Conan",age=16)

# 将数据对象通过接口函数传入
work(a)
## Conan is working

library(pryr)
# 检查work的类型
ftype(work)
# [1] "s4"      "generic"
# 直接查看work函数
work
#standardGeneric for "work" defined from package ".GlobalEnv"
#
#function (object) 
#standardGeneric("work")
#<environment: 0x000001d98cf9fad8>
#Methods may be defined for arguments: object
#Use  showMethods("work")  for currently available ones.
# 查看work函数的显示定义
showMethods(work)
#Function: work (package .GlobalEnv)
#object="Person"
# 查看Person对象的work函数现实
getMethod("work","Person")
#Method Definition:
#
#function (object) 
#cat(object@name, "is working")
#
#Signatures:
#        object  
#target  "Person"
#defined "Person"

# 检查Person对象有没有work函数
existMethod("work","Person")
hasMethod("work","Person")

setClass("check",slots=list(name="character"))

# 定义check_na类，并继承check,

setClass("check_na",contains = "check",slots=list(x="numeric"))

car_na <- new("check_na",name="car_na",x=mtcars$mpg)
iris_na <- new ("check_na",name="iris_na",x=iris$Sepal.Width)

#定义接口
setGeneric("do",function(obj,...){
  standardGeneric("do")
})
setMethod("do","check_na",function(obj,...){
  print("看看有多少缺失")
  sum(is.na(obj@x))
})

do(car_na)
do(iris_na)
#[1] "看看有多少缺失"
#[1] 0