###############################################################################
## Inhalt:
## Abschnitt 8.1 (R als objektorientierte Sprache) des Kurses von 
## Ruckdeschel & Kohl
###############################################################################


###############################################################################
## Lesen Sie die Abschnitte 8.1.1 - 8.1.3 im Skript von Ruckdeschel & Kohl
###############################################################################

###############################################################################
## S3-Klassen und Methoden
###############################################################################

###########################################################
## S3-Klassen
###########################################################

## Es gibt keine abstrakte, formale Definition der Klassen. Die Klassen-
## zugehörigkeit eines Objekts wird über ein Attribut nämlich das Attribut
## "class" bestimmt. Da R über die Zeit gewachsen ist, gibt es natürlich 
## Ausnahmen; siehe "Implizite S3-Klassen" weiter unten.

#######################################
## Explizite S3-Klassen
#######################################

###################.
## 1. Beispiel: factor
###################.
x <- factor(1:10)
class(x)
## oder auch
data.class(x)

## dies entspricht
attr(x, "class")

## alle Attribute
## factor ist ein integer-vector mit einem "level" Attribut
attributes(x)

## Achtung!
mode(x) ## Speichermodus/Typ nicht notwendig identisch zur Klasse!!!

## jedoch: factor ist nicht abgeleitet von vector bzw. numeric!!!
is.numeric(x)
is.vector(x)

## geordneter factor: ordered
x <- ordered(1:10)
class(x)

## Inheritance - Vererbung: factor -> ordered

## Test der Klassenzugehörigkeit
is.ordered(x)
is.factor(x)

## oder auch
inherits(x, c("ordered", "data.frame", "integer", "factor"), which = TRUE)

## casting: Umwandeln von einer Klasse in eine andere
## Dies kann man u.a. durch explizites Verändern des Attributes "class" erreichen.
x
class(x)

## jetzt verändern wir die Klasse
class(x) <- "factor"
x
class(x)

## dieses direkte Setzen der Klasse sollte aber mit großer Sorgfalt geschehen
class(x) <- "data.frame"

## Zum Casting sollten besser dafür vorgesehene Funktionen verwendet werden.
## Viele dieser Funktionen sind von der Form: "as.###"
x <- factor(c("a", "b", "c"))
y <- as.character(x)
class(y)
y <- as.integer(x)
y
class(y)
y <- as.data.frame(x)
y
class(y)

## Entfernen des Klassenattributes
y <- unclass(x) ## x bleibt unverändert
y

## auch möglich
class(x) <- NULL
x

###################.
## 2. Beispiel: data.frame
###################.
D <- data.frame(a = rnorm(10), b = character(10), c = factor(1:10))
class(D)
data.class(D)
attributes(D)

## casting in "matrix"
M <- as.matrix(D)
M 
mode(M) ## character-Matrix

## data.matrix erzwingt die Umwandlung in eine numerische Matrix
M <- data.matrix(D)
M
mode(M) ## numeric-Matrix

###################.
## 3. Beispiel: lm
###################.
x <- sample(1:10, 100, replace = TRUE)
y <- x + rnorm(100)
plot(x, y)
lm1 <- lm(y ~ x)
class(lm1) ## Klasse "lm"
data.class(lm1)
attributes(lm1)
mode(lm)

## Beim Rückgabewert von "lm" - d.h. der S3-Klasse "lm" - handelt es sich 
## genau genommen um eine Liste mit dem Attribut "class" gleich "lm".
## In vielen Fällen - wohl sogar in den meisten Fällen - sind S3-Klassen von 
## genau dieser Struktur.
is.list(lm1)

## Ein Möglichkeit eine solche Struktur - d.h. S3-Klasse - anzulegen, ist
z <- structure(data.frame(a = 10, b = 5), class = "MeineNeueS3Klasse")
z ## es gibt noch keine "print"-Methode für diese neue Klasse
class(z)
data.class(z)

## Man kann damit auch eine Vererbungsstruktur angeben
z <- structure(data.frame(a = 10, b = 5), 
               class = c("MeineNeueS3Klasse", "data.frame"))

## Es gibt immer noch keine "print"-Methode für diese neue Klasse, jedoch für 
## deren Mutterklasse "data.frame". Es wird also print.data.frame aufgerufen.
## Zu S3-Methoden kommen wir später noch genauer.
z
class(z)


#######################################
## Implizite S3-Klassen
#######################################

###################
## numeric, double, real
###################
x <- numeric(10) ## identisch zu x <- double(10) bzw. x <- real(10)
class(x)
data.class(x)

## aber kein Klassenattribut
attributes(x)

## In diesem Spezialfall entspricht Aufruf von "class" dem Aufruf von "mode"
mode(x)

## Inheritance - Vererbung
## Test der Klassenzugehörigkeit
## vector -> numeric
is.numeric(x)
is.vector(x)

###################
## raw (analog zu numeric)
###################
## vector -> raw
x <- raw(10)
class(x)
data.class(x)
attributes(x)
mode(x)
is.raw(x)
is.vector(x)

