R/join.r

In chbernau/CMA: Synthesis of microarray-based classification

### filename: join.r
### Title: Convenience function to unify objects of class 'cloutput',
### or 'clvarseloutput'
###
### Author: M. Slawski
### email: <Martin.Slawski@campus.lmu.de>
### date of creation: 12.10.2007
#
### Brief description:
#
#  Returns an object of class cloutput where all results have been 'joined'.
#
### Further comments and notes:
#
#   For objects of class 'clvarseloutput', all attributes concerning
#   variable selection are lost !
#
###**************************************************************************###

setGeneric("join", function(cloutputlist) standardGeneric("join"))

setMethod("join", signature(cloutputlist = "list"), function(cloutputlist){
          if(class(cloutputlist) != "list")
          stop("'cloutputlist' must be a list \n")
          if(length(cloutputlist) < 2)
          stop("'join' not necessary for a list containing only one element \n")
          classes <- unlist(lapply(cloutputlist, class))
          methods <- unlist(lapply(cloutputlist, slot, "method"))
          modes <- unlist(lapply(cloutputlist, slot, "mode"))
          method <- unique(methods)
          mode <- unique(modes)
          if(any(!extends(classes, "cloutput")))
          stop("All list elements must be of class 'cloutput' \n")
          if(length(method) > 1)
          stop("All list elements must have been generated by
                the same method \n")
          if(length(mode) > 1)
          stop("All list elements must have been generated in
                the same mode \n")
          y <- unlist(lapply(cloutputlist, slot, name="y"))
          yhat <- unlist(lapply(cloutputlist, slot, name="yhat"))
          learnind <- unlist(lapply(cloutputlist, slot, name="learnind"))
          matrices <- lapply(cloutputlist, slot, "prob")
          cols <- unlist(lapply(matrices, ncol))
          if(length(unique(cols)) != 1)
          stop("All list elements have to classifiy the same number of classes \n")
          probmatrix <- matrices[[1]]
          for(i in 2:length(cloutputlist))
          probmatrix <- rbind(probmatrix, matrices[[i]])

          new("cloutput", y=y, yhat=yhat, prob=probmatrix, method = method,
              mode = mode, learnind = learnind)
          })