R/nwaTS.R

In CityUHK-CompBio/HTSanalyzeR2: HTSanalyzeR2: An R package for functional annotation, network analysis and time series analysis of high-throughput data

#  preprocess -------------------------------------------------------------
#' A preprocessing method for a GSCABatch object of Time-series data Network Analyses
#'
#' This function will do basic preprocessing for each NWA object of 'nwaList'.
#'
#' @param object  An NWABatch object.
#' @param species A single character value specifying the species for which the
#' data should be read.
#' @param initialIDs A single character value specifying the type of initial
#' identifiers for input nwaList.
#' @param keepMultipleMappings A single logical value. If TRUE, the function
#' keeps the entries with multiple mappings (first mapping is kept). If FALSE,
#' the entries with multiple mappings will be discarded.
#' @param duplicateRemoverMethod A single character value specifying the method
#' to remove the duplicates. See duplicateRemover for details.
#' @param verbose A single logical value specifying whether to display detailed messages
#' (when verbose=TRUE) or not (when verbose=FALSE), default is TRUE.
#' @return In the end, this function will return an updated list of NWA object.
#' @seealso \code{\link[HTSanalyzeR2]{preprocess}}
#' @export
#' @examples
#' data(d7, d13, d25)
#'
#' ## generate expInfor to describe the information of time series data
#' expInfor <- matrix(c("d7", "d13", "d25"), nrow = 3, ncol = 2,
#'                    byrow = FALSE, dimnames = list(NULL, c("ID", "Description")))
#'
#' ## package pvalueTS into a list of pvalues
#' datalist <- list(d7, d13, d25)
#' pvalueTS <- lapply(datalist, function(x){
#'                    tmp <- as.vector(x$neg.p.value)
#'                    names(tmp) <- x$id
#'                    tmp})
#'
#' ## package phenotypeTS into a list of phenotypes if you want to color nodes by it,
#' ## otherwise ignore it!
#' phenotypeTS <- lapply(datalist, function(x) {
#'                       tmp <- as.vector(x$neg.lfc)
#'                       names(tmp) <- x$id
#'                       tmp})
#'
#' ## create an object of class 'NWABatch' with phenotypes
#' nwaTS <- NWABatch(expInfor = expInfor, pvalueTS = pvalueTS, phenotypeTS = phenotypeTS)
#'
#' ## preprocess nwaTS
#' nwaTS1 <- preprocessNwaTS(nwaTS, species="Hs", initialIDs="SYMBOL",
#'                          keepMultipleMappings=TRUE, duplicateRemoverMethod="max")
preprocessNwaTS <- function(object, species="Hs", initialIDs="SYMBOL",
                            keepMultipleMappings=TRUE,
                            duplicateRemoverMethod="max", verbose = TRUE){
  paraCheck("nwaTS", "object", object)
  tmpName <- names(object@listOfNWA)
  tmp <- lapply(object@listOfNWA, function(x){
    preprocess(x, species=species, initialIDs=initialIDs,
               keepMultipleMappings=keepMultipleMappings,
               duplicateRemoverMethod=duplicateRemoverMethod,
               verbose=verbose)
  })
  names(tmp) <- tmpName
  tmp
}


# interactome -------------------------------------------------------------
#' Create an interactome from BioGRID database or input custom interactome
#'
#' This function creates an interactome before conducting network analysis for Time-series data.
#' Different from \code{\link[HTSanalyzeR2]{interactome}} which can either be performed before
#' \code{\link[HTSanalyzeR2]{preprocess}} or after \code{\link[HTSanalyzeR2]{preprocess}}, this method
#' must be performed after \code{\link[HTSanalyzeR2]{preprocessNwaTS}}.
#'
#'
#' @param nwaList A named list of NWA object generated by preprocessNwaTS.
#' @param interactionMatrix An interaction matrix including columns
#' 'InteractionType', 'InteractorA' and 'InteractorB'. If this matrix
#' is available, the interactome can be directly built based on it instead
#' of downloading from BioGRID.
#' @param species A single character value specifying the species for
#' which the data should be read.
#' @param link the link (url) where the data should be downloaded (in
#' tab2 format). The default link is version 3.4.138 of BioGRID.
#' @param reportDir  A single character value specifying the directory
#' to store reports. The BioGRID data set will be downloaded and stored
#' in a subdirectory called 'Data' in 'reportDir'.
#' @param genetic A single logical value. If TRUE, genetic interactions
#' will be kept; otherwise, they will be removed from the data set.
#' @param force Force to download the data set.
#' @param verbose A single logical value indicating to display detailed
#' messages (when verbose=TRUE) or not (when verbose=FALSE).
#' @return In the end, this function will return an updated list of NWA object.
#' @seealso \code{\link[HTSanalyzeR2]{interactome}}
#' @examples
#' data(d7, d13, d25)
#'
#' ## generate expInfor to describe the information of time series data
#' expInfor <- matrix(c("d7", "d13", "d25"), nrow = 3, ncol = 2,
#'                    byrow = FALSE, dimnames = list(NULL, c("ID", "Description")))
#'
#' ## package pvalueTS into a list of pvalues
#' datalist <- list(d7, d13, d25)
#' pvalueTS <- lapply(datalist, function(x){
#'                    tmp <- as.vector(x$neg.p.value)
#'                    names(tmp) <- x$id
#'                    tmp})
#'
#' ## package phenotypeTS into a list of phenotypes if you want to color nodes by it,
#' ## otherwise ignore it!
#' phenotypeTS <- lapply(datalist, function(x) {
#'                       tmp <- as.vector(x$neg.lfc)
#'                       names(tmp) <- x$id
#'                       tmp})
#'
#' ## Example1: create an object of class 'NWABatch' by inputting an igraph object as the interactome
#' data(Biogrid_HS_Interactome)
#' nwaTS <- NWABatch(expInfor = expInfor, pvalueTS = pvalueTS,
#'                  phenotypeTS = phenotypeTS, interactome = Biogrid_HS_Interactome)
#'
#' ## Example2: create an object of class 'NWABatch' without interactome
#' nwaTS <- NWABatch(expInfor = expInfor, pvalueTS = pvalueTS, phenotypeTS = phenotypeTS)
#' ## preprocess nwaTS
#' nwaTS1 <- preprocessNwaTS(nwaTS, species="Hs", initialIDs="SYMBOL",
#'                          keepMultipleMappings=TRUE, duplicateRemoverMethod="max")
#' ## create an interactome for NWABatch by inputting an interaction matrix
#' data(Biogrid_HS_Mat)
#' nwaTS2 <- interactomeNwaTS(nwaTS1, interactionMatrix = Biogrid_HS_Mat, genetic=FALSE)
#'
#' \dontrun{
#' ## Example3: create an object of class 'NWABatch' without interactome
#' nwaTS <- NWABatch(expInfor = expInfor, pvalueTS = pvalueTS, phenotypeTS = phenotypeTS)
#' ## preprocess nwaTS
#' nwaTS1 <- preprocessNwaTS(nwaTS, species="Hs", initialIDs="SYMBOL",
#'                          keepMultipleMappings=TRUE, duplicateRemoverMethod="max")
#' ## create an interactome for nwa by downloading for BioGRID database
#' nwaTS2 <- interactomeNwaTS(nwaTS1, species="Hs", reportDir="HTSanalyzerReport", genetic=FALSE)
#' }
#' @export
interactomeNwaTS <- function(nwaList, interactionMatrix = NULL, species,
                             link = "http://thebiogrid.org/downloads/archives/Release%20Archive/BIOGRID-3.4.138/BIOGRID-ORGANISM-3.4.138.tab2.zip",
                             reportDir = "HTSanalyzerReport", genetic = FALSE,
                             force = FALSE, verbose = TRUE){
  paraCheck("nwaTS", "nwaList", nwaList)
  tmpName <- names(nwaList)
  tmp <- lapply(nwaList, function(x){
    interactome(x, interactionMatrix=interactionMatrix, species=species,
                link=link, reportDir=reportDir, genetic=genetic,
                force=force, verbose=verbose)
  })
  names(tmp) <- tmpName
  tmp
}