## Analog verhält es sich auch bei logical, complex und character

###################
## list (ebenfalls analog zu numeric, ...)
###################
## vector -> list
x <- vector("list", 10)
x
class(x)
data.class(x)
attributes(x)
mode(x)
is.vector(x)
is.list(x)

## möglicherweise Attribut names
x <- list(a = 1, b = 2)
class(x)
attributes(x)

## casting: Umwandeln in ein Objekt einer anderen Klasse
## hier: von "list" zu "vector"
y <- unlist(x)
is.list(y)
is.vector(y)

###################
## Spezialfall "integer"
###################
## vector -> numeric -> integer
x <- integer(10)
class(x) ## spezielle implizite Klasse!
## Achtung!!!
data.class(x)
mode(x) ## mode nicht identisch zu class!
is.vector(x)
is.numeric(x)
is.integer(x)

###################
## "array"
###################
A <- array(rnorm(12), dim = c(2, 2, 3))
class(A)
data.class(A)

## ein Array ist nichts anderes als ein Vector mit einem "dim"-Attribut
attributes(A)

A1 <- rnorm(12)
A1
attr(A1, "dim") <- c(2, 2, 3)
A1
is.array(A1)

## Speichermodus/Typ
mode(A)

###################
## "matrix"
###################
M <- matrix(rnorm(10), ncol = 2)
class(M)
data.class(M)

## eine Matrix ist ein Spezialfall eines Arrays und somit wieder nichts
## anderes als ein Vektor mit einem "dim"-Argument.
attributes(M)
mode(M)
is.matrix(M)
is.array(M)

## alternative Möglichkeiten Matrix anzulegen
M <- array(rnorm(10), dim = c(5, 2))
class(M)

M <- rnorm(10)
attr(M, "dim") <- c(5, 2)
class(M)


###########################################################
## S3-Methoden
## Lesen Sie den Abschnitt 8.1.5(a) im Skript von Ruckdeschel & Kohl
###########################################################
## Es handelt sich dabei um sog. generische Funktionen, die anhand der S3-Klasse 
## eines (!!!) ihrere Arguments entscheiden (dispatchen), welche konkrete 
## Methode/Funktion aufgerufen wird.
## Diese S3-Methoden/Funktionen sind immer von folgender Struktur
## "Funktionsname.Klassenname".

## Mit Hilfe von "methods" läßt sich festzustellen, welche Methoden es für 
## eine S3-Klasse gibt.
methods(class = "vector")
methods(class = "numeric")
methods(class = "lm")

## Andererseits kann man damit auch feststellen, für welche Klassen es von einer
## generischen Funktion spezielle S3-Methoden gibt.
methods("print")
methods("plot")
methods("summary")

###################
## Wir möchten uns die "summary"-Methode für "matrix" genauer ansehen.
###################
## 1. Möglichkeit
summary.matrix

## 2. Möglichkeit
getS3method(f = "summary", class = "matrix")

###################
## Falls die S3-Methode nicht "sichtbar" ist - d.h., beim Aufruf von "methods" 
## mit einem * versehen ist -, gibt es folgende Möglichkeiten:
###################
## 1. Möglichkeit
getS3method(f = "summary", class = "ecdf")

## 2. Möglichkeit
## Durch diesen Aufruf sehen wir u.a. auch, dass diese Methode im NAMESPACE von
## "stats" liegt. Wenn wir von einer Funktion (oder einem anderen R-Objekt) 
## wissen, in welchem Paket/Namespace sie zu finden ist, können wir uns diese 
## Funktion (dieses Objekt) auch mittels ":::" ansehen.
stats:::summary.ecdf

## 3. Möglichkeit
## Dies ist eine sehr allgemeine Möglichkeit, die nicht nur für S3-Methoden 
## funktioniert.
getAnywhere("summary.ecdf")

###################
## Methoden-Dispatching
###################
## Kommen wir nun zurück zu einem Beispiel, welches wir weiter oben bereits 
## einmal betrachten haben
z <- structure(data.frame(a = 10, b = 5), class = c("MeineNeueS3Klasse"))

## Die Eingabe eines Objektnames mit anschließendem Drücken der "Return"-Taste
## bewirkt nichts anderes als den Aufruf von print für dieses Objekt; d.h.,
## z entspricht print(z). Nun ist es so, dass wir für "MeineNeueS3Klasse"
## bisher noch keine print-Methode "print.MeineNeueS3Klasse" implementiert haben.
## Was passiert also bei
z
## bzw. bei
print(z)

## Im Fall, dass es keine spezielle S3-Methode für eine Klasse und diese Klasse 
## auch nicht die Tochterklasse von einer anderen S3-Klasse ist, wird die 
## S3-Methode "Funktionsname.default" aufgerufen. In unserem Fall entspricht
## print(z) also print.default(z).
print.default(z)

## Anhand dieses letzten Aufrufes sehen wir als, dass wir das Dispatchen auch
## umgehen können und konkrete Methoden direkt aufrufen können. Diesen Weg sollte
## man aber nur einschlagen, wenn man sich sicher ist, dass die konkrete Methode
## mit dem Objekt "umgehen" kann.
print.data.frame(z)

