# Introduzione alla programmazione object oriented in R
# Classi ed oggetti in  R

setClass("sequence", representation(x="character"), prototype(x=character(3)));

s0<-new("sequence");

# Newseq extends sequence, maintaining the same representation
setClass("Newseq","sequence")

setClass("Pairedseq",representation(y="character"), 
         prototype(x=character(3), y=character(3)), contains="sequence");

# costruttore
Pairedseq <- function(x,y) {
   if (length(x)!=length(y))
      stop("the two sequences must match in length.");
   new("Pairedseq",x=x,y=y)
}

pseq <- Pairedseq(LETTERS[1:5],LETTERS[6:10]);

# obtaining information about the class
getClass("Pairedseq");


setClass("Threeseq",representation("Pairedseq",z="character"), 
         prototype(x=character(3), y=character(3), z=character(3)));

# example of multiple inherithance
setClass("Multiple",representation("sequence","numeric"));
s1<-new("Multiple");
# obtaining information about the class
getClass("Multiple");


# Definizione della classe track
setClass("track", representation(x = "numeric", y = "numeric"));
# Computation with slots
# 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);

# accesso agli slot
tr1@x;
slot(tr1,"x");
# getting slot names of slots
slotNames(tr1)
# getting names and classes of slots of a class
getSlots("track")


# Classi virtuali
# Definizione 1 (senza rappresentazione)
setClass("myvirtual");
getClass("myvirtual");
# Def.2 (con rappresentazione)
setClass("myvirtual2", representation("VIRTUAL",x="numeric"));
getClass("myvirtual2");
x<-new("myvirtual2");

# Which is the usage of virtual classes ? (da fare)

# Validity checking methods
# Validity checking for objects of class track
valid.track <- function(obj) {
  if (any(is.na(obj@x)) || any(is.na(obj@y)))
    return ("x, y slots should not have NA values");
  if (!identical(length(obj@x),length(obj@y)))
     return ("x, y slots should have equal length");
  return(TRUE);
}

# 1. Using setClass
setClass("track", representation(x = "numeric", y = "numeric"), validity=valid.track);
tr2<-new("track");
tr2<-new("track", x=rep(1,5), y=c(1,1,1,1,NA));  # error
tr2<-new("track", x=rep(1,5), y=rep(2,6));  # error
tr2<-new("track", x=rep(1,5), y=rep(2,5)); # OK
# 2. Using setValidity
setClass("track", representation(x = "numeric", y = "numeric"));
setValidity("track",valid.track);
# Explicit validity checking
validObject(tr2);

# Relations between classes
# Testing the is relation
is(tr2,"track");
# testing the extends relation
extends("sequence","numeric")
extends("Pairedseq","sequence")

# Removing a class
setClass("track100", "track");
removeClass("track100");

# Conditional extension
valid.track10 <- function(obj) {
  if ((length(obj@x) < 10) || (length(obj@y) < 10))
     return ("x, y slots should have length larger than 10");
  return(TRUE);
}
setClass("track10", representation(x = "numeric", y = "numeric"), 
         validity=valid.track10, prototype=prototype(x=numeric(10),y=numeric(10)));

setIs("track10","track");
setIs("track","track10", test=function(object) ((length(object@x) >= 10) && (length(object@y) >= 10)));

# Coercion
setAs("sequence","track", function(from) new("track", 
                          y=as.numeric(from@x), x=seq(length(from@x))));
s<-new("sequence",x=c("1","2"));
z <-as(s,"track");
s<-new("sequence",x=c("A","B"));
z <-as(s,"track");  # problems!

# Constructors
track <- function(xval, yval) { 
  xval <- as(xval, "numeric");
  yval <- as(yval, "numeric");
  new("track", x = xval, y = yval)
}

# Using constructor and setAs to get a constructor that use objects from other classes
setAs("numeric","track",
      function(from) track(seq(length=length(from)), from));
track <- function(xval, yval) {
  if (missing(yval))
     return(as(xval,"track")); 
  xval <- as(xval, "numeric");
  yval <- as(yval, "numeric");
  new("track", x = xval, y = yval)
}
x<-10:20;
tx<-track(x);
s<-new("sequence",x=c("1","2"));
ts <-track(s);

# Class extensions and virtual classes
setClass("trackv", representation(x="numeric", y="numeric", "VIRTUAL"));

setClass("trackerr",representation("track", err="numeric"));
setClass("trackerrv",representation("trackv", err="numeric"));

# setting a generic method
modify<-function(obj){};

# definition of the method for the parent classes
setMethod("modify", signature("track"),
   function(obj) {obj@x=10:20; obj@y=rnorm(11); obj})
   
setMethod("modify", signature("trackv"),
   function(obj) {obj@x=10:20; obj@y=rnorm(11); obj})

# applying the method to the corresponding extended classes
terr <- new("trackerr", x=1:3, y=rnorm(3), err=rnorm(3));
terrv <- new("trackerrv", x=1:3, y=rnorm(3), err=rnorm(3));

# Note that only the solts of the parent class are modified
terr2<-modify(terr);
terrv2<-modify(terrv);

# the same with an extension of class numeric
setClass("measured", representation("numeric", fuzz="numeric"))
getClass("measured")

x<-new("measured", .Data=1:5, fuzz=6:10)
y<-log(x); # y is an object of class "mesured"