R/classes.R

In seandavi/GEOquery: Get data from NCBI Gene Expression Omnibus (GEO)

### $Id$

### Generic GEO classes:

setClass("GEODataTable", representation(columns = "data.frame", table = "data.frame"),
    prototype = list(columns = data.frame(matrix(nr = 0, nc = 0)), table = data.frame(matrix(nr = 0,
        nc = 0))))


setClass("GEOData", representation(header = "list"), prototype = list(header = list()))

setClass("GSE", representation(header = "list", gsms = "list", gpls = "list"), prototype = list(header = list(),
    gsms = list(), gpls = list()))

setClass("GPL", representation(dataTable = "GEODataTable"), prototype = list(dataTable = new("GEODataTable")),
    contains = "GEOData")
setClass("GSM", representation(dataTable = "GEODataTable"), prototype = list(dataTable = new("GEODataTable")),
    contains = "GEOData")
setClass("GDS", representation(gpl = "GPL", dataTable = "GEODataTable"), prototype = list(gpl = new("GPL"),
    dataTable = new("GEODataTable")), contains = "GEOData")

printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth printHead
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth <-
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth function(x)
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth #
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth Print
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth leading
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth 5
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth elements
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth or
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth rows
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth of
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth atomic
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth object
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth From
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth limma
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth and
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth Gordon
printHead <- function(x) #  Print leading 5 elements or rows of atomic object   From limma and Gordon Smyth Smyth
{
    if (is.atomic(x)) {
        d <- dim(x)
        if (length(d) < 2)
            which <- "OneD"
        if (length(d) == 2)
            which <- "TwoD"
        if (length(d) > 2)
            which <- "Array"
    } else {
        if (inherits(x, "data.frame")) {
            d <- dim(x)
            which <- "TwoD"
        } else which <- "Recursive"
    }
    switch(which, OneD = {
        n <- length(x)
        if (n > 20) {
            print(x[1:5])
            cat(n - 5, "more elements ...\n")
        } else print(x)
    }, TwoD = {
        n <- d[1]
        if (n > 10) {
            print(x[1:5, ])
            cat(n - 5, "more rows ...\n")
        } else print(x)
    }, Array = {
        n <- d[1]
        if (n > 10) {
            dn <- dimnames(x)
            dim(x) <- c(d[1], prod(d[-1]))
            x <- x[1:5, ]
            dim(x) <- c(5, d[-1])
            if (!is.null(dn[[1]])) dn[[1]] <- dn[[1]][1:5]
            dimnames(x) <- dn
            print(x)
            cat(n - 5, "more rows ...\n")
        } else print(x)
    }, Recursive = print(x))
}

chopColumns <- function(x) {
    apply(x, 2, substring, first = 1, last = 35)
}

setGeneric("Meta", function(object) standardGeneric("Meta"))
setGeneric("Accession", function(object) standardGeneric("Accession"))
setGeneric("dataTable", function(object) standardGeneric("dataTable"))
setGeneric("Columns", function(object) standardGeneric("Columns"))
setGeneric("GPL", function(object) standardGeneric("GPL"))
setGeneric("GSM", function(object) standardGeneric("GSM"))
setGeneric("GPLList", function(object) standardGeneric("GPLList"))
setGeneric("GSMList", function(object) standardGeneric("GSMList"))
setGeneric("Table", function(object) standardGeneric("Table"))

#' @export
setMethod("Meta", "GEOData", function(object) {
    return(object@header)
})
#' @export
setMethod("Meta", "GSE", function(object) {
    return(object@header)
})

#' @export
setMethod("Accession", "GEOData", function(object) {
    return(Meta(object)$geo_accession)
})

#' @export
setMethod("dataTable", "GEOData", function(object) {
    return(object@dataTable)
})

#' @export
setMethod("Table", "GEODataTable", function(object) {
    return(object@table)
})

#' @export
setMethod("Columns", "GEODataTable", function(object) {
    return(object@columns)
})

#' @export
setMethod("Table", "GEOData", function(object) {
    return(Table(dataTable(object)))
})

#' @export
setMethod("Columns", "GEOData", function(object) {
    return(Columns(dataTable(object)))
})

#' @export
setMethod("GPLList", "GSE", function(object) {
    return(object@gpls)
})

#' @export
setMethod("GPL", "GDS", function(object) {
    return(object@gpl)
})

#' @export
setMethod("GSMList", "GSE", function(object) {
    return(object@gsms)
})


#' @export
setMethod("show", "GEODataTable", function(object) {
    cat("An object of class \"", class(object), "\"\n", sep = "")
    cat("****** Column Descriptions ******\n")
    print(Columns(object))
    cat("****** Data Table ******\n")
    printHead(Table(object))
})

#' @export
setMethod("show", "GEOData", function(object) {
    cat("An object of class \"", class(object), "\"\n", sep = "")
    for (i in names(Meta(object))) {
        cat(i, "\n")
        print(Meta(object)[[i]])
    }
    print(dataTable(object))
})