diff --git a/components/board.connectivity/R/connectivity_plot_connectivityHeatmap.R b/components/board.connectivity/R/connectivity_plot_connectivityHeatmap.R index 3aeae283d..c03f71a28 100644 --- a/components/board.connectivity/R/connectivity_plot_connectivityHeatmap.R +++ b/components/board.connectivity/R/connectivity_plot_connectivityHeatmap.R @@ -99,7 +99,7 @@ connectivity_plot_connectivityHeatmap_server <- function(id, } F <- F[order(-rowMeans(F**2, na.rm = TRUE)), , drop = FALSE] F <- scale(F, center = FALSE) - + list( F = F, score = rho2 @@ -124,42 +124,41 @@ connectivity_plot_connectivityHeatmap_server <- function(id, ) } - reverse_negative <- function(F, k=1) { - ## reverse sign of negative profiles - fsign <- sign(cor(F, F[,k])[,1]) - F2 <- t( t(F) * fsign) - ii <- which(fsign < 0) - if(length(ii)) { - reverse_contrast_name <- function(s) { - prefix <- sub(":.*","",s) - if(prefix==s) { - prefix=NULL - } else { - prefix <- paste0(prefix,":") - } - vs.name <- sub(".*[:]","",s) - vs.name2 <- strsplit(vs.name, split="_vs_")[[1]] - paste0(prefix,paste(rev(vs.name2),collapse="_vs_")) - } - rev.name <- sapply(colnames(F2)[ii], reverse_contrast_name ) - colnames(F2)[ii] <- rev.name + reverse_negative <- function(F, k = 1) { + ## reverse sign of negative profiles + fsign <- sign(cor(F, F[, k])[, 1]) + F2 <- t(t(F) * fsign) + ii <- which(fsign < 0) + if (length(ii)) { + reverse_contrast_name <- function(s) { + prefix <- sub(":.*", "", s) + if (prefix == s) { + prefix <- NULL + } else { + prefix <- paste0(prefix, ":") + } + vs.name <- sub(".*[:]", "", s) + vs.name2 <- strsplit(vs.name, split = "_vs_")[[1]] + paste0(prefix, paste(rev(vs.name2), collapse = "_vs_")) } - F2 + rev.name <- sapply(colnames(F2)[ii], reverse_contrast_name) + colnames(F2)[ii] <- rev.name + } + F2 } - - create_iheatmap <- function(F, score, maxfc = 20, maxgenes = 60) { + create_iheatmap <- function(F, score, maxfc = 20, maxgenes = 60) { sel <- 1:min(NCOL(F), maxfc) F <- F[, sel, drop = FALSE] score <- score[colnames(F)] F <- head(F, maxgenes) - if(input$reverse_neg) { - F <- reverse_negative(F, k=1) - score <- abs(score) + if (input$reverse_neg) { + F <- reverse_negative(F, k = 1) + score <- abs(score) } ii <- order(rowMeans(F, na.rm = TRUE)) F <- F[ii, ] - + plt <- iheatmapr::main_heatmap( data = t(F), layout = list(margin = list(r = 0)) diff --git a/components/board.connectivity/R/connectivity_plot_connectivityMap.R b/components/board.connectivity/R/connectivity_plot_connectivityMap.R index 812f79517..b9c4d164d 100644 --- a/components/board.connectivity/R/connectivity_plot_connectivityMap.R +++ b/components/board.connectivity/R/connectivity_plot_connectivityMap.R @@ -403,7 +403,7 @@ connectivity_plot_connectivityMap_server <- function(id, plt <- plt %>% plotly::layout( showlegend = FALSE, - margin = list(l = 0, r = 0, b = 0, t = 0) + margin = list(l = 0, r = 0, b = 0, t = 0) ) %>% plotly::hide_colorbar() return(plt) diff --git a/components/board.connectivity/R/connectivity_server.R b/components/board.connectivity/R/connectivity_server.R index 019f959bc..f4695eb3d 100644 --- a/components/board.connectivity/R/connectivity_server.R +++ b/components/board.connectivity/R/connectivity_server.R @@ -71,14 +71,14 @@ ConnectivityBoard <- function( meta2 <- pgx$gset.meta$meta has.contrast <- ct %in% names(meta1) && ct %in% names(meta2) shiny::req(has.contrast) - + if (!has.contrast) { dbg("[ConnectivityBoard:getCurrentContrast] ERROR! ct = ", ct) dbg("[ConnectivityBoard:getCurrentContrast] ERROR! names(gx.meta) = ", names(meta1)) dbg("[ConnectivityBoard:getCurrentContrast] ERROR! names(gset.meta) = ", names(meta2)) return(NULL) } - + fc <- meta1[[ct]]$meta.fx names(fc) <- rownames(meta1[[ct]]) gs <- meta2[[ct]]$meta.fx @@ -87,16 +87,16 @@ ConnectivityBoard <- function( list(name = ct, fc = fc, gs = gs) }) -## observeEvent({ -## getCurrentContrast() -## input$genelist_ntop -## },{ + ## observeEvent({ + ## getCurrentContrast() + ## input$genelist_ntop + ## },{ observe({ contr <- getCurrentContrast() shiny::req(contr) ntop <- as.integer(input$genelist_ntop) top50 <- head(names(sort(abs(contr$fc), decreasing = TRUE)), ntop) - top50 <- paste(top50, collapse = " ") + top50 <- paste(top50, collapse = " ") updateTextAreaInput(session, "genelist", value = top50) }) @@ -269,8 +269,8 @@ ConnectivityBoard <- function( } scores <- as.data.frame(all.scores[[ct]]) - dbg("[getConnectivityScores] dim.scores=",dim(scores)) - + dbg("[getConnectivityScores] dim.scores=", dim(scores)) + if (input$abs_score == FALSE) { ## put sign back!!! scores$score <- scores$score * sign(scores$rho) diff --git a/components/board.connectivity/R/connectivity_table_foldchange.R b/components/board.connectivity/R/connectivity_table_foldchange.R index f0f7ded46..5988615b1 100644 --- a/components/board.connectivity/R/connectivity_table_foldchange.R +++ b/components/board.connectivity/R/connectivity_table_foldchange.R @@ -68,7 +68,7 @@ connectivity_table_foldchange_server <- function(id, fillContainer = TRUE, options = list( dom = "lfrtip", - #dom = "lrtip", + # dom = "lrtip", pageLength = 99999, scrollX = TRUE, scrollY = height, diff --git a/components/board.connectivity/R/connectivity_ui.R b/components/board.connectivity/R/connectivity_ui.R index e2790e4a8..e33c934fc 100644 --- a/components/board.connectivity/R/connectivity_ui.R +++ b/components/board.connectivity/R/connectivity_ui.R @@ -59,10 +59,11 @@ ConnectivityInputs <- function(id) { "Paste a list of genes that defines your signature. By default, the top50 most (absolute) differentially expressed genes (by logFC) are chosen for the selected comparison." ), shiny::radioButtons( - ns("genelist_ntop"), - "ngenes:", choices = c(10,50,100), - sel = 50, inline = TRUE - ), + ns("genelist_ntop"), + "ngenes:", + choices = c(10, 50, 100), + sel = 50, inline = TRUE + ), br(), withTooltip( shiny::actionButton(ns("recalc"), "recalculate"),