# analyze -----------------------------------------------------------------
#' Subnetwork analysis for Time-series data
#'
#' For each NWA object in 'nwaList', this function will store the subnetwork module identified
#' by BioNet (if species is given, labels of nodes will also be mapped from
#' Entrez IDs to gene symbols), and update information about these results to
#' slot summary of class NWA.
#'
#' @param nwaList  A named list of NWA object.
#' @param fdr  A single numeric value specifying the false discovery for the scoring of nodes
#' (see BioNet::scoreNodes and Dittrich et al., 2008 for details)
#' @param species A single character value specifying the species for which the data should be read.
#' @param plotBumModel Boolean value, whether to plot a histogram and qqplot of the p-values with the fitted model.
#' @param verbose A single logical value specifying to display detailed messages
#'  (when verbose=TRUE) or not (when verbose=FALSE), default is TRUE.
#' @return In the end, this function will return an updated list of NWA objects.
#' @seealso \code{\link[HTSanalyzeR2]{analyze}}
#' @export
#' @examples
#' data(d7, d13, d25)
#'
#' ## generate expInfor to describe the information of time series data
#' expInfor <- matrix(c("d7", "d13", "d25"), nrow = 3, ncol = 2,
#'                    byrow = FALSE, dimnames = list(NULL, c("ID", "Description")))
#'
#' ## package pvalueTS into a list of pvalues
#' datalist <- list(d7, d13, d25)
#' pvalueTS <- lapply(datalist, function(x){
#'                    tmp <- as.vector(x$neg.p.value)
#'                    names(tmp) <- x$id
#'                    tmp})
#'
#' ## package phenotypeTS into a list of phenotypes if you want to color nodes by it,
#' ## otherwise ignore it!
#' phenotypeTS <- lapply(datalist, function(x) {
#'                       tmp <- as.vector(x$neg.lfc)
#'                       names(tmp) <- x$id
#'                       tmp})
#'
#' ## create an object of class 'NWABatch' with phenotypes
#' nwaTS <- NWABatch(expInfor = expInfor, pvalueTS = pvalueTS, phenotypeTS = phenotypeTS)
#'
#' ## preprocess NWABatch
#' nwaTS1 <- preprocessNwaTS(nwaTS, species="Hs", initialIDs="SYMBOL",
#'                          keepMultipleMappings=TRUE, duplicateRemoverMethod="max")
#' \dontrun{
#' ## create an interactome for nwa by downloading for BioGRID database
#' nwaTS2 <- interactomeNwaTS(nwaTS1, species="Hs", reportDir="HTSanalyzerReport", genetic=FALSE)
#'
#' ## analyze
#' nwaTS3 <- analyzeNwaTS(nwaTS2, fdr=0.0001, species="Hs")
#' }
analyzeNwaTS <- function(nwaList,  fdr = 0.001,
                         species,
                         plotBumModel = FALSE,
                         verbose = TRUE){
  paraCheck("nwaTS", "nwaList", nwaList)
  tmpName <- names(nwaList)
  tmp <- lapply(nwaList, function(x){
    analyze(x, fdr=fdr, species=species,
            plotBumModel=plotBumModel,
            verbose=verbose)
  })
  names(tmp) <- tmpName
  tmp
}