CODE CLEAN UP, UPDATE UI

- migrated cliquesum code to ppi network module
- added placeholder for text input
- file handling

R/mod_CClique.R

@@ -13,7 +13,7 @@ mod_CClique_ui <- function(id){
     uiOutput(ns("input_choice")),
     uiOutput(ns("ppi_choice")),
     tags$div(id = "error_name_CClique_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     sliderInput(ns("frequency_cutoff"), label = "Select frequency cutoff", min = 0, max = 1, value = 0.5, popup = "Fraction of the number of times a gene should be present in the iterations"),

R/mod_CliqueSum.R

@@ -9,9 +9,19 @@
 #' @importFrom shiny NS tagList 
 mod_CliqueSum_ui <- function(id){
   ns <- NS(id)
-  tagList(
-          uiOutput(ns("parameters")),
-          uiOutput(ns("build_clique"))
+  tagList(uiOutput(ns("input_choice")),
+          uiOutput(ns("ppi_choice")),
+          tags$div(id = "error_name_CliqueSum_js",
+                  textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods", placeholder = "Module name")),
+          uiOutput(ns("error_name_descrip")),
+          uiOutput(ns("error_name_js")),
+          sliderInput(ns("clique_significance"), label = "Clique significance", min = 0, max = 1, value = 0.05, popup ="P-value for cliques to be considered significant"),
+          numericInput(ns("min_clique_size"), label = "Minimal clique size", value = 2, max = 50, min = 2, popup = "Minimal size of cliques"),
+          numericInput(ns("n_iterations"), label = "Iterations", value = 500, max = 10000, min = 0, popup = "Number of iterations to be performed for the permutation based P-value"),
+          tags$div(style = "text-align:center",
+                  actionButton(ns("load_input"), label = "Infer Clique Sum module", onclick="loading_modal_open(); stopWatch()"),
+                  htmlOutput(ns("close_loading_modal")) # Close modal with JS
+           )
   )
 }
 
@@ -23,57 +33,6 @@ mod_CliqueSum_server <- function(input, output, session, con, upload_ui_1){
 
   CliqueSum_module <- reactiveValues()
 
-  UI <- tagList(
-    uiOutput(ns("input_choice")),
-    uiOutput(ns("ppi_choice")),
-    tags$div(id = "error_name_CliqueSum_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods")),
-    uiOutput(ns("error_name_descrip")),
-    uiOutput(ns("error_name_js")),
-    sliderInput(ns("clique_significance"), label = "Clique significance", min = 0, max = 1, value = 0.05, popup ="P-value for cliques to be considered significant"),
-    numericInput(ns("min_clique_size"), label = "Minimal clique size", value = 2, max = 50, min = 2, popup = "Minimal size of cliques"),
-    numericInput(ns("n_iterations"), label = "Iterations", value = 500, max = 10000, min = 0, popup = "Number of iterations to be performed for the permutation based P-value"),
-    tags$div(style = "text-align:center",
-    actionButton(ns("load_input"), label = "Infer Clique Sum module", onclick="loading_modal_open(); stopWatch()"),
-    htmlOutput(ns("close_loading_modal")) # Close modal with JS
-    )
-  )
-
-  if (nrow(MODifieRDB::get_available_db_networks(con)) != 0 ) {
-    output$parameters <- renderUI({
-      UI
-    })
-  } else {
-
-    output$build_clique <- renderUI({
-      tagList(
-        uiOutput(ns("ppi_choice")),
-        textInput(ns("db_name"), "Clique database name"),
-        tags$div(style = "text-align:center",
-        actionButton(ns("build_db"), "Build clique database")),
-
-      )
-    })
-
-
-    observeEvent(input$build_db, {
-      output$build_clique <- renderUI({})
-
-      id <- showNotification("Creating clique database", duration = NULL, closeButton = FALSE, type = "warning")
-
-      clique_db <- MODifieRDB::build_clique_db_db(ppi_name = input$ppi_object,
-                                                  db_folder =  "./.." , 
-                                                  db_name = input$db_name,
-                                                  con = con
-      )
-      on.exit(removeNotification(id), add = TRUE)
-
-      output$parameters <- renderUI({
-        UI
-      })
-    })
-  }
-
   module_name <- reactive({
     input$module_name
   })

R/mod_DIAMoND.R

@@ -13,7 +13,7 @@ mod_DIAMoND_ui <- function(id){
     uiOutput(ns("input_choice")),
     uiOutput(ns("ppi_choice")),
     tags$div(id = "error_name_DIAMoND_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     sliderInput(ns("seed_weight"), label = "Select Seed Weight", min = 0, max = 50, value = 25, popup = "Additional numeric parameter to assign weight for the seed genes."),

R/mod_DiffCoEx.R

@@ -12,7 +12,7 @@ mod_DiffCoEx_ui <- function(id){
   tagList(
     uiOutput(ns("input_choice")),
     tags$div(id = "error_name_DiffCoEx_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     radioButtons(ns("cluster_method"), "Select a cluster method:", 

R/mod_MCODE.R

@@ -13,7 +13,7 @@ mod_MCODE_ui <- function(id){
     uiOutput(ns("input_choice")),
     uiOutput(ns("ppi_choice")),
     tags$div(id = "error_name_MCODE_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     radioButtons(

R/mod_MODA.R

@@ -12,7 +12,7 @@ mod_MODA_ui <- function(id){
   tagList(
     uiOutput(ns("input_choice")),
     tags$div(id = "error_name_MODA_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods.", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     radioButtons(

R/mod_Modulediscoverer.R

@@ -13,7 +13,7 @@ mod_Modulediscoverer_ui <- function(id){
     uiOutput(ns("input_choice")),
     uiOutput(ns("ppi_choice")),
     tags$div(id = "error_name_Modulediscoverer_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
     sliderInput(ns("permutations"), label= "Permutations", min = 0, max = 10000, value = 5000, popup = "Number of permutations to perform to identify the community structure"),

R/mod_WGCNA.R

@@ -12,7 +12,7 @@ mod_WGCNA_ui <- function(id){
   tagList(
     uiOutput(ns("input_choice")),
     tags$div(id = "error_name_WGCNA_js",
-    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods")),
+    textInput(ns("module_name"), "Module object name", popup = "Object that is produced by the disease module inference methods", placeholder = "Module name")),
     uiOutput(ns("error_name_descrip")),
     uiOutput(ns("error_name_js")),
 

R/mod_input_overview.R

@@ -13,7 +13,7 @@ mod_input_overview_ui <- function(id){
     DT::dataTableOutput(ns("input_overview")),
     tags$div(`class`="row",
              tags$div(`class`="col-sm-8", style = "color:black",
-             fileInput(ns("input_object"), label = "Upload an input object"),
+             fileInput(ns("input_object"), label = "Upload an input object", accept = ".rds"),
              uiOutput(ns("input_name_chooser"))),
              tags$br(),
              tags$div(`class`="col-sm-4", style = "text-align:right",
@@ -37,25 +37,29 @@ mod_input_overview_server <- function(input, output, session, con){
 
       return(NULL)
     }
-
-    read.table(file = infile, header = T)
+    readRDS(file = infile)
   })
 
   # File input
   output$input_name_chooser <- renderUI({
-    input <- upload_input() #reactive
+    input <- upload_input() #reactive pop up
     tagList( 
-      textInput(ns("input_name"), "Input object name"),
+      textInput(ns("input_name"), "Input object name", placeholder = "Input name"),
       actionButton(ns("upload_input"), "Add input object to database")
     )
   })
 
+  # Name reactive
+  input_name <- reactive({
+    input$input_name
+  })
+
   # Upload input object
   observeEvent(input$upload_input, {
-    id <- showNotification("Saving input object to database", duration = NULL, closeButton = FALSE)
-    input <- upload_input()
-    input_name <- input$input_name
+    id <- showNotification("Saving input object to database", duration = NULL, closeButton = FALSE, type = "warning")
     on.exit(removeNotification(id), add = TRUE)
+    input <- upload_input()
+    input_name <- input_name()
 
     MODifieRDB::MODifieR_object_to_db(MODifieR_object = input,
                                       object_name = input_name,

R/mod_module_overview.R

@@ -13,7 +13,7 @@ mod_module_overview_ui <- function(id){
     DT::dataTableOutput(ns("module_overview")),
     tags$div(`class`="row",
              tags$div(`class`="col-sm-8", style = "color:black",
-             fileInput(ns("module_object"), label = "Upload a module object"),
+             fileInput(ns("module_object"), label = "Upload a module object", accept =  ".rds"),
              uiOutput(ns("module_name_chooser"))),
              tags$br(),
              tags$div(`class`="col-sm-4", style = "text-align:right",
@@ -38,23 +38,29 @@ mod_module_overview_server <- function(input, output, session, con){
       return(NULL)
     }
 
-    read.table(file = infile, header = T)
+    readRDS(file = infile)
   })
 
   output$module_name_chooser <- renderUI({
-    module <- upload_module() #reactive
+    module <- upload_module() #reactive pop up
     tagList( 
-      textInput(ns("module_name"), "Module object name"),
+      textInput(ns("module_name"), "Module object name", placeholder = "Module name"),
       actionButton(ns("upload_module"), "Add module object to database")
     )
   })
 
+  # Name reactive
+  module_name <- reactive({
+    input$module_name
+  })
+
   # Upload module
   observeEvent(input$upload_module, {
-    id <- showNotification("Saving module object to database", duration = NULL, closeButton = FALSE)
-    module <- upload_module()
-    module_name <- input$module_name
+    id <- showNotification("Saving module object to database", duration = NULL, closeButton = FALSE, type = "warning")
     on.exit(removeNotification(id), add = TRUE)
+    module <- upload_module()
+    module_name <- module_name()
+
 
     MODifieRDB::MODifieR_object_to_db(MODifieR_object = module,
                                       object_name = module_name,

R/mod_ppi_networks.R

@@ -72,16 +72,23 @@ mod_ppi_networks_server <- function(input, output, session, con){
     MODifieRDB::ppi_network_to_db(ppi_network = ppi, ppi_name = ppi_name, con = con)
 
   })
+
 
   if (is.data.frame(ppi_networks) && nrow(ppi_networks)==0) {
     MODifieRDB::ppi_network_to_db(ppi_network = MODifieR::ppi_network,
                                   ppi_name = "Default", 
                                   con = con)
+  } else if (any(ppi_networks == "Default")) {
+    return()
   }
-    else if (any(ppi_networks == "Default")) {
-      return()
-    }
+
+  if (nrow(MODifieRDB::get_available_db_networks(con))==0 ) {
+    clique_db <- MODifieRDB::build_clique_db_db(ppi_name = "Default",
+                                                db_folder =  "./.." , 
+                                                db_name = "Clique_db",
+                                                con = con)
   }
+}
 
 ## To be copied in the UI
 # mod_ppi_networks_ui("ppi_networks_ui_1")

R/mod_upload.R

@@ -10,7 +10,7 @@
 mod_upload_ui <- function(id){
   ns <- NS(id)
   tagList(
-    fileInput(ns("expression_matrix"), label = "Upload an expression matrix", accept = c("text/csv", "text/plain", "application/vnd.ms-excel", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet", ".tsv")),
+    fileInput(ns("expression_matrix"), label = "Upload an expression matrix", accept = c("text/csv", "text/plain", "application/vnd.ms-excel", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet", "text/tab-separated-values", ".rds")),
     uiOutput(ns("sample_chooser")),
     htmlOutput(ns("error_name_js"))
   )
@@ -37,19 +37,23 @@ mod_upload_server <- function(input, output, session, con){
     infile <- (input$expression_matrix$datapath)
     if (is.null(infile)){
       return(NULL)
-      } else {
-        read.table(file = infile, header = T)
-      }
+    }
+    if(input$expression_matrix$type == "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"){
+      readxl::read_excel(infile)
+    }
+    else {
+      read.table(file = infile, header = T) 
+    }
   })
 
   output$sample_chooser <- renderUI({
     expression_matrix <- upload_expression()
     tagList(
       tags$div(id = "error_name_js",
-      textInput(ns("input_name"), "Input object name")),
+      textInput(ns("input_name"), "Input object name", placeholder = "Input name")),
       htmlOutput(ns("error_name_descrip")),
-      textInput(ns("group1"), "Group 1 label"),
-      textInput(ns("group2"), "Group 2 label"),
+      textInput(ns("group1"), "Group 1 label", placeholder = "Group 1 label"),
+      textInput(ns("group2"), "Group 2 label", placeholder = "Group 2 label"),
       chooserInput(ns("sample_groups"), "Available frobs", "Selected frobs", 
                    colnames(expression_matrix), c(), multiple = TRUE),
       tags$br(),
@@ -136,13 +140,14 @@ mod_upload_server <- function(input, output, session, con){
       updateTextInput(session, "group2", value = character(0))
       input_name <- input_name()
       upload_module$input_name <- input_name
+      print(input_object)
       MODifieRDB::MODifieR_object_to_db(MODifieR_object = input_object,
                                         object_name = input_name,
                                         con = con)
     }
     output$close_loading_modal <- renderUI({
      tags$script("loading_modal_close(); reset();")
-      })
+    })
   })
 
   outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)