R S3 S4 2012 11 4
: S3 : S4 S3 S4
: S3 : S4 S3 S4
There is an important difference in philosophy between S (and hence R) and the other main statistical systems In S a statistical analysis is normally done as a series of steps, with intermediate results being stored in objects An Introduction to R
,,
,,
,,,
R (object-oriented programming), (encapsulate),,
R (object-oriented programming), (encapsulate),, R,
R (object-oriented programming), (encapsulate),, R, R,
R (object-oriented programming), (encapsulate),, R, R, R
(class) (method)
(class) (method), (instance)
(class) (method), (instance)
: S3 : S4 S3 S4
S3 S3
S3 S3,
S3 S3, R print, summary plot, summary(),
x <- rep(0:1, c(10, 20)) summary(x) ## Min 1st Qu Median Mean 3rd Qu Max ## 0000 0000 1000 0667 1000 1000 y <- asfactor(x) summary(y) ## 0 1 ## 10 20
S3 list class, foo class() x <- 1 attr(x, "class") <- "foo" x ## [1] 1 ## attr(,"class") ## [1] "foo" class(x) ## [1] "foo" x <- structure(1, class = "foo") x ## [1] 1 ## attr(,"class") ## [1] "foo" class(x) ## [1] "foo"
S3, class class(x) <- c("foo", "bar") class(x) ## [1] "foo" "bar"
(method dispatch) (generic function) :, UseMethod(), mean() mean ## function (x, ) ## UseMethod("mean") ## <bytecode: 0x102f0eab0> ## <environment: namespace:base>
UseMethod() class, genericclass UseMethod(), : meannumeric <- function(x, ) sum(x)/length(x) meandataframe <- function(x, ) sapply(x, mean, ) meanmatrix <- function(x, ) apply(x, 2, mean)
class c( foo, bar ), meanfoo, meanbar, meandefault bar <- function(x) UseMethod("bar", x) bardefault <- function(x) "default" bary <- function(x) "y" barz <- function(x) "z" foo <- structure(1, class = "nonsense") bar(foo) ## [1] "default" foo <- structure(1, class = c("y", "z")) bar(foo) ## [1] "y"
(Inheritance) class, S3 class NextMethod() barson <- function(x) c("i am son", NextMethod()) barfather <- function(x) c("i am father") foo <- structure(1, class = c("son", "father")) bar(foo) ## [1] "I am son" "I am father"
S3 S3 class,genericclass foo <- structure(1, class = "nonsense") bar(foo) ## [1] "default" barz(foo) ## [1] "z"
class class class() x <- 1 attr(x, "my_cool_class") <- "foo" x ## [1] 1 ## attr(,"my_cool_class") ## [1] "foo" class(x) ## [1] "numeric"
class, class class(foo) <- c("y", "z") bar(foo) ## [1] "y" class(foo) <- c("z", "y") bar(foo) ## [1] "z"
S3 ˆβ 0, ˆβ 1, cov( ˆβ 0, ˆβ x 1 ) = (xi x) 2 σ2, Var( ˆβ 0 ) = (1/n + Var( ˆβ 1 ) = x 2 (xi x) 2 )σ2 σ 2 (xi x) 2
fit <- lm(dist ~ speed, data = cars) sigma2 <- sd(fit$residuals)^2 cov <- -mean(cars$speed)/sum((cars$speed - mean(cars$speed))^2) * sigma2 var_beta0 <- (1/nrow(cars) + mean(cars$speed)^2/sum((cars$speed - mean(cars$speed))^2)) * sigma2 var_beta1 <- sigma2/sum((cars$speed - mean(cars$speed))^2) 1 2 1 4474-260 2-260 017
, summary() lm, summary() sigma2 <- summary(fit)$sigma^2
, summary() lm, summary() sigma2 <- summary(fit)$sigma^2 vcov() lm vcov(fit) ## (Intercept) speed ## (Intercept) 45677-26588 ## speed -2659 01727
co2d <- decompose(co2, type = "multiplicative") plot(co2d$x, ylim = c(0, 400), type = "l") lines(co2d$seasonal) lines(co2d$trend) lines(co2d$random) decompose() co2d$x 0 100 200 300 400 (ts) 1960 1970 1980 1990 Time
m <- cbind(co2d$x, co2d$seasonal, co2d$trend, co2d$random) co2mts <- ts(m) plot(co2mts) co2d$random co2d$trend co2d$seasonal co2d$x 0998 1000 1002 320 340 360 0990 1000 320 340 360 co2mts ts(),, plot() 0 100 200 300 400 Time
plot(co2d) Decomposition of multiplicative time series decomposedts plotdecomposedts() random observed trend 320 340 360 320 340 360 seasonal 0998 1000 1002 0990 1000 1960 1970 1980 1990 Time
S3 methods() S3 methods(genericfunction=predict) methods(class=lm)
S3 methods() S3 methods(genericfunction=predict) methods(class=lm) gets3method(f, class)
S3 methods() S3 methods(genericfunction=predict) methods(class=lm) gets3method(f, class), getanywhere()
: S3 : S4 S3 S4
S4 setclass() S4 representation (slot) setclass(class = "Person", representation(name = "character", age = "numeric"))
S4 S3, contains,, setclass(class = "Reporter", representation(title = "character"), contains = "Person")
new() S4, yuchen <- new("reporter", name = "yuchen", age = 22, title = 22) ## Error: invalid class "Reporter" object: invalid object for slot "title" in class "Reporter": got class "numeric", should be or extend class "character" yuchen <- new("reporter", name = "yuchen", age = 22, title = "R and OOP")
S3 $, S4 @ yuchen@name ## [1] "yuchen", slot() slot(yuchen, "age") ## [1] 22
, numeric, numeric(0), prototype setclass("person", representation(name = "character", age = "numeric"), prototype(name = NA_character_, age = NA_real_)) new("person", name = "yuchen")@age ## [1] NA
, validity CheckAge <- function(object) { if (object@age <= 0) { stop("age is negative") } } setclass("person", representation(name = "character", age = "numeric"), validity = CheckAge) new("person", age = -5) ## Error: Age is negative
S3, setgeneric(), standardgeneric() setgeneric("prepare", function(object) { }) standardgeneric("prepare")
setmethod(), signature() setmethod("prepare", signature(object = "Person"), function(object) { }) cat("got Materials\n") prepare(new("person")) ## Got Materials
callnextmethod() setmethod("prepare", signature(object = "Reporter"), function(object) { callnextmethod() cat("slides are ready\n") }) prepare(new("reporter")) ## Got Materials ## Slides are ready
S4 is(), getslots()
S4 is(), getslots() showmethods()
S4 is(), getslots() showmethods() Bioconductor Matrix S4,
Reference Class R5, 212,R5 R, Java C#?ReferenceClasses
Reference Class R5, 212,R5 R, Java C#?ReferenceClasses : Roo, proto mutatr
: S3 : S4 S3 S4
# S3 a1 <- a2 <- a3 <- a4 <- a5 <- 0 class(a1) <- "Instrument" class(a2) <- c("stringed", "Instrument") class(a3) <- c("wind", "Instrument") class(a4) <- c("brass", "Wind", "Instrument") class(a5) <- c("woodwind") # S4 setclass("instrument", representation("virtual", tune = "character")) setclass("stringed", representation("instrument")) setclass("wind", representation("instrument")) setclass("brass", contains = "Wind") setclass("woodwind", representation(tune = "character"))
# S3 play3 <- function(x, ) UseMethod("play3") play3instrument <- function(x) print("i am a Instrument") play3stringed <- function(x) print("i am a Stringed") play3default <- function(x) print("i don't know who I am") # S4 setgeneric("play4", function(object, ) standardgeneric("play4")) setmethod("play4", "Instrument", function(object) print(paste("play:", object@tune)))
play3(a1) ## [1] "I am a Instrument" play3(a2) ## [1] "I am a Stringed" play3(a3) ## [1] "I am a Instrument" play3(a4) ## [1] "I am a Instrument" play3(a5) ## [1] "I don't know who I am"
play4(new("stringed", tune = "I am a Stringed")) ## [1] "Play: I am a Stringed" play4(new("wind", tune = "I am a Wind")) ## [1] "Play: I am a Wind" play4(new("brass", tune = "I am a Brass")) ## [1] "Play: I am a Brass" play4(new("woodwind", tune = "I am a Woodwind")) ## Error: unable to find an inherited method for function 'play4' for signature '"Woodwind"'