R/utils.R

In matthewcarlucci/DiscoRhythm: Interactive Workflow for Discovering Rhythmicity in Biological Data

#' Data formatting for DiscoRhythm
#'
#' Functions to import a data.frame (from the format expected by the 
#' web application \code{discoApp()}) as a SummarizedExperiment object or
#' to export a SummarizedExperiment for use with the web application.
#'
#' @name discoDFtoSE
NULL

#' @rdname discoDFtoSE
#'
#' @param Maindata data.frame with the first column containing row IDs and all
#' subsequent columns containing experimental values. Columns should follow the
#' expected naming format described in the vignette.
#' @param Metadata data.frame of sample data, usually generated by
#' using \code{discoParseMeta} on the column names of the Maindata data.frame. 
#' If \code{is.null(Metadata)} and Maindata is provided as input, Metadata will 
#' be generated from Maindata.
#' @inheritParams discoParseMeta
#' @export
#' 
#' @return discoDFtoSE returns a SummarizedExperiment object with colData 
#' containing sample metadata. 
#' 
#' @importFrom SummarizedExperiment SummarizedExperiment assay
#' @importFrom S4Vectors DataFrame
#' 
#' @examples 
#' 
#' df <- discoGetSimu()
#' se <- discoDFtoSE(df)
#' 
discoDFtoSE <- function(Maindata,Metadata=NULL,shinySession=NULL){
    if(methods::is(Maindata,"SummarizedExperiment")){
        message("Input is already a SummarizedExperiment")
        return(Maindata)
    }
    
    mat <- as.matrix(Maindata[,-1])
    rownames(mat) <- Maindata[,1]
    
    if(is.null(Metadata)){
        Metadata <- discoParseMeta(colnames(Maindata)[-1],shinySession)
    }
    
    rownames(Metadata) <- colnames(mat)
    
    se <- SummarizedExperiment(assays=mat,
                                colData=DataFrame(Metadata))
    
    return(se)
}

#' @rdname discoDFtoSE
#' 
#' @inheritParams discoInterCorOutliers
#' @export
#' 
#' @return discoSEtoDF returns a DiscoRhythm format data.frame.
#' 
#' @importFrom SummarizedExperiment assay
#' @importFrom BiocGenerics rownames
#' 
#' @examples
#' df <- discoSEtoDF(se) 
discoSEtoDF <- function(se){
    df <- data.frame("IDs"=rownames(se),assay(se))
    if(!is.null(se$ID)){
        if(anyDuplicated(se$ID)){
            message("Duplicate IDs found, remaking IDs...")
            colnames(df)[-1] <- paste(se$Time,
                                        seq_len(ncol(se)),
                                        se$ReplicateID,
                                        sep="_")
        } else{
            colnames(df)[-1] <- se$ID
        }
    }
    return(df)
}

#' Handle Error/Warning messages appropriately with
#' shiny notifications for warnings and
#' pop-ups for errors
#'
#' @keywords internal
#' @return output from expr
discoShinyHandler <- function(expr,
    section = "Execution",
    shinySession = NULL) {
    myWarnings <- NULL
    myMessages <- NULL
    results <- tryCatch({
        withCallingHandlers({
            expr
        },
        message = function(msg) {
            myMessages <<- c(myMessages, list(msg))
        },
        warning = function(msg) {
            myWarnings <<- c(myWarnings, list(msg))
            invokeRestart("muffleWarning")
        }
        )
    },
    error = function(msg) {
        warning("An error message was displayed in the application")
        warning(msg$message)
        shiny::showModal(shiny::modalDialog(
            title = paste0("Error in ", section),
            shiny::tags$b(msg$message), shiny::tags$br(),
            "R function: ",
            deparse(msg$call), shiny::tags$br(),
            "Contact the author if you believe this to be a bug",
            easyClose = TRUE, footer = NULL
            ))
    }
    )

    if (!is.null(myMessages) & !is.null(shinySession)) {
        for (i in seq_along(myMessages)) {
            shiny::showNotification(
                type = "message",
                shiny::tags$h4("Message"),
                myMessages[[i]]$message,
                session = shinySession, duration = 10
                )
        }
    }
    if (!is.null(myWarnings) & !is.null(shinySession)) {

        warns <- utils::head(myWarnings)
        # Limit to 5 warnings
        if(length(myWarnings)>5){
            warns[[6]]$message <- paste0("There were ", length(myWarnings)-5,
                                    " other warnings.")
        }

        for (i in seq_along(warns)) {
            shiny::showNotification(
                type = "warning",
                shiny::tags$h4(paste0("Warning in ", section)),
                warns[[i]]$message,
                session = shinySession, duration = 40
                )
        }
    }

    return(results)
}