inst/app/app.R

In chemokine/OmicsSBGN: Overlay omics data onto SBGN pathway diagram

library(shiny)
library(colourpicker)
library(shinyjs)
library(shinycssloaders)
library(shinydashboard)
library(SummarizedExperiment)
library(DT)
library(V8)
# library(OmicsSBGN)
library(SBGNview)
library(gage)
library(SBGNview.data)
data("cancer.ds","pathways.info")
data(IFNg)

get.pathway.candidates = function(){
    print("function to generate pathway candidates")
    pathways.to.select = pathways.info[,"pathway.id"]
    pathway.names = paste0(pathways.info[,"pathway.id"], "::", pathways.info[,"pathway.name"])
    names(pathways.to.select) = pathway.names
    return(pathways.to.select)
}

jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
# ProjectUrl = "https://github.com/chemokine/OmicsSBGN"
ProjectUrl = "https://github.com/datapplab/SBGNview"
jsShinyBusy <- "$('html').hasClass('shiny-busy')"
jsShinyNotBusy <- "!$('html').hasClass('shiny-busy')"
# Dashboard title is what the browser tab will be named
ui <- dashboardPage(
    title = "Omics on SBGN",
    ####################
    # Header
    ####################
    dashboardHeader(
        title = div(
            conditionalPanel(
                jsShinyNotBusy,
                # Sun Icon
                tags$p(
                    style = "font-size:25px;display: inline-block;",
                    class = "disco",
                    "SBGNview"
                )
            ),
            # What happens when R server is Busy/Working
            conditionalPanel(
                jsShinyBusy,
                # Icon spins
                tags$p(
                    style = "font-size:20px;display: inline-block; background-color: orange;",
                    class = "disco",
                    "SBGNview running"
                    # textOutput("SBGNviewBusy")
                )
            )
        ),
        tags$li(
            style = "position: absolute; left: 40px; padding: 0px;",
            class = "dropdown",
            actionLink(
                inputId = "continue",
                # label = HTML(paste(icon("play", class = "disco-button"), ""))
                label = ""
            )
        )
    ),
    
    ####################
    # Sidebar
    ####################
    # List items (parts of analysis) in the sidebar
    dashboardSidebar(sidebarMenu(
        # We need this to update/jump
        # when "Run analyis" in uploadData is clicked
        id = "sidebar",
        tags$head(
            tags$style(HTML("
                    .sidebar { height: 90vh; overflow-y: auto; }
                    "))
            ),
        tags$head(tags$style(".inactiveLink {
                   pointer-events: none;
                   cursor: default;
                   }")),
        shinyjs::useShinyjs(),
        hr(class="sidebarsplitter"),
        menuItem("Introduction",
             tabName = "Introduction"
        ),
        #################################################################################
        hr(class="sidebarsplitter"),
        div(style = "padding-left: 15px;color: var(--neutral2);",
        h4("Select pathway")),
        menuItem("Select pathway",
             tabName = "selectPathway",
             icon = icon("cloud-upload")
        ),
        
        #################################################################################
        hr(class="sidebarsplitter"),
        div(style = "padding-left: 15px;color: var(--neutral2);",
        h4("Input Data")),
        menuSubItem("Upload Omics Data", "upload",
                icon = icon("clock-o")),
        #################################################################################
        hr(class="sidebarsplitter"),
        div(style = "padding-left: 15px;color: var(--neutral2);",
          h4("Main Analysis")),
        menuItem("Overlay Omics Data", tabName = "Overlay",
              icon = icon("signal")),
        
        
        hr(class="sidebarsplitter"),
        tableOutput("summaryTable"),
        p(paste0("Omics on SBGN summary"))
        ,tableOutput("selectedPathFromEnrichOut")
        # Restart App (avoiding V8 dep by using functions arg)
    )),
    
    # Where to find code for each tabItem
    dashboardBody(
        useShinyjs(),
        extendShinyjs(text = jscode),
        includeCSS("www/custom_styles.css"), # custom color themes
        tags$head(tags$style(HTML('
            .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
              background-color: #5B90BF;
              color: #ffffff;
            }
            .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
              background-color: #88c0ea;
              color: "blue";
            }
          '))),
        # HTML(paste0('<link rel="stylesheet" href="https://use.fontawesome.com',
        #       '/releases/v5.3.1/css/all.css">')),
        # HTML(paste0('<link rel="stylesheet" href="https://use.fontawesome.com',
        #       '/releases/v5.3.1/css/v4-shims.css">')),
        # fixed dashboard header/sidebar
        tags$script(HTML("$('body').addClass('fixed');")),
        tabItems(
            tabItem("Introduction",
                source("code/ui/Introduction.R", TRUE)$value),
            tabItem("Overlay",
                source("code/ui/overlay.omics.R", TRUE)$value),
            # tabItem("demoData",
            #     source("code/ui/demoOmicsTable.R", TRUE)$value),
            tabItem("upload",
                source("code/ui/upload.omics.table.R", TRUE)$value),
            tabItem("selectPathway",
                source("code/ui/selectPathway.R", TRUE)$value)
        )
    )
)


#################################################################
server <- function(input, output, session) {
    options(shiny.maxRequestSize=30*1024^2) 
    source("code/server/s_OverlayOmics.R", TRUE)
    source("code/server/s_input.data.R", TRUE)
    source("code/server/s_select.pathway.R", TRUE)
    source("code/server/s_introduction_load.data.R", TRUE)
    observeEvent(input$continue, {
            
        if(input$sidebar == "Overlay") {
            updateTabItems(session, "sidebar", "Overlay")
        # }else if (input$sidebar == "selectData") {
        #     updateTabItems(session, "sidebar", "selectData")
        }else if (input$sidebar == "demoData") {
            updateTabItems(session, "sidebar", "demoData")
        }else if (input$sidebar == "upload") {
            updateTabItems(session, "sidebar", "upload")
        }else if (input$sidebar == "prePathways") {
            updateTabItems(session, inputId = "sidebar", selected = "prePathways")
        }else if (input$sidebar == "Introduction") {
            updateTabItems(session, inputId = "sidebar", selected = "Introduction")
        }
    })
    
    observeEvent(input$AboutSbgnBox, {
        js$collapse("dataIntro")
    })
}

shinyApp(ui, server)