Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

  • a78cb8f
  • /
  • module
  • /
  • enrichmodule.R
Raw File Download

To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
Select below a type of object currently browsed in order to display its associated SWHID and permalink.

  • content
  • directory
content badge
swh:1:cnt:c227ec25301d4b02e9e778816b1845c52a250f20
directory badge
swh:1:dir:c2fbeb3a282ae4e712de69c4c8697d75059f7bda

This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
Select below a type of object currently browsed in order to generate citations for them.

  • content
  • directory
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
enrichmodule.R
### Author: Franck Soubès
### Bioinformatics Master Degree - University of Bordeaux, France
### Link: https://github.com/GeT-TRiX/MA_Trix_App/
### Where: GET-TRiX's facility
### Application: MATRiX is a shiny application for Mining and functional Analysis of TRanscriptomics data
### Licence: GPL-3.0


#' selSpecies is a shiny widget which aims is to select the Species for the functional analysis
#'
#' @param id Shiny id
#'
#' @return Widget in the gui
#'
#' @export

selSpecies <- function(id) {
  ns <- NS(id)
  selectInput( ns("selspecies"), label = "Choose your Species:", selected = "Mus musculus",
              c("Mouse" = "Mus musculus", "Human" = "Homo sapiens", "Rat" = "Rattus norvegicus", "C. elegans" = "Caenorhabditis elegans",
                "Zebrafish" = "Danio rerio",  "Pig" = "Sus scrofa",
                "Chicken" = "Gallus gallus", "Chimpanzee" = " Pan troglodytes" ))
}

#' runAnalysis is a shiny widget action button for run the functional analysis
#'
#' @param id Shiny id
#'
#' @return Widget in the gui
#'
#' @export
#'

