inst/demos/galFiltered-fromBioconductorGraphNEL/galFiltered.R

library(shiny)
library(cyjShiny)
library(htmlwidgets)
library(graph)
library(jsonlite)

# NOT WORKING: 2023-03-20

#----------------------------------------------------------------------------------------------------

yeastGalactoseGraphNELFile <- system.file(file.path("demos", "galFiltered-fromBioconductorGraphNEL", "yeastGalactoseGraphNEL.RData"), package="cyjShiny")
yeastGalactoseFile <- system.file(file.path("demos", "galFiltered-fromBioconductorGraphNEL", "yeastGalactose.RData"), package="cyjShiny")
  
load(yeastGalactoseGraphNELFile)
load(yeastGalactoseFile)
tbl.mrna <- as.data.frame(tbl.mrna)
nodeAttrs <- nodeData(g, attr="label")

g <- removeNode("YER056CA", g) #not used in all three experimental conditions

yeastGalactoseNodeNames <- as.character(nodeAttrs)
yeastGalactodeNodeIDs <- nodes(g)

g <- addNode("gal1RGexp", g)
graphAsJSON <- graphNELtoJSON(g)

styleList <- c(" ", "Yeast-Galactose"="yeastGalactoseStyle.js",
                   "Random Graph Style"="randomGraph.style")

condition <- c("", "gal1RGexp", "gal4RGexp", "gal80Rexp")
#----------------------------------------------------------------------------------------------------
ui = shinyUI(fluidPage(

  # includeScript("message-handler.js"),

  tags$head(
     tags$style("#cyjShiny{height:95vh !important;}")),
  titlePanel(title="galFiltered from Bioconductor GraphNel"),
  sidebarLayout(
      sidebarPanel(
          selectInput("loadStyleFile", "Select Style: ", choices=styleList),
          selectInput("doLayout", "Select Layout:",
                      choices=c("",
                                "cose",
                                "cola",
                                "circle",
                                "concentric",
                                "breadthfirst",
                                "grid",
                                "random",
                                "preset",
                                "fcose")),

          selectInput("setNodeAttributes", "Select Condition:", choices=condition),
          selectInput("selectName", "Select Node by ID:", choices = c("", nodes(g))),
          actionButton("sfn", "Select First Neighbor"),
          actionButton("fit", "Fit Graph"),
          actionButton("fitSelected", "Fit Selected"),
          actionButton("clearSelection", "Unselect Nodes"),
          HTML("<br>"),
          actionButton("loopConditions", "Loop Conditions"),
          HTML("<br>"),
          actionButton("removeGraphButton", "Remove Graph"),
          HTML("<br>"),
          actionButton("addRandomGraphFromDataFramesButton", "Add Random Graph"),
          HTML("<br>"),
          actionButton("getSelectedNodes", "Get Selected Nodes"),
          HTML("<br><br>"),
          htmlOutput("selectedNodesDisplay"),
          width=2
      ),
      mainPanel(cyjShinyOutput('cyjShiny'),
          width=10
      )
  ) # sidebarLayout
))
#----------------------------------------------------------------------------------------------------
server = function(input, output, session)
{
    observeEvent(input$fit, ignoreInit=TRUE, {
       fit(session, 80)
       })

    observeEvent(input$setNodeAttributes, ignoreInit=TRUE, {
       attribute <- "lfc"
       expression.vector <- switch(input$setNodeAttributes,
                                   "gal1RGexp" = tbl.mrna$gal1RGexp,
                                   "gal4RGexp" = tbl.mrna$gal4RGexp,
                                   "gal80Rexp" = tbl.mrna$gal80Rexp)
       setNodeAttributes(session, attributeName=attribute, nodes=yeastGalactodeNodeIDs, values=expression.vector)
       })

    observeEvent(input$loadStyleFile,  ignoreInit=TRUE, {
        if(input$loadStyleFile != "")
            loadStyleFile(input$loadStyleFile)
    })

    observeEvent(input$doLayout,  ignoreInit=TRUE,{
        strategy <- input$doLayout
        doLayout(session, strategy)
        #session$sendCustomMessage(type="doLayout", message=list(input$doLayout))
    })

    observeEvent(input$selectName,  ignoreInit=TRUE,{
        session$sendCustomMessage(type="selectNodes", message=list(input$selectName))
    })

    observeEvent(input$sfn,  ignoreInit=TRUE,{
        session$sendCustomMessage(type="sfn", message=list())
    })

    observeEvent(input$fitSelected,  ignoreInit=TRUE,{
        fitSelected(session, 100)
    })

    observeEvent(input$getSelectedNodes, ignoreInit=TRUE, {
        output$selectedNodesDisplay <- renderText({" "})
        getSelectedNodes(session)
    })

    observeEvent(input$clearSelection,  ignoreInit=TRUE, {
        session$sendCustomMessage(type="clearSelection", message=list())
    })

    observeEvent(input$loopConditions, ignoreInit=TRUE, {
        condition.names <- c("gal1RGexp", "gal4RGexp", "gal80Rexp")
        for(condition.name in condition.names){
           expression.vector <- tbl.mrna[, condition.name]
           setNodeAttributes(session, attributeName="lfc", nodes=yeastGalactodeNodeIDs, values=expression.vector)
           Sys.sleep(1)
           } # for condition.name
        updateSelectInput(session, "setNodeAttributes", selected="gal1RGexp")
        })

    observeEvent(input$removeGraphButton, ignoreInit=TRUE, {
        removeGraph(session)
        })

    observeEvent(input$addRandomGraphFromDataFramesButton, ignoreInit=TRUE, {
        source.nodes <-  LETTERS[sample(1:5, 5)]
        target.nodes <-  LETTERS[sample(1:5, 5)]
        tbl.edges <- data.frame(source=source.nodes,
                                target=target.nodes,
                                interaction=rep("generic", length(source.nodes)),
                                stringsAsFactors=FALSE)
        all.nodes <- sort(unique(c(source.nodes, target.nodes, "orphan")))
        tbl.nodes <- data.frame(id=all.nodes,
                                type=rep("unspecified", length(all.nodes)),
                                stringsAsFactors=FALSE)
        addGraphFromDataFrame(session, tbl.edges, tbl.nodes)
        })

    observeEvent(input$selectedNodes, {
        newNodes <- input$selectedNodes;
        output$selectedNodesDisplay <- renderText({
           paste(newNodes)
           })
        })

    output$value <- renderPrint({ input$action })
    output$cyjShiny <- renderCyjShiny(
        cyjShiny(graphAsJSON, layout="preset")
    )

} # server
#----------------------------------------------------------------------------------------------------
runApp(shinyApp(ui = ui, server = server), port=10001)

Try the cyjShiny package in your browser

Any scripts or data that you put into this service are public.

cyjShiny documentation built on March 31, 2023, 10:24 p.m.