############################################################################### ## Inhalt: ## Abschnitt 8.1 (R als objektorientierte Sprache) des Kurses von ## Ruckdeschel & Kohl ############################################################################### ############################################################################### ## S4-Klassen und Methoden ## Implementiert im Paket "methods", welches bei der Standardinstallation von ## R mitinstalliert wird. ############################################################################### ########################################################### ## S4-Klassen ## Lesen Sie den Abschnitt 8.1.4 im Skript von Ruckdeschel & Kohl ########################################################### ## Bei den S4-Klassen handelt es sich im Unterschied zu den S3-Klassen um ## Klassen, die eine explizite, formale Definition haben. ## Das Anlegen einer Klasse erfolgt mittels der Funktion "setClass". setClass(Class = "Rohstoffe", representation = representation(laenge = "numeric", ## Längengrad +/- 180 (ost: +, west: -) breite = "numeric", ## Breitengrand +/- 90 (nord: +, sued: -) tiefe = "numeric", ## Tiefe in Meter menge = "numeric", ## Menge in kg art = "character")) ## Art/Name des Rohstoffes ## Die Überprüfung, ob es sich bei einer Klasse um eine formale S4-Klasse ## handelt, kann mit Hilfe von "isClass" vorgenommen werden. isClass("Rohstoffe") ## Die Definition einer Klasse kann man sich per "getClass" bzw. "getClassDef" ## genauer ansehen. getClass("Rohstoffe") getClassDef("Rohstoffe") ## Wollen wir ein konkretes Objekt von dieser Klasse anlegen, so können wir hierfür ## "new" verwenden. Generell ist der Aufruf von "new" nicht für den Anwender ## vorgesehen. Der Entwickler sollte stattdessen eine sog. "generating function" ## zur Verfügung stellen. Dies eine Funktion die i.d.R. den gleichen Namen wie ## Klasse besitzt, zu der sie gehört und mit der man ein Klassenobjekt erzeugen ## kann. Mehr dazu später. R <- new("Rohstoffe", laenge = 11.69, breite = 50.01, tiefe = 100, ## in der Nähe von Goldkronach menge = 0.1, art = "Gold") ## Handelt es sich bei R um ein Objekt der Klasse "Rohstoffe" is(R, "Rohstoffe") ## Die Eingabe von R am Prompt löst im Fall eines Objektes das zu einer S4-Klasse ## gehört, nicht den Aufruf einer print-Methode aus, sondern einer show-Methode R show(R) ## aber auch möglich print(R) ## Wir werden später bei S4-Methoden noch genauer darauf eingehen. ## Jede Klasse sollte einen Default-Prototyp besitzen; d.h., eine Instanz der ## Klasse, die ein korrektes Objekt darstellt. Da wir in der obigen Definition ## keinen Prototypen angegeben haben, wird der Standard-Default-Prototyp ## verwendet. new("Rohstoffe") ## laenge, breite, tiefe, menge und art sind die sog. Slots der Klasse ## "Rohstoffe" getSlots("Rohstoffe") slotNames("Rohstoffe") ## Wir können auf die Slots mittels des "@"-Operators zugreifen vglbar zu "$" ## bei "list". In diesem Fall muss aber der Name des Slots exakt angegeben ## werden (kein partielles matching!). R@laenge R@lae ## nein! ## oder auch slot(R, "breite") slot(R, "br") ## vgl. l <- list(laenge = 10) l$lae ## Über den "@"-Operator können Slots auch modifiziert werden R@laenge <- 12 R ## oder auch slot(R, "laenge") <- 11 R ################### ## Generell ist dies jedoch nicht zu empfehlen, da man damit unzulässige ## Objekte erzeugen kann. Stattdessen empfiehlt es sich für jeden Slot sog. ## Accessor und Replacement Funktionen anzulegen. Dazu später mehr im ## Abschnitt S4-Methoden. ################### ## Im vorliegenden Fall haben wir die Klasse aus elementaren Klassen aufgebaut. ## Dies ist nicht zwingend notwendig. ## Wir nehmen nun eine andere Definition vor. Hierzu entfernen wir zuerst die ## vorhandene Definition mit "removeClass". removeClass("Rohstoffe") isClass("Rohstoffe") ## nicht mehr vorhanden ## Vor der Definition der Klasse "Rohstoffe" definieren wir zuerst die Klasse ## "Position", die eine geographische Position darstellt.. setClass(Class = "Position", representation = representation(laenge = "numeric", breite = "numeric", tiefe = "numeric"), ## Wir legen einen expliziten Prototypen fest prototype = prototype(laenge = 0, breite = 0, tiefe = 0), ## Wir möchten außerdem überprüfen, ob es sich um ein korrektes Object handelt validity = function(object){ if(any(abs(object@laenge) > 180)) stop("Ungueltiger Laengengrad!") if(any(abs(object@breite) > 90)) stop("Ungueltiger Breitengrad!") if(any(object@tiefe < 0) | any(object@tiefe > 6350000)) stop("Ungueltige Tiefe!") n <- length(object@laenge) if(length(object@breite) != n | length(object@tiefe) != n) stop("laenge, breite und tiefe besitzen unterschiedliche Längen") return(TRUE) }) ## Beispiele new("Position") new("Position", tiefe = 10) new("Position", tiefe = -10) ## fehlerhafte Eingabe new("Position", laenge = 190) ## fehlerhafte Eingabe new("Position", breite = -100) ## fehlerhafte Eingabe new("Position", laenge = 11.69, breite = 50.01, tiefe = 100) ## Wir definieren nun die Klasse "Rohstoffe" erneut setClass(Class = "Rohstoffe", representation = representation("Position", menge = "numeric", art = "character"), prototype = prototype(menge = 0, art = ""), validity = function(object){ if(any(object@menge < 0)) stop("menge darf nicht negativ sein!") n <- length(object@laenge) if(length(object@menge) != n | length(object@art) != n) stop("laenge, breite, tiefe und menge bzw. art sind nicht von gleicher Laenge") return(TRUE) }) getClass("Rohstoffe") ## Alternative Möglichkeit der Definition removeClass("Rohstoffe") isClass("Rohstoffe") setClass(Class = "Rohstoffe", representation = representation(menge = "numeric", art = "character"), contains = "Position", ## damit enthält "Rohstoffe" alle Slots von "Position" prototype = prototype(menge = 0, art = ""), validity = function(object){ if(any(object@menge < 0)) stop("menge darf nicht negativ sein!") n <- length(object@laenge) if(length(object@menge) != n | length(object@art) != n) stop("laenge, breite, tiefe und menge bzw. art sind nicht von gleicher Laenge") return(TRUE) }) getClass("Rohstoffe") ## Es ist auch möglich den "validity"-Check nachträglich zu setzen bzw. zu ## verändern. Dies ist per "setValidity" möglich. Zum Beispiel ## aktueller validity-Check getValidity(getClassDef("Rohstoffe")) ## neuer validity-Check validRohstoffe <- function(object){ if(any(object@menge < 0)) stop("menge darf nicht negativ sein!") n <- length(object@laenge) if(length(object@menge) != n | length(object@art) != n) stop("laenge, breite, tiefe und menge bzw. art sind nicht von gleicher Laenge") if(sum(object@menge) > 6e24) stop("Die eingegebenen Mengen sind größer als die Erdmasse!") return(TRUE) } setValidity("Rohstoffe", validRohstoffe) getValidity(getClassDef("Rohstoffe")) ## Vererbung: "Rohstoffe" ist abgeleitet von "Position" ## "Position ist die Mutterklasse zu Rohstoffe" extends("Rohstoffe", "Position") ## Beispiele new("Rohstoffe") new("Rohstoffe", laenge = 11.69, breite = 50.01, tiefe = 100, menge = 0.1, art = "Gold") ## Der Aufruf von "new" ist nicht für den "normalen" Benutzer gedacht. ## Stattdessen wollen wir jetzt sog. generating functions definieren. Position <- function(laenge, breite, tiefe){ new("Position", laenge = laenge, breite = breite, tiefe = tiefe) } P <- Position(laenge = 11.69, breite = 50.01, tiefe = 10) P ## eine Möglichkeit für "Rohstoffe" Rohstoffe <- function(Pos, laenge, breite, tiefe, menge, art){ if(!missing(Pos)){ laenge <- Pos@laenge breite <- Pos@breite tiefe <- Pos@tiefe } new("Rohstoffe", laenge = laenge, breite = breite, tiefe = tiefe, menge = menge, art = art) } R <- Rohstoffe(Pos = P, menge = 0.1, art = "Gold") R is(R, "Rohstoffe") is(R, "Position") ## TRUE, da Mutterklasse von "Rohstoffe" die Klasse "Position" ist. ################### ## Coercing, Umwandeln von Objekten ################### ## Für Klassen, die über Vererbung zusammenhängen, gibt es Default-Methoden ## für das Coercing ## Die Slots "menge" und "art" werden hinzugefügt und mit Default-Werten aus ## dem Prototyp belegt. as(P, "Rohstoffe") ## Die Slots "menge" und "art" werden entfernt. as(R, "Position") ################### ## Es können auch explizite coercing Methoden und Klassenrelation mittels ## setAs und setIs angelegt werden. Dazu mehr im Abschnitt zu S4-Methoden. ################### ################### ## Wir haben die Standardargumente und den Standardaufruf von "setClass" ## vorgestellt. Generell besitzt setClass noch mehr Argumente als die ## vorgestellten; für weitere Einzelheiten siehe ?setClass bzw. ## Abschnitt 8.1.4(a) im Skript von Ruckdeschel & Kohl. ################### ####################################### ## S3-Klassen als S4-Klassen ####################################### ## Viele (alle?) der S3-Klassen, die in der Grundinstallation von R vorhanden ## sind, sind als Erweiterung von "oldClass" auch als formale S4-Klassen ## verwendbar. isClass("numeric") isClass("data.frame") getClass("numeric") getClassDef("numeric") getClass("lm") ## virtuelle Klasse! getClassDef("lm") ## Wir betrachten die "estimate" Klasse aus "S3KlassenUndMethoden.R", welche ## bisher nur als S3-Klasse vorliegt. isClass("estimate") ## Wir können hieraus nun auch eine formale S4-Klasse machen. Hierfür vorgesehen ## ist die Funktion "setOldClass" setOldClass("estimate") isClass("estimate") getClass("estimate") getClassDef("estimate") ## Vererbung extends("vector", "integer") extends("integer", "numeric") ####################################### ## Virtuelle S4-Klassen ####################################### ## Ein gutes Beispiel hierfür ist "vector". Ein Vektor ist ein abstraktes ## Konzept, bei man verschiedene, gleichartige Objekte z.B. Zahlen oder ## Buchstaben zusammenfügt. Gemeinsam haben alle Vektoren etwa, dass man ## eine Indizierung, ein Durchzählen der Elemente des Vektors möglich ist. ## getClass("vector") ## Konkret sind dies dann Zahlenvektoren getClass("numeric") ## oder Zeichenvektoren getClass("character") ## oder auch Listen getClass("list") ## Will man eine virtuelle Klasse anlegen, so ist geschieht dies, indem man bei ## contains "VIRTUAL" angibt. Zum Beispiel setClass("Vektor", representation = representation(data = "ANY"), contains = "VIRTUAL") getClass("Vektor") new("Vektor") ## nicht möglich setClass("Real", contains = "Vektor", prototype = prototype(data = numeric(0)), validity = function(object){ if(!is.numeric(object@data)) stop("data enthält keinen Vektor von reellen Zahlen!") return(TRUE) }) ####################################### ## setClassUnion ####################################### ## Vereinigungen von Klassen sind dann sehr praktisch, wenn man z.B. einen "slot" ## in einer Klasse hat, der in gewisser hinsicht optional, d.h., nicht zwingend ## erforderlich für ein gültiges Objekt ist. ## Ein Beispiel aus dem "methods"-Paket ist: getClass("OptionalFunction") ## Ähnlich könnte nützlich sein. setClassUnion("OptionalNumeric", c("NULL", "numeric")) getClass("OptionalNumeric") ####################################### ## Bemerkungen: ## 1. Um das Anlegen von Klassen nicht unnötig zeitaufwendig zu machen, ## empfiehlt es sich in den Validitätscheck einfache und keine rechenintensiven ## Checks einzubauen! Für rechenintensive Checks kann man dann zusätzlich ## eine explizite check-Methode zur Verfügung stellen, die dann nur bei Bedarf ## aufgerufen wird. ## 2. Das Anlegen von S4-Klassen ist "teuer", insbesondere falls eine Klasse ## zusätzlich aufwendige Validitätschecks enthält. Daher empfiehlt sich, das ## Anlegen von neuen Objekten, wenn möglich, zu vermeiden und besser die Slots ## bereits vorhandener Objekte zu modifizieren. Ein einfaches Beispiel dazu: myFun <- function(R, laenge, breite, tiefe, menge, art){ new("Rohstoffe", laenge = laenge, breite = breite, tiefe = tiefe, menge = menge, art = art) } system.time(for(i in seq_len(1000)) myFun(R = R, laenge = 11.5, breite = 50, tiefe = 10, menge = 1, art = "Gold")) myFun1 <- function(R, laenge, breite, tiefe, menge, art){ R@laenge <- laenge R@breite <- breite R@tiefe <- tiefe R@menge <- menge R@art <- art R } system.time(for(i in seq_len(1000)) myFun1(R = R, laenge = 11.5, breite = 50, tiefe = 10, menge = 1, art = "Gold")) ## Die zweite Funktion ist auf meinem System um den Faktor 4 schneller! ########################################################### ## S4-Methoden ## Lesen Sie die Abschnitte 8.1.5(b)-(f) und 8.1.6-8.1.9 im Skript von ## Ruckdeschel & Kohl ########################################################### ####################################### ## Generische Funktionen ####################################### ## Alle generischen Funktionen, für die wir S4-Methoden schreiben können erhalten ## wir über allGenerics() ## bzw. getGenerics() ## Ob eine konkrete Funktion eine S4-generische Funktion ist, läßt sich mit ## "isGeneric" feststellen isGeneric("print") isGeneric("plot") isGeneric("initialize") ####################################### ## initialize ####################################### ## Generell ist es möglich, für eine neue Klasse eine neue Methode für "new" ## zu schreiben. Die dazu gehörende generische Funktion heißt "initialize". ## Wir raten jedoch davon ab. Unsere Gründe dafür sind: ## 1. Die initialize-Methode - d.h. new - sollte nicht vom Anwender, sondern ## nur vom Entwickler (bzw. evtl. von erfahrenen Anwendern) verwendet werden. ## Stattdessen sollten für den Anwender sog. generating functions (siehe ## oben) zur Verfügung gestellt werden. ## 2. Durch eine "initialize"-Methode wird die Default-Methode überschrieben. ## Diese Default-Methode kann aber gerade im Rahmen der Implementation von ## neuer Funktionalität ein wichtiges Hilfsmittel sein, um Objekte von ## Klassen anzulegen. ## Trotz der Einwände wollen wir ein Beispiel für das Überladen von "initialize" ## geben. Mit Hilfe der Funktion "setMethod" können neue S4-Methoden angelegt ## werden. ## Bevor wir neue S4-Methoden für eine generische Funktion anlegen, müssen wir ## zuerst einmal feststellen, welche Argumente die generische Funktion akzeptiert ## und auf welchen Argumenten "dispatched" wird. Dies kann man mit Hilfe der ## Funktionen args, "getGeneric" und "findMethodSignatures". new ## -> ruft initialize auf args("initialize") getGeneric("initialize") ## Wir definieren nun eine neue Methode für die Klasse "Rohstoffe" setMethod(f = "initialize", signature = c("Rohstoffe"), definition = function(.Object, Pos, laenge, breite, tiefe, menge, art){ if(!missing(Pos)){ laenge <- Pos@laenge breite <- Pos@breite tiefe <- Pos@tiefe } .Object@laenge <- laenge .Object@breite <- breite .Object@tiefe <- tiefe .Object@menge <- menge .Object@art <- art .Object }) new("Rohstoffe", Pos = P, menge = 0.1, art = "Gold") ## Wir wollen nun kontrollieren, welche "initialize"-Methoden es gibt. ## Hierfür können wir die Funktion "showMethods" verwenden. showMethods("initialize") ## Wollen wir wisseen für, welche Signatur(en) es konkrete Methoden gibt, so ## können wir "findMethodSignatures" aufrufen. findMethodSignatures("initialize") ## Wenn wir nicht wissen, ob es eine konkrete Methode gibt. Können wir die ## Funktionen "existsMethod" oder "hasMethod" verwenden. existsMethod("initialize", signature = "Rohstoffe") existsMethod("initialize", signature = "ANY") ## default-initialize hasMethod("initialize", signature = "ANY") ## Wollen wir wissen, ob es von einer Funktion überhaupt Methoden gibt, so ## können wir dies mit "hasMethods" feststellen. hasMethods("initialize") ## Wollen wir uns die Definition einer konkreten Methode genauer ansehen, so ## können wir "getMethods", "findMethods", "getMethod", "selectMethod" oder ## "showMethod" verwenden. ## "getMethods" zeigt die Definition aller Methoden. Die Funktion "getMethods" ## ist eine alte Variante der Funktion "findMethods". In den Fällen, in denen ## es mehrere Methoden gibt, sind die Ausgaben dieser beiden Funktionen etwas ## unübersichtlich. getMethods("initialize") findMethods("initialize") ## Wir wollen uns nun aber nur die Definition einer speziellen Methode ansehen. getMethod("initialize", signature = "Rohstoffe") selectMethod("initialize", signature = "Rohstoffe") showMethods("initialize", classes = "Rohstoffe", includeDefs = TRUE) ## In welchem Paket, welchem environment ist eine konkrete Methode ## implementiert? findMethod("initialize", signature = "ANY") findMethod("initialize", signature = "Rohstoffe") ## Wir entfernen die initialize-Methode für die Klasse "Rohstoffe" wieder. Für ## das Entfernen von Methoden ist die Funktion "removeMethod" vorgesehen. removeMethod(f = "initialize", signature = c("Rohstoffe")) ####################################### ## show ####################################### ## Im Unterschied zu S3-Klassen, bei denen die Ausgabe über "print" erfolgt, ## werden S4-Klassen durch den Aufruf von "show" dargestellt. Das Konzept von ## "show" beinhaltet, dass es sich bei der Darstellung nicht nur um eine ## Text-Ausgabe handeln kann, sondern es könnte in manchen Fällen auch denkbar ## sein, dass "show" evtl. zusätzlich oder auch nur eine Graphik erzeugt, um ## die Struktur eines Objektes darzustellen. args("show") getGeneric("show") args("print") ## Im Unterschied zu print erlaubt "show" keine zusätzlichen Argumente. Es dient ## zu einer automatisierten Anzeige der Informationen eines Objektes. Um Fehler ## zu vermeiden und Kompatibilität zu gewährleisten, kann aber auch "print" für ## ein S4-Objekt aufgerufen werden bzw. "show" für ein S3-Objekt. ## Im jeweiligen Fall wird entweder von "print" dann "show" bzw. von "show" dann ## "print" aufgerufen. P ## entspricht show(P) show(P) print(P) ## oder z.B. show(diag(3)) ## Welche Methoden gibt es für "show"? showMethods("show") ## Die Default Methode getMethod("show", "ANY") ## ruft die Funktion "showDefault" auf. showDefault ## Wir definieren nun eine "show"-Methode für unsere Klasse "Rohstoffe" setMethod("show", signature = "Rohstoffe", definition = function(object){ for(i in seq_len(length(object@art))){ if(i > 1) cat("=========================================================\n") cat("Art des Rohstoffs:\t", object@art[i], "\n") cat("\nGeographische Position\n") cat("Längengrad:\t", object@laenge[i], "\n") cat("Breitengrad:\t", object@breite[i], "\n") cat("\nGeschätzte Tiefe des Vorkommens:\t", object@tiefe[i], "m\n") cat("\nGeschätzte Menge des Vorkommens:\t", object@menge[i], "kg\n") } }) ## Um die show-Methode zu demonstrieren, erzeugen wir ein etwas kompliziertes ## "Rohstoffe"-Object P1 <- Position(laenge = c(11.69, 10.9, 11.8), breite = c(50.01, 50.1, 49.8), tiefe = c(10, 50, 100)) P1 ## immer noch showDefault! R1 <- Rohstoffe(P1, art = c("Gold", "Eisenerz", "Uran"), menge = c(0.1, 1000, 20)) R1 ####################################### ## plot ####################################### ## In vielen Fällen möchte man auch plot-Methoden für eine S4-Klasse erstellen. ## Dies funktioniert z.B. folgendermaßen: getGeneric("plot") args("plot") setMethod("plot", signature = c("Rohstoffe", "ANY"), ## oder auch kürzer setMethod("plot", signature = "Rohstoffe" ## fehlende Argumente werden dann automatisch als "ANY" behandelt definition = function(x, y = NULL, ...){ plot(x@breite, x@laenge, xlab = "Breitengrad", ylab = "Längengrad", xlim = range(x@breite) + c(-0.5, 0.5), ylim = range(x@laenge) + c(-0.5, 0.5), ...) text(x@breite, x@laenge, pos = 3, labels = paste(x@art, ": ", x@tiefe, "m, ", x@menge, "kg", sep = "")) }) ## Der obige Aufruf von "setMethod" erzeugt automatisch eine neue generische ## Funktion für "plot"! plot(R1) ####################################### ## Eigene generische Funktionen und abgeleitete Methoden ####################################### ## Folgende Funktion soll zum Zusammenfügen von Objekten der Klasse ## "Rohstoffe" dienen. setGeneric("addRohstoffe", ## Name function(obj, R, ...){ ## Argumente der generischen Funktion standardGeneric("addRohstoffe") ## der Aufruf von standardGeneric sorgt für das Dispatching }) ## Bemerkung: "..." ist in der Signatur von generischen Funktionen zulässig. ## Jedoch kann darauf nicht dispatched werden. Es kann aber dafür ## nützlich sein, um evtl. weitere (Steuer/Tuning-)Parameter mit ## zu übergeben. ## Wir definieren nun eine Methode für "addRohstoff" setMethod("addRohstoffe", signature = c("Rohstoffe", "Rohstoffe"), definition = function(obj, R){ ## nicht notwendigerweise auch "..." in der Argumentliste obj@laenge <- c(obj@laenge, R@laenge) obj@breite <- c(obj@breite, R@breite) obj@tiefe <- c(obj@tiefe, R@tiefe) obj@art <- c(obj@art, R@art) obj@menge <- c(obj@menge, R@menge) obj }) addRohstoffe(R1, R) ####################################### ## Accessor und Replacement-Methoden ####################################### ## Wie oben bereits erwähnt und demonstriert kann auf Slots über den "@"-Operator ## zugegriffen werden - Lesen und Schreiben. ## Unserer Empfehlung nach sollte der Anwender/User jedoch nicht den "@"-Operator ## direkt verwenden, sondern stattdessen sollte man für den Anwender sog. ## Accessor und Replacement-Methoden bereitstellen. P P@tiefe <- -20 ## eigentlich unzulässig, wird jedoch nicht automatisch geprüft! P ## Kommt erst zu Tage durch validObject(P) ## Wir wollen nun stattdessen, Accessor und Replacement-Methoden für die Klasse ## "Position" bereitstellen. Hierfür müssen wir zuerst die entsprechenden generischen ## Funktionen erzeugen. ## Zuerst die generischen Funktionen für die Accessor-Methoden setGeneric("laenge", function(object) standardGeneric("laenge")) setGeneric("breite", function(object) standardGeneric("breite")) setGeneric("tiefe", function(object) standardGeneric("tiefe")) ## Nun die generischen Funktionen für die Replacement-Methoden setGeneric("laenge<-", function(object, value) standardGeneric("laenge<-")) setGeneric("breite<-", function(object, value) standardGeneric("breite<-")) setGeneric("tiefe<-", function(object, value) standardGeneric("tiefe<-")) ## Wir erzeugen die Accessor-Methoden setMethod("laenge", signature = "Position", definition = function(object) object@laenge) setMethod("breite", signature = "Position", definition = function(object) object@breite) setMethod("tiefe", signature = "Position", definition = function(object) object@tiefe) laenge(P) breite(P1) tiefe(P1) ## Wir erzeugen die Replacement-Methoden ## 1. Möglichkeit setMethod("laenge<-", signature = c("Position", "numeric"), definition = function(object, value){ if(any(abs(value) > 180)) stop("Ungültiger Wert für den Längengrad") object@laenge <- value object }) P laenge(P) <- 11.75 P laenge(P) <- 190 P removeMethod("laenge<-", signature = c("Position", "numeric")) ## 2. Kanonische Möglichkeit setReplaceMethod("laenge", signature = c("Position", "numeric"), definition = function(object, value){ if(any(abs(value) > 180)) stop("Ungültiger Wert für den Längengrad") if(length(value) != length(object@laenge)) stop("Falsche Länge des Längengradvektors") object@laenge <- value object }) P laenge(P) <- 11.75 P laenge(P) <- 190 P setReplaceMethod("breite", signature = c("Position", "numeric"), definition = function(object, value){ if(any(abs(value) > 90)) stop("Ungültiger Wert für den Breitengrad") if(length(value) != length(object@breite)) stop("Falsche Länge des Breitengradvektors") object@breite <- value object }) P breite(P) <- 50.5 P breite(P) <- -100 setReplaceMethod("tiefe", signature = c("Position", "numeric"), definition = function(object, value){ if(any(abs(value) < 0) | any(value > 6350000)) stop("Ungültiger Wert für die Tiefe") if(length(value) != length(object@tiefe)) stop("Falsche Länge des Tiefenvektors") object@tiefe <- value object }) P tiefe(P) <- -10 tiefe(P) <- 50 P ####################################### ## coerce, setIs, setAs ####################################### ## Die Funktionen coerce, setIs, setAs stellen Funktionen bereit, mit denen man ## zusätzlich zur direkten Vererbung zusätzlich explizit Vererbungen anlegen ## kann. ## Die folgende Klasse stellt eine Liste von Matrizen dar. setClass(Class = "MatrixList", prototype = prototype(list(new("matrix"))), contains = "list", validity = function(object){ nrvalues <- length(object) for(i in 1:nrvalues) if(!is(object[[i]], "matrix")) stop("Element ", i, " is keine Matrix") return(TRUE) }) ## Generating Function MatrixList <- function(...){ new("MatrixList", list(...)) } ## Nun gibt es für diese Klasse keinen direkten Bezug zur Klasse "matrix", sondern ## "nur" zur Klasse "list". M <- MatrixList(diag(3), diag(2)) M as(M, "list") ## Diesen Zusammenhang zur Klassen "matrix" wollen wir nun explizit herstellen. ## Und zwar soll eine Objekt der Klasse "MatrixList", welches nur eine Matrix ## enthält, im Wesentlichen identisch zu einem Objekt der Klasse "matrix" sein. setIs(class1 = "MatrixList", class2 = "matrix", test = function(obj) { length(obj) == 1 }, coerce = function(obj) { obj[[1]] }, replace = function(obj, value){ obj <- value[[1]] }) M is(M, "matrix") ## nein M1 <- MatrixList(diag(3)) M1 is(M1, "matrix") ## ja as(M1, "matrix") ## Umgekehrt wollen wir nun auch eine Matrix als eine "MatrixList" der Länge 1 ## auffassen können. setIs(class1 = "matrix", class2 = "MatrixList", coerce = function(obj){ new("MatrixList", list(obj)) }, replace = function(obj, value){ obj[[1]] <- value }) ## Dies geht also für "matrix" leider so nicht. Mit setClassUnion könnte man ## eine Mutterklasse von "matrix" und "MatrixList" erzeugen. Außerdem ist es ## zumindest möglich eine explizite coerce-Methode zu schreiben. setAs(from = "matrix", to = "MatrixList", def = function(from){ new("MatrixList", list(from)) }) D <- diag(3) is(D, "MatrixList") ## nein ## aber as(D, "MatrixList") ####################################### ## Gruppen-Methoden ####################################### ## Es gibt außerdem noch spezielle "group generics". Dabei handelt es sich um ## Gruppen von Funktionen, die identische Aufrufe besitzen. Man muss den spezielle ## Methoden nur einmal für die gesamte Gruppe definieren. ## Beispiele sind: Arith, Compare, Ops, Logic, Math, Math2, Summary und ## Complex; vgl. ?S4groupGeneric. Die Mitglieder der Gruppen lassen sich mittels ## "getGroupMembers" feststellen. getGroupMembers("Arith") ## Wir wollen nun einmal für unsere "MatrixList" beispielhaft eine Methode für ## die Gruppe "Arith" anlegen. getGeneric("Arith") setMethod("Arith", signature = c("MatrixList", "numeric"), definition = function(e1, e2){ for(i in seq_len(length(e1))){ e1[[i]] <- callGeneric(e1[[i]], e2) } e1 }) M * 3 M / c(1, 2, 3) M - 10 ## Man kann auch selber solche Gruppen anlegen mit "setGroupGeneric". Man eine ## generische Funktion auch nachträglich zu einer bestehenden Gruppe hinzufügen, ## indem man bei der Definition mittels "setGeneric" zusätzlich das Argument ## "group" entsprechend setzt.