## Nun betrachten wir den Fall, dass "MeineNeueS3Klasse" die Tochterklasse einer
## andere Klasse - nämlich "data.frame" ist. Auch jetzt gibt es weiterhin keine
## S3-Methode "print.MeineNeueS3Klasse". Als Tochterklasse von "data.frame" 
## sollte "MeineNeueS3Klasse" jedoch (Achtung dies wird nicht wirklich überprüft!)
## alle Eigenschaften/Attribute von "data.frame" besitzen. Somit wird nach 
## der erfolglosen Suche nach "print.MeineNeueS3Klasse" nun nach "print.data.frame"
## gesucht. Da es diese S3-Methode in der Tat gibt wird jetzt diese und nicht
## länger "print.default" aufgerufen.
z <- structure(data.frame(a = 10, b = 5), 
               class = c("MeineNeueS3Klasse", "data.frame"))
z ## entspricht nun
print.data.frame(z)


###########################################################
## S3 Klassen und Methoden an einem konkreten Beispiel
###########################################################

#######################################
## 1. Schritt:
## Wir definieren eine Funktion ("Konstruktor"), mit der wir unsere neue S3-Klasse 
## anlegen; vgl. etwa "lm".
## Es handelt sich hier natürlich nur um ein künstliches Beispiel ...
#######################################
estimate <- function(x, estimator, ...){
    class(x) <- data.class(x)
    UseMethod("estimate", x) ## oder auch nur UseMethod("estimate")
}

## Wir setzen die Klasse für "x" explizit, damit das Dispatching auch bei 
## impliziten S3-Klassen funktioniert.

#######################################
## 2. (optionaler) Schritt: 
## Wir legen eine default-Methode an. Diese sollte nach Möglichkeit in 
## möglichst vielen Fällen ein Antwort liefern.
#######################################
estimate.default <- function(x, estimator, ...){
    structure(list(sample = x, estimate = estimator(x, ...)),
              class = "estimate")
}

## Beispiele
estimate(rnorm(10), mean)
estimate(rnorm(10), median)
M <- matrix(rnorm(20), ncol = 2)
estimate(M, mean)
estimate(M, median)


#######################################
## 3. (optionaler) Schritt: 
## Wir definieren eine print-Methode für unsere neue S3-Klasse.
#######################################
print.estimate <- function(x, ...){
    cat("Sample:\n")
    print(str(x$sample))
    cat("Estimate:\n")
    print(x$estimate)
    invisible(x)
}

## Weitere Beispiele
estimate(as.data.frame(M), mean)
estimate(as.data.frame(M), median) ## Fehler!

#######################################
## 4. (optionaler) Schritt:
## Wir definieren konkrete Methoden für spezielle Klassen
#######################################

## Wir möchten nun das der Schätzer auf jede Spalte einer Matrix bzw.
## jede Variable eines data.frames getrennt angewendet wird.

###################
## Methode für "data.frame"
###################
estimate.data.frame <- function(x, estimator, ...){
    y <- data.matrix(x)
    estimate <- apply(y, 2, estimator, ...)
    structure(list(sample = x, estimate = estimate),
              class = "estimate")
}

## Weitere Beispiele
estimate(as.data.frame(M), mean)
estimate(as.data.frame(M), median)

## jedoch
estimate(M, mean)
estimate(M, median)

###################
## Methode für "matrix"
###################
## Wir benötigen also auch noch eine Methode für Matrizen
estimate.matrix <- function(x, estimator, ...){
    y <- as.data.frame(x)
    UseMethod("estimate", y)
}

## aber jetzt
estimate(M, mean)
estimate(M, median)

###################
## Methode für "numeric"
###################
## Wir schreiben nun noch für Demonstrationszwecke - Anwendung von "NextMethod" - 
## eine explizite Methode für numerische Vektoren.
estimate.numeric <- function(x, estimator, ...){
    if(is.integer(x)){
      warning("x ist ein integer Vektor - prüfen Sie die Anwendbarkeit von estimator!")
    }
    NextMethod("estimate", x, ...)
}

## In diesem Fall führt "NextMethod" zu einem Aufruf von "estimate.default".
## Generell funktioniert "NextMethod" folgendermaßen:
## Situation: Objekt X mit S3-Klassen c("class2", "class1")
## Eine konkrete generische Funktion 

## Beispiel
x <- rnorm(10)
estimate(x, mean)

x <- as.integer(rpois(10, lambda = 3))
estimate(x, mean)
## x ein ordinales Merkmal???
estimate(x, median)

#######################################
## Achtung: 
## Das Dispatching muss nicht notwendigerweise auf dem ersten Argument 
## stattfinden.
#######################################
estimate <- function(estimator, x, ...){
    class(x) <- data.class(x)
    UseMethod("estimate", x)
}

## Es wird aufgrund der Klasse des 2. Argumentes "x" dispatched!