Improvements multiwgcna

VERSION

@@ -1 +1 @@
-v4.1.2+devel260116
+v4.1.2+devel260114

components/00SourceAll.R

@@ -274,6 +274,7 @@ if(!file.exists('00SourceAll.R')) {
   source('board.wgcna/R/consensusWGCNA/consensuswgcna_ui.R',encoding='UTF-8')
   source('board.wgcna/R/multiwgcna/board_multiwgcna_server.R',encoding='UTF-8')
   source('board.wgcna/R/multiwgcna/board_multiwgcna_ui.R',encoding='UTF-8')
+  source('board.wgcna/R/multiwgcna/multiwgcna_html_report.R',encoding='UTF-8')
   source('board.wgcna/R/multiwgcna/multiwgcna_plot_dendrograms.R',encoding='UTF-8')
   source('board.wgcna/R/multiwgcna/multiwgcna_plot_lasagna.R',encoding='UTF-8')
   source('board.wgcna/R/multiwgcna/multiwgcna_plot_modulecorr.R',encoding='UTF-8')
@@ -298,6 +299,7 @@ if(!file.exists('00SourceAll.R')) {
   source('board.wgcna/R/preservationWGCNA/preservationwgcna_table_modulegenes.R',encoding='UTF-8')
   source('board.wgcna/R/preservationWGCNA/preservationwgcna_ui.R',encoding='UTF-8')
   source('board.wgcna/R/wgcna_html_module_summary.R',encoding='UTF-8')
+  source('board.wgcna/R/wgcna_html_report.R',encoding='UTF-8')
   source('board.wgcna/R/wgcna_plot_correlation_network.R',encoding='UTF-8')
   source('board.wgcna/R/wgcna_plot_eigengene_clustering.R',encoding='UTF-8')
   source('board.wgcna/R/wgcna_plot_eigengene_heatmap.R',encoding='UTF-8')

components/app/R/server.R

@@ -173,31 +173,14 @@ app_server <- function(input, output, session) {
     enable_info = shiny::reactive(input$enable_info)
   )
 
-  ## observe and set global User options
-  shiny::observeEvent( input$enable_llm, {
-    model <- input$llm_model
-    if(input$enable_llm) {
-      if(is.null(model) || model=="") {
-        shinyalert::shinyalert("ERROR",
-          "No LLM server available. Please check your settings.")
-        return(NULL)
-      }
-      shinyalert::shinyalert("WARNING",
-        "Using LLM might expose some of your data to external LLM servers.",
-        closeOnClickOutside = TRUE
-        #showCancelButton = TRUE
-      )
-    }
-  })
-
   shiny::observeEvent({
     list( input$enable_llm, input$llm_model)
   }, {
     if(input$enable_llm) {
       dbg("[MAIN] enable input$llm_model -> ", input$llm_model)
       setUserOption(session,'llm_model', input$llm_model)
     } else {
-      dbg("[MAIN] AI/LLM diabled")
+      dbg("[MAIN] AI/LLM disabled")
       setUserOption(session,'llm_model', '')      
     }
   })
@@ -785,7 +768,7 @@ app_server <- function(input, output, session) {
     bigdash.toggleTab(session, "tcga-tab", show.beta && has.libx)
     bigdash.toggleTab(session, "consensus-tab", show.beta)
     bigdash.toggleTab(session, "preservation-tab", show.beta)
-    bigdash.toggleTab(session, "mwgcna-tab", show.beta)
+    bigdash.toggleTab(session, "mwgcna-tab", show.beta && playbase::is.multiomics(rownames(PGX$counts)))
 
     ## hide beta subtabs..
     toggleTab("drug-tabs", "Connectivity map (beta)", show.beta) ## too slow

components/app/R/ui.R

@@ -329,9 +329,11 @@ app_ui <- function(x) {
                   label = "show captions",
                   is.checked = FALSE
                 ),
-                bslib::input_switch("enable_llm", "Enable AI"),
-                shiny::conditionalPanel(
-                  "input.enable_llm",
+                bslib::input_switch("enable_llm", "Enable AI")
+              ),
+              shiny::conditionalPanel(
+                "input.enable_llm",
+                bigdash::navbarDropdownItem(
                   shiny::selectInput(
                     inputId = "llm_model",
                     label = NULL,

components/board.loading/R/loading_table_datasets_public.R

@@ -39,16 +39,12 @@ loading_table_datasets_public_ui <- function(
         icon = icon("file-import"),
         class = "btn btn-primary"
       ),
-      ## Always render delete button but hidden initially.
-      ## Server-side will control visibility based on user options.
       if (delete_button) {
-        shinyjs::hidden(
-          shiny::actionButton(
-            ns("deletebutton"),
-            label = "Delete dataset",
-            icon = icon("trash"),
-            class = "btn btn-danger"
-          )
+        shiny::actionButton(
+          ns("deletebutton"),
+          label = "Delete dataset",
+          icon = icon("trash"),
+          class = "btn btn-danger"
         )
       }
     )
@@ -62,18 +58,6 @@ loading_table_datasets_public_server <- function(id,
                                                  reload_pgxdir,
                                                  loadAndActivatePGX = NULL) {
   moduleServer(id, function(input, output, session) {
-    ## Control delete button visibility based on per-user options
-    observeEvent(auth$logged, {
-      if (!is.null(auth$logged) && auth$logged) {
-        enable_delete <- isTRUE(auth$options$ENABLE_PUBLIC_DELETE)
-        if (enable_delete) {
-          shinyjs::show("deletebutton")
-        } else {
-          shinyjs::hide("deletebutton")
-        }
-      }
-    })
-
     getPGXINFO_PUBLIC <- shiny::reactive({
       shiny::req(auth$logged)
       if (is.null(auth$logged) || !auth$logged) {

components/board.loading/R/loading_ui.R

@@ -105,7 +105,7 @@ LoadingUI <- function(id) {
           height = c("100%", 700),
           width = c("100%", "100%"),
           load_button = opt$ENABLE_PUBLIC_LOAD,
-          delete_button = TRUE
+          delete_button = opt$ENABLE_PUBLIC_DELETE
         ),
         loading_tsne_ui(
           ns("tsne_public"),

components/board.upload/R/upload_module_normalization.R

@@ -451,7 +451,7 @@ upload_module_normalization_server <- function(
           if (input$missing_plottype == "heatmap") {
             if (any(X2 > 0)) {
               par(mar = c(3, 3, 2, 2), mgp = c(2.5, 0.85, 0))
-              playbase::gx.imagemap(X2, cex = -1, col = rev(heat.colors(64)))
+              playbase::gx.imagemap(X2, cex = -1)
               title("missing values patterns", cex.main = 1.2)
             } else {
               plot.new()

components/board.upload/R/upload_module_preview_counts.R

@@ -519,13 +519,15 @@ upload_table_preview_counts_server <- function(id,
     })
 
     output$histogram <- renderPlot({
+      # counts <- checked_matrix()
       counts <- uploaded$counts.csv
       shiny::req(counts)
       xx <- counts
       if (!is_logscale()) {
         prior <- min(counts[counts > 0], na.rm = TRUE)
         xx <- log2(prior + counts)
       }
+      # Add seed to make it deterministic
       set.seed(123)
       if (nrow(xx) > 1000) xx <- xx[sample(1:nrow(xx), 1000), , drop = FALSE]
       suppressWarnings(dc <- reshape2::melt(xx))
@@ -547,7 +549,9 @@ upload_table_preview_counts_server <- function(id,
         xx <- log2(pmax(xx, 0) + prior)
       }
       # Downsample to 40 columns as we do on qc/bc tab
-      if (ncol(xx) > 40) xx <- xx[, sample(1:ncol(xx), 40)]
+      if (ncol(xx) > 40) {
+        xx <- xx[, sample(1:ncol(xx), 40)]
+      }
       boxplot(xx, ylab = tspan("counts (log2)", js = FALSE))
     })
 
@@ -613,13 +617,19 @@ upload_table_preview_counts_server <- function(id,
       ## ---counts---##
       sel <- grep("count|expression|abundance|concentration", tolower(input$counts_csv$name))
       if (length(sel)) {
-
         datafile <- input$counts_csv$datapath[sel[1]]
         datafile.name <- input$counts_csv$name
         file.ext <- tools::file_ext(datafile.name)
 
         if (upload_datatype() == "scRNA-seq" && file.ext == "h5") {
-          df <- tryCatch({ playbase::read_h5_counts(datafile) }, error = function(w) { NULL } )
+          df <- tryCatch(
+            {
+              playbase::read_h5_counts(datafile)
+            },
+            error = function(w) {
+              NULL
+            }
+          )
           if (is.null(df)) {
             shinyalert::shinyalert(
               title = "Error",
@@ -631,12 +641,12 @@ upload_table_preview_counts_server <- function(id,
           df.samples <- NULL
           if (upload_datatype() == "proteomics" && is.olink()) {
             df <- tryCatch(
-            {
-              playbase::read_Olink_NPX(datafile)
-            },
-            error = function(w) {
-              NULL
-            }
+              {
+                playbase::read_Olink_NPX(datafile)
+              },
+              error = function(w) {
+                NULL
+              }
             )
             if (is.null(df)) {
               shinyalert::shinyalert(
@@ -646,51 +656,44 @@ upload_table_preview_counts_server <- function(id,
             }
             if (!is.null(df)) {
               df.samples <- tryCatch(
+                {
+                  playbase::read_Olink_samples(datafile)
+                },
+                error = function(w) {
+                  NULL
+                }
+              )
+            }
+          } else {
+            df <- tryCatch(
               {
-                playbase::read_Olink_samples(datafile)
+                playbase::read_counts(datafile)
               },
               error = function(w) {
                 NULL
               }
-              )
-            }
-          } else if (upload_datatype() == "proteomics" && !is.olink()) {
-            df <- tryCatch({ playbase::read_counts(datafile) }, error = function(w) { NULL } )
-            if (is.null(df)) {
-              df <- tryCatch({ playbase::read_spectronaut(datafile) }, error = function(w) { NULL } )
-              if (!is.null(df)) {
-                char.cols <- which(sapply(df, class) == "character")
-                if (length(char.cols) > 0) {
-                  uploaded$annot.csv <- df[, names(char.cols), drop = FALSE]
-                  df <- df[, colnames(df) != names(char.cols), drop = FALSE]
-                  df <- as.matrix(df)
-                }
-              }
-            }
-          } else {
-            df <- tryCatch({ playbase::read_counts(datafile) }, error = function(w) { NULL } )
+            )
           }
         }
       } else {
         df <- tryCatch(
-        {
-          playbase::read_counts(datafile)
-        },
-        error = function(w) {
-          NULL
-        }
+          {
+            playbase::read_counts(datafile)
+          },
+          error = function(w) {
+            NULL
+          }
         )
       }
-
-
+
       file.ext <- tools::file_ext(input$counts_csv$name)
       if (is.null(df) & file.ext != "h5") {
         data_error_modal(path = datafile, data_type = "counts")
       } else {
         uploaded$counts.csv <- df
-        if (is.null(uploaded$annot.csv)) {
-          uploaded$annot.csv <- if (file.ext != "h5") playbase::read_annot(datafile) else NULL
-        }
+        af <- NULL
+        if (file.ext != "h5") af <- playbase::read_annot(datafile)
+        uploaded$annot.csv <- af
       }
 
       if (upload_datatype() == "proteomics" && is.olink() && !is.null(df.samples)) {
@@ -764,4 +767,4 @@ upload_table_preview_counts_server <- function(id,
       selector = "none"
     )
   }) ## end of moduleServer
-} ## end of server
+} ## end of server

components/board.wgcna/R/consensusWGCNA/consensuswgcna_plot_dendrograms.R

@@ -62,7 +62,7 @@ consensusWGCNA_plot_dendrograms_server <- function(id,
       mytrees <- c(0, names(cons$layers))
       shiny::req(input$clusterby %in% mytrees)
 
-      playbase::wgcna.plotDendroAndTraitCorrelation(
+      playbase::wgcna.plotDendroAndColors(      
         cons,
         main = "",
         show.traits = input$showtraits,

components/board.wgcna/R/multiwgcna/board_multiwgcna_server.R

@@ -39,11 +39,16 @@ MultiWGCNA_Board <- function(id, pgx) {
 
     # Observe tabPanel change to update Settings visibility
     tab_elements <- list(
-      "Dendrograms" = list(disable = c("phenotype", "module", "condition", "lasagna_options")),
-      "Module-Trait" = list(disable = c("phenotype", "module", "condition", "wgcna_options", "lasagna_options")),
-      "Module correlation" = list(disable = c("phenotype", "module", "wgcna_options", "lasagna_options")),
-      "WGCNA-Lasagna" = list(disable = c("module", "condition", "wgcna_options")),
-      "Feature Table" = list(disable = c("layers", "condition", "wgcna_options", "lasagna_options"))
+      "Dendrograms" = list(disable = c("phenotype", "module", "condition", "lasagna_options", "report_options")),
+      "Module-Trait" = list(disable = c("phenotype", "module", "condition", "wgcna_options",
+        "lasagna_options", "report_options")),
+      "Module correlation" = list(disable = c("phenotype", "module", "wgcna_options", "lasagna_options",
+        "report_options")),
+      "WGCNA-Lasagna" = list(disable = c("module", "condition", "wgcna_options", "report_options")),
+      "Feature Table" = list(disable = c("layers", "condition", "wgcna_options", "lasagna_options",
+        "report_options")),
+      "AI Report" = list(disable = c("phenotype","module", "condition", "layers", "lasagna_options",
+        "wgcna_options"))
     )
 
     shiny::observeEvent(input$tabs, {
@@ -54,20 +59,6 @@ MultiWGCNA_Board <- function(id, pgx) {
     ## ============================ REACTIVES =====================================
     ## ============================================================================
 
-    shiny::observeEvent(pgx$X,
-      {
-        dataX <- playbase::mofa.split_data(pgx$X)
-        datatypes <- c(names(dataX), "gset")
-        sel.datatypes <- datatypes
-        updateSelectInput(session, "layers",
-          choices = datatypes,
-          selected = sel.datatypes
-        )
-      },
-      ignoreNULL = FALSE
-    )
-
-
     r_multiwgcna <- shiny::eventReactive(
       {
         list(input$compute, pgx$X)
@@ -101,7 +92,7 @@ MultiWGCNA_Board <- function(id, pgx) {
           contrasts = contrasts,
           do.consensus = input$consensus,
           add.pheno = (ncol(samples) > 10),
-          add.gsets = TRUE,
+          add.gsets = input$addgsets,
           cutMethod = "hybrid",
           deepsplit = as.integer(input$deepsplit),
           power = power,
@@ -114,7 +105,6 @@ MultiWGCNA_Board <- function(id, pgx) {
           gset.methods = c("gsetcor","xcor","fisher"),        
           annot = pgx$genes,
           GMT = pgx$GMT,  
-          ##gsetX = pgx$gsetX,  ## ??
           summary = TRUE,
           ai_model = NULL,
           ai_experiment = pgx$description,
@@ -141,7 +131,6 @@ MultiWGCNA_Board <- function(id, pgx) {
           selected = sel.layers
         )
 
-
         all_modules <- lapply(wgcna, function(w) sort(names(w$me.genes)))
         module1 <- all_modules[[1]][1]
         updateSelectInput(session, "module",
@@ -222,6 +211,14 @@ MultiWGCNA_Board <- function(id, pgx) {
       watermark = WATERMARK
     )
 
+    wgcna_html_report_server(
+      id = "multiwgcnaReport",
+      wgcna = r_multiwgcna,
+      multi = TRUE,
+      r_annot = reactive(pgx$genes),      
+      watermark = WATERMARK
+    )
+
     return(NULL)
   })
 } ## end of Board