runAnalysis <- function(id) {
  ns <- NS(id)
  actionButton(ns("GOana"), label = "Run Analysis",style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
}

#' catHm is a shiny widget which aims is to select the categories for the functional analysis
#'
#' @param id Shiny id
#'
#' @return Widget in the gui
#'
#' @export
#'

catHm  <- function(id, label = "Run Analysis") {
  ns <- NS(id)

  selectInput(ns('catinfo'),'Category: ',
              choices =  c( `BP`= "GOTERM_BP_ALL", `MF` = "GOTERM_MF_ALL", `CC`=  "GOTERM_CC_ALL", `Kegg`= "KEGG_PATHWAY"),
              selected=  c( `BP`= "GOTERM_BP_ALL", `MF` = "GOTERM_MF_ALL", `CC`=  "GOTERM_CC_ALL", `Kegg`= "KEGG_PATHWAY"),
              multiple = TRUE
  )
}


#' entrezIdstosymb is a shiny module which aims that takes as input a dataframe with entrez ids and return a dataframe with gene symbols
#'
#' @param input Internal
#' @param output Internal
#' @param session Internal
#' @param data A statistical output dataframe of the DAVID web service
#' @param cutgo A numeric value to specify which cluster is selected
#' @param rows_selected A reactive character vector of the selected rows within the DAVID output table
#'
#' @return A reactive dataframe that associates Genes (genesymbols) with the corresponding term
#'
#' @export
#'

entrezIdstosymb <- function(input, output, session , data, cutgo, rows_selected ) {


myentreztosymb <- reactive({

  req(data())
  myselectedrows = (data()$mygodavid[[as.numeric(cutgo())]][rows_selected(), c("Genes", "Term"),  drop = FALSE])
  if(length(myselectedrows["Genes"][[1]])>0){
    myentreztosymb = lapply(1:NROW(myselectedrows),function(x){
      myselectedrows$Genes[[x]] %>% strsplit( ", ") %>% unlist() %>% mget(x= ., envir = data()$packages , ifnotfound = NA) %>%  unlist() %>%
        unique() %>% cbind(myselectedrows$Term[[x]]) %>% as.data.frame() %>% setNames(., c("Genes", "Term"))

    })

    return(myentreztosymb)
  }
  else{

    return(NULL)
  }


  })
}


#' queryDavid is a shiny module which aims is to query the DWS for performing Functional Annotation or Gene Functional Classification
#'
#' @param input Internal
#' @param output Internal
#' @param session Internal
#' @param data A reactive dataframe(s)
#' @param parent_session External session
#' @param tabsetpanid Widget tabset panel
#' @param tabPanel Plot tabset panel
#' @param hmana A boolen value (T for heatmap and F for Venn)
#'
#' @return A reactive statistical dataframe of S4 class
#'
#' @export
#'


queryDavid <- function(input, output, session , data, parent_session, tabsetpanid, tabPanel, hmana= F ) {


resAnalysis <- eventReactive(input$GOana , {

  req(data())

  enrichmanalysis <- reactiveValues()
  enrichmanalysis$packages <- Species()[[2]]



  withProgress(message = 'Performing GO enrichment:',
               value = 0, {
                 n <- NROW(50)
                 for (i in 1:n) {
                   incProgress(1 / n, detail = "Please wait...")
                 }
#~                  library(RDAVIDWebService)

                 timeoutdav <- function(y)
                   if (any(grepl("Read timed out", y)))
                     invokeRestart("muffleWarning")

                 tryCatch({
                     mygodavid = probnamtoentrez(data(), Species()[[1]], gohm = hmana ) %>%
                    {if (!hmana) davidqueryvenn(., input$selspecies) else davidquery(. , input$selspecies, input$catinfo) } %>% withCallingHandlers(error = timeoutdav)
                 }, warning = function(e) {

                   shinyjs::alert("David's server is busy")
                   warning("David's server is busy")
                   return(NULL)

                 })
               })

  if(!hmana)
    pdf(NULL)

  enrichmanalysis$mygodavid <- mygodavid

  updateTabsetPanel(session = parent_session, inputId=  tabsetpanid,
                    selected = tabPanel)


  return(enrichmanalysis)
})


Species <- reactive({

  if ( input$selspecies == "Homo sapiens") { # human
#~     library("org.Hs.eg.db")
#~     return(list(org.Hs.egALIAS2EG, org.Hs.egSYMBOL))
  }
  else if ( input$selspecies == "Mus musculus" ) { # Mouse
#~     library("org.Mm.eg.db")
#~     return( list(org.Mm.egALIAS2EG, org.Mm.egSYMBOL))
  }
  else if (input$selspecies == "Danio rerio") { #Zebra fish
#~     library("org.Dr.eg.db")
#~     return(list(org.Dr.egALIAS2EG, org.Dr.egSYMBOL))
  }
  else if (input$selspecies == "Gallus gallus") { # chicken
#~     library("org.Gg.eg.db")
#~     return(list(org.Gg.egALIAS2EG, org.Gg.egSYMBOL))
  }
  else if ( input$selspecies == "equCab2") { # horse
#~     library("org.Gg.eg.db")
#~     return(list(org.Gg.eg.dbALIAS2EG))
  }
  else if (input$selspecies == "Caenorhabditis elegans") { # cC elegans
#~     library("org.Ce.eg.db")
#~     return(list(org.Ce.egALIAS2EG, org.Ce.egSYMBOL))
  }
  else if ( input$selspecies == "Rattus norvegicus") { # Rat
#~     library("org.Rn.eg.db")
#~     return(list(org.Rn.egALIAS2EG, org.Rn.egSYMBOL ))
  }
  else if (input$selspecies == "Sus scrofa") { # Pig
#~     library("org.Ss.eg.db")
#~     return(list(org.Ss.egALIAS2EG, org.Ss.egSYMBOL))
  }

})

  return(reactive({
    validate(need((input$GOana),'You need to click on the run Analysis button!'))
    resAnalysis()
  }))

}


back to top

Software Heritage — Copyright (C) 2015–2026, The Software Heritage developers. License: GNU AGPLv3+.
The source code of Software Heritage itself is available on our development forge.
The source code files archived by Software Heritage are available under their own copyright and licenses.
Terms of use: Archive access, API— Content policy— Contact— JavaScript license information— Web API