# Introduzione alla programmazione object oriented in R # Esempi da "Classes and Methods in the S Language" di J. Chambers. ############################################ ####### Metodi ############################# ############################################ # Generazione variabili usate negli esempi x <- 1:12; m <- matrix(x, nrow=3); m.d <- as.data.frame(m); # Definizione di una funzione generica whatis <- function(object) { paste("An object of class", data.class(object)); } # Definizione del metodo per la classe vector setMethod("whatis", "vector", function(object) paste(data.class(object), "vector of length", length(object)) ) # Definizione del metodo per la classe matrix whatIsMatrix <- function(object) { paste(data.class(as(object, "vector")), "matrix with", nrow(object), "rows and", ncol(object), "columns") } setMethod("whatis", "matrix", whatIsMatrix); showMethods("whatis"); # dumpMethod dumpMethod("whatis","numeric"); # definizione della funzione setMethod("whatis", "numeric", function (object) { print(paste(data.class(object), "vector of length", length(object))); print(paste("This is a newly defined method for class numeric")); } ) # Definizione del metodo per la classe data.frame whatIsDataFrame <- function(object) { print(paste("Data frame with", length(object), "variables and with", nrow(object), "components")); } setMethod("whatis", "data.frame", whatIsDataFrame); showMethods("whatis") ############################################################################# ### Definizione di classi, costruzione, accesso ed elaborazione di oggetti # ############################################################################# # Definizione della classe setClass("track", representation(x = "numeric", y = "numeric")); # Creazione di un oggetto pos1 <- c(156, 182, 211, 212, 218, 220, 246, 247, 251, 252, 254, 258, 261, 263); resp1 <- c(348, 325, 333, 345, 325, 334, 334, 332, 347, 335, 340, 337, 323, 327); tr1 <- new("track", x = pos1, y = resp1); resp2 <- resp1 - 10; tr2 <- new("track", x = pos1, y = resp2); # Accesso agli slot tr1@x; tr1@y; # oppure slot(tr1,"x"); slot(tr1,"y"); # Definizione di un costruttore track <- function(xval, yval) { xval <- as(xval, "numeric"); yval <- as(yval, "numeric"); if(length(xval) != length(yval)) stop("x, y should have equal length"); new("track", x = xval, y = yval) } # Utilizzo del costruttore tr3 <- track(pos1, resp1+20); # definizione del metodo show dumpMethod("show", "track"); setMethod("show", "track", function(object) { xy <- rbind(object@x, object@y); dimnames(xy) <- list( c("x", "y"), 1:ncol(xy)); show(xy); } ) # prova del metodo show tr1 # definizione del metodo plot setMethod("plot", signature(x = "track"), function(x, y, ...) plot(x@x, x@y) ) # prova plot(tr1); # ridefinizione del metodo plot setMethod("plot", signature(x = "track"), function(x, y, ...) plot(x@x, x@y, xlab="Posizione", ylab="Valore", type="b", ...) ) # prova windows(); plot(tr1); # plot di x@y contro un vettore generico setMethod("plot", signature(x = "track", y="vector" ), function(x, y, ...) plot(x@y, y, xlab="Track object", ylab="Matching object", type="p", col="green", ...) ) # prova windows(); plot(tr1,tr2@y); ######################################################### ########## Ereditarieta' ################################ ######################################################### # definizione di una classe derivata da track setClass("trackerr", representation(err = "numeric"), contains="track"); # Creazione di un oggetto pos1 <- c(156, 182, 211, 212, 218, 220, 246, 247, 251, 252, 254, 258, 261, 263); resp1 <- c(348, 325, 333, 345, 325, 334, 334, 332, 347, 335, 340, 337, 323, 327); err1 <- c(3, 5, 3, 5, 2, 1, 2, 0, 1, 2, 2, 8, 2, 1); trerr1 <- new("trackerr", x = pos1, y = resp1, err=err1); # Definizione di un costruttore trackerr <- function(xval, yval, errval) { xval <- as(xval, "numeric"); yval <- as(yval, "numeric"); errval <- as(errval, "numeric"); if((length(xval) != length(yval)) || (length(xval) != length(errval)) || (length(yval) != length(errval))) stop("x, y err should have equal length"); new("trackerr", x = xval, y = yval, err=errval) } # Definizione del metodo show setMethod("show", "trackerr", function(object) { xyerr <- rbind(object@x, object@y, object@err); dimnames(xyerr) <- list( c("x", "y", "err"), 1:ncol(xyerr)); show(xyerr); } ) # Definizione del metodo plot setMethod("plot", "trackerr", function(x,y,...) { signature(x = "trackerr"); maximum <- max(c(x@y,x@err)); minimum <- min(c(x@y,x@err)); plot(x@x, seq(minimum,maximum, length=length(x@x)), xlab="Posizione", ylab="Valore", type="n", ...); lines(x@x,x@y,col="black",type="b"); lines(x@x,x@err,col="red",type="l"); });