FoRt: R & OOP - Institut für Statistik

FoRt: R & OOP
Fabian Scheipl Institut für Statistik LMU München
Objekt-Orientierte Programmierung in R
OOP Systeme in R
• Basistypen: interne (C) Datentypen
• S3: OO mit generischen Funktionen. generics entscheiden welche Methode benutzt wird. Zwanglos,
keine formelle Klassendefinition oder Objektvalidierung
• S4: Formellere & mächtigere Variante von S3:
– formelle Klassendefinition kontrolliert Repräsentation, Konstruktion, Vererbung
– multiple dispatch: generische Funktionen wählen Methoden basierend auf der Klasse von mehreren
Funktions-Argumenten, nicht nur der Klasse des ersten wie bei S3
– Standard für Bioconductor-Pakete.
• Reference classes (RC): mehr wie Java oder Python:
– kein copy-on-modify sondern mutable objects
– Methoden gehören zu Objekten, nicht zu generischen Funktionen
Basistypen
Basistypen
•
•
•
•
•
jedes R Objekt wird als C Objekt (struct) angelegt
dieses definiert wie das Objekt tatsächlich abgespeichert wird
vector und list sind Basistypen (base types).
nur R Core kann neue Basistypen definieren
Abfrage mit typeof:
typeof(t.test)
## [1] "closure"
typeof(globalenv())
## [1] "environment"
typeof(pi)
## [1] "double"
1
Relevante Basistypen
•
•
•
•
•
•
•
•
•
•
•
Vektoren: logical, integer, double, complex, character
list
environment
Funktionen: closure
language-Objekte mit modes expression, name, call
symbol
promise
expression
S4
NULL
...
Basistypen & OOP systems
• S3 Objekte: typischerweise Listen aus verschiedenen Basistypen
• S4 Objekte: spezieller Basistyp deren Felder Basistypen oder andere S4 Objekte enthalten
• RC Objekte sind eine Kombination aus S4 und environments.
S3
S3
• ältestes & einfachstes OO System in R
• einziges OO System das in den base, graphics, utils, datasets und stats Paketen benutzt wird
• informell und ad hoc, aber ausreichend für die meisten Projekte (IMO, YMMV)
S3 Prinzip
Methoden sind mit Funktionen – genauer: generics– assoziiert, nicht mit Objekten oder Klassen
Grundidee:
• Generische Funktionen definieren ein Label für eine ganze Sammlung von Funktionen (Methoden)
• Wenn eine generische Funktion aufgerufen wird, gibt sie die Argumente weiter an eine spezialisierte
Methode die für die Klasse des (üblicherweise) ersten Arguments definiert ist (method dispatch)
S3 Beispiel: print()
• print(x) muss sehr unterschiedliche Dinge tun je nachdem was x ist. . .
• S3 nimmt es dem Nutzer ab selbst angeben zu müssen was für eine print-Funktion benutzt werden soll
• die richtige Methode für das Ausgeben von x wird ermittelt indem die S3-Klasse von x abgefragt wird
(method dispatch)
2
S3: Generische Funktionen
• Quellcode einer generic macht üblicherweise nur einen Aufruf von UseMethod()
• UseMethod() baldowert aus welche Methode die richtige ist und ruft diese auf (method dispatch)
Beispiel:
print
##
##
##
##
function (x, ...)
UseMethod("print")
<bytecode: 0x13bbc48>
<environment: namespace:base>
predict
##
##
##
##
function (object, ...)
UseMethod("predict")
<bytecode: 0x17bbf90>
<environment: namespace:stats>
S3: Methoden
• S3-Methoden heißen immer <generic>.<class>() (ein Grund mehr bei der Programmierung nicht
den Punkt als Trennzeichen für Namen zu verwenden)
• benutze methods(<generic>) um zu sehen welche Methoden für eine generic definiert sind:
methods(mean)
## [1] mean.Date
mean.default mean.difftime mean.POSIXct
## see '?methods' for accessing help and source code
mean.POSIXlt
•
S3: Methods
• zeige alle generics die Methoden für eine gegebene Klasse haben:
methods(class = "ts")
##
##
##
##
##
##
[1] aggregate
[6] diffinv
[11] Math2
[16] plot
[21] [<see '?methods' for
as.data.frame cbind
coerce
diff
initialize
kernapply
Math
monthplot
na.omit
print
show
slotsFromS3
[
t
window<accessing help and source code
3
cycle
lines
Ops
time
window
methods(class = "lm")
##
##
##
##
##
##
##
##
##
##
##
[1] add1
alias
anova
[5] coerce
confint
cooks.distance
[9] dfbeta
dfbetas
drop1
[13] effects
extractAIC
family
[17] hatvalues
influence
initialize
[21] labels
logLik
model.frame
[25] nobs
plot
predict
[29] proj
qr
residuals
[33] rstudent
show
simulate
[37] summary
variable.names vcov
see '?methods' for accessing help and source code
case.names
deviance
dummy.coef
formula
kappa
model.matrix
print
rstandard
slotsFromS3
S3: Methods
• viele S3-Methoden sind nicht direkt einsehbar
• benutze getS3method() um deren Quellcode zu betrachten:
getS3method(f = "extractAIC", class = "lm")
##
##
##
##
##
##
##
##
##
##
##
##
function (fit, scale = 0, k = 2, ...)
{
n <- length(fit$residuals)
edf <- n - fit$df.residual
RSS <- deviance.lm(fit)
dev <- if (scale > 0)
RSS/scale - n
else n * log(RSS/n)
c(edf, dev + k * edf)
}
<bytecode: 0x2b56568>
<environment: namespace:stats>
S3 Objekte
S3-Klasse eines Objekts wird durch sein class-Attribut festgelegt:
• class(x) gibt das class-Attribut zurück
• class<-() setzt das class-Attribut eines Objekts und damit die S3-Klasse
• inherits(x, "some_class") checkt ob x zur Klasse some_class gehört.
that_guy <- "Josef Ackermann"
class(that_guy) <- "top1percenter"
attributes(that_guy)
## $class
## [1] "top1percenter"
4
class(that_guy)
## [1] "top1percenter"
inherits(that_guy, "top1percenter")
## [1] TRUE
S3: Klassendefinition & Objekterstellung
Simpel, ad-hoc:
• es gibt keine Klassendefinition: nur implizit durch bestehenden Code definiert
• jedes dahergelaufene R-Objekt mit
"whatev" %in% attribute(<object>, "class")
ist ein Objekt der Klasse whatev (!!)
S3 Objekte
• class kann auch ein Vektor sein
• geht von engster zu breitester/allgemeinster Klasse:
(o <- ordered(1 : 3))
## [1] 1 2 3
## Levels: 1 < 2 < 3
class(o)
## [1] "ordered" "factor"
• S3-Objekte sind meist base type list oder ein Vektor mit Attributen:
attributes(o)
##
##
##
##
##
$levels
[1] "1" "2" "3"
$class
[1] "ordered" "factor"
typeof(o)
## [1] "integer"
5
S3 Objekte
• S3-Klassen haben üblicherweise eine Konstruktor-Funktion
• immer benutzen falls vorhanden (z.B. factor(), data.frame())
• Konstruktor sollte genauso heißen wie die Klasse deren Objekte er erzeugt:
top1percenter <- function(x, wealth) {
if (wealth < 1e7) {
stop(x, " is not filthy rich and not a member of the top 1%.")
}
attr(x, "wealth") <- wealth
class(x) <- "top1percenter"
x
}
that_guy <- top1percenter("Josef Ackermann", wealth = 238e6)
top1percenter("F.S. aus M.", wealth = -1000)
## Error in top1percenter("F.S. aus M.", wealth = -1000): F.S. aus M. is not filthy rich and not a membe
Neue generics definieren
•
•
•
•
Funktion new_generic definieren die UseMethod("new_generic", "arg") aufruft
arg ist das Argument dessen Klasse für den method dispatch abgefragt wird (default: erstes Argument)
UseMethod() bekommt keinerlei andere Argumente der generic!
generics sollten immer ...-Argument akzeptieren: gewährleistet Flexibilität für neue Methoden
insult <- function(object, ...) UseMethod("insult")
Neue Methoden
Ganz normale Funktionsdefinition:
• mit dem korrekten <generic>.<class> Namen
• mit den Argumenten der generic:
insult.top1percenter <- function(object, ...) {
message(object, " ist ein Ausbeuter, Plutokrat & Feind der Arbeiterklasse.")
}
insult(that_guy)
## Josef Ackermann ist ein Ausbeuter, Plutokrat & Feind der Arbeiterklasse.
Neue Methoden
Ganz normale Funktionsdefinition:
• mit dem korrekten <generic>.<class> name
• mit den Argumenten der generic
6
insult.top1percenter <- function(object, ...) {
message(object, " ist ein Ausbeuter, Plutokrat & Feind der Arbeiterklasse.")
}
insult(that_guy)
## Josef Ackermann ist ein Ausbeuter, Plutokrat & Feind der Arbeiterklasse.
Neue Methoden
Methoden für bestehende generics:
print
##
##
##
##
function (x, ...)
UseMethod("print")
<bytecode: 0x13bbc48>
<environment: namespace:base>
print.top1percenter <- function(x, ...) {
cat(x, "\n
Klasse: Top 1%\n Vermögen: ",
formatC(attr(x, "wealth"), digits = 8), "€\n")
}
that_guy
## Josef Ackermann
##
Klasse: Top 1%
##
Vermögen:
2.38e+08 €
• muss selbst sicherstellen dass neue Methode zu generic (und anderen Methoden) passt.
Method Dispatch
• UseMethod() sucht nach Funktionen mit Namen wie some_generic.<class(x)[1]>, some_generic.<class(x)[2]>,
etc., und some_generic.default, in dieser Reihenfolge.
• die erste die gefunden wird wird ausgewertet
• auf default-Methode wird zurückgegriffen wenn keine Methode für die Klasse implementiert ist:
insult.default <- function(x, ...) {
insult <- sample(c("Tsibfigladscha", "Loamsiada", "Breznsoiza", "Haumdaucha"), 1)
message(substitute(x), ", du ", insult, "!")
}
methods("insult")
## [1] insult.default
insult.top1percenter
## see '?methods' for accessing help and source code
7
class(iris)
## [1] "data.frame"
insult(iris)
## iris, du Breznsoiza!
S4
S4
Ähnlich wie S3, aber formeller und strikter:
• formelle Klassendefinition für
– Felder der Klasse & Art ihrer Einträge
– Vererbungsstruktur (Elternklassen)
– optional: Validitätsprüfung, Prototypen-Instanz
• multiple dispatch für Methoden basierend auf mehreren Argumenten einer generic
Implementation im Paket methods.
Sehr häufig verwendet in Bioconductor-Paketen.
S4: Beispiel
library(methods)
library(stats4)
y <- rpois(10, lambda = 5)
negative_loglik <- function(lambda) -sum(dpois(y, lambda = lambda, log=TRUE))
ml_estimate <- mle(negative_loglik, start = list(lambda = 1), nobs = length(y))
ml_estimate
##
##
##
##
##
##
##
Call:
mle(minuslogl = negative_loglik, start = list(lambda = 1), nobs = length(y))
Coefficients:
lambda
4.500008
Inspektion von S4 Objekten
isS4(ml_estimate)
## [1] TRUE
8
is(ml_estimate)
## [1] "mle"
is(ml_estimate, "mle" )
## [1] TRUE
str(ml_estimate, 2)
## Formal class 'mle' [package "stats4"] with 9 slots
##
..@ call
: language mle(minuslogl = negative_loglik, start = list(lambda = 1), nobs = length(y)
##
..@ coef
: Named num 4.5
##
.. ..- attr(*, "names")= chr "lambda"
##
..@ fullcoef : Named num 4.5
##
.. ..- attr(*, "names")= chr "lambda"
##
..@ vcov
: num [1, 1] 0.45
##
.. ..- attr(*, "dimnames")=List of 2
##
..@ min
: num 18.6
##
..@ details :List of 6
##
..@ minuslogl:function (lambda)
##
.. ..- attr(*, "srcref")=Class 'srcref' atomic [1:8] 4 20 4 77 20 77 4 4
##
.. .. .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x17cefe0>
##
..@ nobs
: int 10
##
..@ method
: chr "BFGS"
Orientierung in S4
• Klassendokumentation: class?mle oder ?"mle-class"
• Welche Klassen und generische Funktionen sind im Paket definiert?
getClasses("package:stats4")
## [1] "mle"
"profile.mle" "summary.mle"
getGenerics("package:stats4")
##
##
##
##
##
##
##
An object of class "ObjectsWithPackage":
Object: "AIC"
"BIC"
"coef" "confint" "logLik" "nobs" "plot"
Package: "stats" "stats" "stats" "stats"
"stats" "stats" "graphics"
Object: "profile" "show"
"summary" "update" "vcov"
Package: "stats"
"methods" "base"
"stats" "stats"
Orientierung in S4
Welche Methodensignaturen gibt es für eine generic?
9
showMethods("plot")
## Function: plot (package graphics)
## x="ANY", y="ANY"
## x="profile.mle", y="missing"
showMethods("AIC")
## Function: AIC (package stats)
## object="ANY"
Quellcode einer Methode:
getMethod("plot", signature = c(x = "profile.mle", y = "missing"))
## Method Definition:
##
## function (x, y, ...)
## {
##
.local <- function (x, levels, conf = c(99, 95, 90, 80, 50)/100,
##
nseg = 50, absVal = TRUE, ...)
##
{
##
obj <- x@profile
##
confstr <- NULL
##
if (missing(levels)) {
##
levels <- sqrt(qchisq(pmax(0, pmin(1, conf)), 1))
##
confstr <- paste0(format(100 * conf), "%")
##
}
##
if (any(levels <= 0)) {
##
levels <- levels[levels > 0]
##
warning("levels truncated to positive values only")
##
}
##
if (is.null(confstr)) {
##
confstr <- paste0(format(100 * pchisq(levels^2, 1)),
##
"%")
##
}
##
mlev <- max(levels) * 1.05
##
nm <- names(obj)
##
opar <- par(mar = c(5, 4, 1, 1) + 0.1)
##
if (absVal) {
##
for (i in nm) {
##
sp <- splines::interpSpline(obj[[i]]$par.vals[,
##
i], obj[[i]]$z, na.action = na.omit)
##
bsp <- splines::backSpline(sp)
##
xlim <- predict(bsp, c(-mlev, mlev))$y
##
if (is.na(xlim[1L]))
##
xlim[1L] <- min(obj[[i]]$par.vals[, i])
##
if (is.na(xlim[2L]))
##
xlim[2L] <- max(obj[[i]]$par.vals[, i])
##
dev.hold()
##
plot(abs(z) ~ par.vals[, i], data = obj[[i]],
##
xlab = i, ylim = c(0, mlev), xlim = xlim, ylab = expression(abs(z)),
10
##
type = "n")
##
avals <- rbind(as.data.frame(predict(sp)), data.frame(x = obj[[i]]$par.vals[,
##
i], y = obj[[i]]$z))
##
avals$y <- abs(avals$y)
##
lines(avals[order(avals$x), ], col = 4)
##
abline(v = predict(bsp, 0)$y, h = 0, col = 3,
##
lty = 2)
##
for (lev in levels) {
##
pred <- predict(bsp, c(-lev, lev))$y
##
lines(pred, rep(lev, 2), type = "h", col = 6,
##
lty = 2)
##
pred <- ifelse(is.na(pred), xlim, pred)
##
lines(pred, rep(lev, 2), type = "l", col = 6,
##
lty = 2)
##
}
##
dev.flush()
##
}
##
}
##
else {
##
for (i in nm) {
##
sp <- splines::interpSpline(obj[[i]]$par.vals[,
##
i], obj[[i]]$z, na.action = na.omit)
##
bsp <- splines::backSpline(sp)
##
xlim <- predict(bsp, c(-mlev, mlev))$y
##
x0 <- predict(bsp, 0)$y
##
if (is.na(xlim[1L]))
##
xlim[1L] <- min(obj[[i]]$par.vals[, i])
##
if (is.na(xlim[2L]))
##
xlim[2L] <- max(obj[[i]]$par.vals[, i])
##
dev.hold()
##
plot(z ~ par.vals[, i], data = obj[[i]], xlab = i,
##
ylim = c(-mlev, mlev), xlim = xlim, ylab = expression(z),
##
type = "n")
##
lines(predict(sp), col = 4)
##
abline(h = 0, v = x0, col = 3, lty = 2)
##
for (lev in levels) {
##
pred <- predict(bsp, c(-lev, lev))$y
##
lines(pred, c(-lev, lev), type = "h", col = 6,
##
lty = 2)
##
pred <- ifelse(is.na(pred), xlim, pred)
##
lines(c(x0, pred[2L]), rep(lev, 2), type = "l",
##
col = 6, lty = 2)
##
lines(c(pred[1L], x0), rep(-lev, 2), type = "l",
##
col = 6, lty = 2)
##
}
##
dev.flush()
##
}
##
}
##
par(opar)
##
}
##
.local(x, ...)
## }
## <bytecode: 0x2cf60f0>
## <environment: namespace:stats4>
11
##
## Signatures:
##
x
y
## target "profile.mle" "missing"
## defined "profile.mle" "missing"
S4 Klassen
sind definiert durch
• Klassenname (oft “kleingeschriebenMitBinnenMajuskeln”).
• slots: benamte Liste von Feldern definiert Feldnamen und erlaubte Einträge
• contains: gibt die Elternklasse(n) an (optional)
Zusätzlich:
• prototype: Defaultwerte für slots
• validity: Funktion die die Gültigkeit übergebener Feldwerte überprüft.
– gibt TRUE zurück falls alle Feldwerte valide sind
– sonst Fehlermeldung (character)
S4 Klassen
setClass("citizen",
slots = list(name = "character", age = "numeric", job = "character"),
prototype = list(name = "Anna Musterfrau", age=40, job="rocket scientist")
)
setClass("top1Percenter",
slots = list(butler = "citizen", illuminati="logical", wealth = "numeric"),
contains = "citizen",
prototype = list(name = "A. Usbeuter", age=70, job="heir",
butler=new("citizen"), illuminati=TRUE, wealth=1e9),
validity = function(object) {
invalids <- character(0)
wrong_job <- !(object@job %in% c("banker", "CEO", "heir"))
poor <- object@wealth < 1e8
if (wrong_job) invalids <- "wrong <job> for a plutocrat."
if (poor) invalids <- c(invalids, "too little <wealth> for a plutocrat.")
if (length(invalids)) invalids else TRUE
}
)
getClass("citizen")
##
##
##
##
##
##
##
##
Class "citizen" [in ".GlobalEnv"]
Slots:
Name:
name
Class: character
age
job
numeric character
Known Subclasses: "top1Percenter"
12
Anlegen von S4 Objekten
albert <- new("citizen",
name = "Albert", age = 42, job = "domestic servant")
joseph_a <- new("top1Percenter",
name = "J. Ackermann", job = "banker", age = 66,
butler = albert, illuminati = TRUE)
str(joseph_a, 2)
## Formal class 'top1Percenter' [package ".GlobalEnv"] with 6 slots
##
..@ butler
:Formal class 'citizen' [package ".GlobalEnv"] with 3 slots
##
..@ illuminati: logi TRUE
##
..@ wealth
: num 1e+09
##
..@ name
: chr "J. Ackermann"
##
..@ age
: num 66
##
..@ job
: chr "banker"
albert
##
##
##
##
##
##
##
##
##
An object of class "citizen"
Slot "name":
[1] "Albert"
Slot "age":
[1] 42
Slot "job":
[1] "domestic servant"
Anlegen von S4 Objekten
new("top1Percenter", name = "F.S.", job = "Akademisches Prekariat", age = 35,
butler = joseph_a, illuminati = FALSE, wealth = 2e4)
## Error in validObject(.Object): invalid class "top1Percenter" object: 1: wrong <job> for a plutocrat.
## invalid class "top1Percenter" object: 2: too little <wealth> for a plutocrat.
• besser als new(): benutze Konstruktorfunktionen für S4 Objekte falls vorhanden.
Zugriff auf S4 Objekte
albert@job
## [1] "domestic servant"
13
slot(joseph_a, "age")
## [1] 66
Definition von S4 generics & Methoden
Prä-existierende generic:
setGeneric("print")
setMethod("print", signature = c(x = "citizen"),
function(x) {
paste0(x@name, " is a ", x@age, "-year old ", x@job, ".")
}
)
print
##
##
##
##
##
##
##
standardGeneric for "print" defined from package "base"
function (x, ...)
standardGeneric("print")
<environment: 0x2cc2780>
Methods may be defined for arguments: x
Use showMethods("print") for currently available ones.
print(albert)
## [1] "Albert is a 42-year old domestic servant."
print(joseph_a)
## [1] "J. Ackermann is a 66-year old banker."
Definition von S4 generics & Methoden
Neue generic:
setClass("Couple",
slots = list(person1 = "citizen", person2 = "citizen"))
setGeneric("marry", function(lover1, lover2, ...) {
standardGeneric("marry")
})
## [1] "marry"
14
setMethod("marry",
c(lover1 = "citizen", lover2 = "citizen"),
function(lover1, lover2) {
message("how wonderful: ", lover1@name, " & ", lover2@name, " will tie the knot.")
new("Couple", person1 = lover1, person2 = lover2)
}
)
## [1] "marry"
happy_couple <- marry(albert, joseph_a)
## how wonderful: Albert & J. Ackermann will tie the knot.
str(happy_couple, 2)
## Formal class 'Couple' [package ".GlobalEnv"] with 2 slots
##
..@ person1:Formal class 'citizen' [package ".GlobalEnv"] with 3 slots
##
..@ person2:Formal class 'top1Percenter' [package ".GlobalEnv"] with 6 slots
Definition von S4 generics & Methoden
Spezielle Datentypen/Signaturen ANY, missing
setMethod("marry",
c(lover1 = "citizen", lover2 = "ANY"),
function(lover1, lover2) {
message(lover1@name, " can only get married to a <citizen>, not to some ",
mode(lover2), ".")
}
)
## [1] "marry"
marry(albert, "Albert's teddybear")
## Albert can only get married to a <citizen>, not to some character.
Definition von S4 generics & Methoden
Spezielle Datentypen/Signaturen ANY, missing:
setMethod("marry",
c(lover1 = "citizen", lover2 = "missing"),
function(lover1, lover2) {
message(lover1@name, " needs to find somebody to love so they can marry.")
}
)
15
## [1] "marry"
marry(albert)
## Albert needs to find somebody to love so they can marry.
Methodenvererbung
callNextMethod() ruft die Methode auf die aufgerufen worden wäre wenn die aktuelle Methode nicht
existieren würde:
setMethod("marry",
c(lover1 = "top1Percenter", lover2 = "citizen"),
function(lover1, lover2) {
message("alert the tabloids -- draft a pre-nup -- put the Moet on ice!")
callNextMethod()
}
)
## [1] "marry"
rich_couple <- marry(joseph_a, albert)
## alert the tabloids -- draft a pre-nup -- put the Moet on ice!
## how wonderful: J. Ackermann & Albert will tie the knot.
Method dispatch
get("AIC", pos = "package:stats4")
##
##
##
##
##
##
##
standardGeneric for "AIC" defined from package "stats"
function (object, ..., k = 2)
standardGeneric("AIC")
<environment: 0x2684798>
Methods may be defined for arguments: object, k
Use showMethods("AIC") for currently available ones.
get("AIC", pos = "package:stats")
##
##
##
##
function (object, ..., k = 2)
UseMethod("AIC")
<bytecode: 0x1c408b8>
<environment: namespace:stats>
⇒ S3:UseMethod ≈ S4:standardGeneric
16
S4: . . . but wait, there’s more
• virtuelle Klassen
• setClassUnion()
• multiple inheritance
S3 vs. S4
Operation
S3
S4
Klassendefinition
implizit, am besten über Konstruktorfunktion
setClass()
Objekterzeugung
Konstruktor oder Setzen von class-Attribut
new() oder Konstruktor
Feld/Attribut auslesen
je nach base type des Objekts: $, [, [[, attribute()
@, slot(), accessor-Funktionen
Methode definieren
<generic>.<class> schreiben
setMethod()
generic deklarieren
Funktion die UseMethod() aufruft definieren
setGeneric()
Vererbung: Klassen
vektorielles class-Attribut
contains in setClass()
Vererbung: Methoden
NextMethod()
callNextMethod()
17

Download Report