From 88ac3de120fe02e26f0beb60d76960dad7be1da5 Mon Sep 17 00:00:00 2001 From: Nathan Palamuttam <63568423+nathanpalamuttam@users.noreply.github.com> Date: Wed, 7 Feb 2024 11:15:47 -0500 Subject: [PATCH 1/6] Changed mapvalues such that the mapping is functioning properly and the UI is easy to understand --- R/miscFunctions.R | 20 +++++++++++++ inst/shiny/server.R | 44 +++++++++++++++++++++++++++++ inst/shiny/ui_04_fs_dimred.R | 42 +++++++++++++++++++++++++++ man/renameClusters.Rd | 25 ++++++++++++++++ tests/testthat/test-renameCluster.R | 17 +++++++++++ 5 files changed, 148 insertions(+) create mode 100644 man/renameClusters.Rd create mode 100644 tests/testthat/test-renameCluster.R diff --git a/R/miscFunctions.R b/R/miscFunctions.R index 3e3ca09f1..c64a0bf2c 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -475,3 +475,23 @@ getGenesetNamesFromCollection <- function(inSCE, geneSetCollectionName) { code) } } + +#' Add together two numbers +#' +#' @param inSCE Input \linkS4class{SingleCellExperiment} object. +#' @param clusterName Input +#' @param From value to describe what to map +#' @param To value to describe what to map to +#' @param newCluster value to change name of cluster +#' @return inSCE object with changed values +renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) { + clusterLabels <- unique(colData(inSCE)[,clusterName]) + + renamedLabels <- mapvalues(c(clusterLabels), from = c(from), to = c(to)) + if (!is.null(newClusterName)) { + colData(inSCE)[,newClusterName] <- renamedLabels + } else { + colData(inSCE)[,clusterName] <- mapvalues(colData(inSCE)[,clusterName], from = c(from), to = c(to)) + } + return(inSCE) +} diff --git a/inst/shiny/server.R b/inst/shiny/server.R index b75e4f951..847b71e62 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -17,6 +17,7 @@ source("qc_help_pages/ui_doubletFinder_help.R", local = TRUE) # creates several source("qc_help_pages/ui_scrublet_help.R", local = TRUE) # creates several smaller UI components source("qc_help_pages/ui_dc_and_qcm_help.R", local = TRUE) # creates several smaller UI components source("qc_help_pages/ui_scDblFinder_help.R", local = TRUE) # creates several smaller UI components +source(file.path("..","..", "R/miscFunctions.R")) # source("server_partials/server_01_data.R", local = TRUE) # functions for Data section # Define server logic required to draw a histogram @@ -6417,6 +6418,49 @@ shinyServer(function(input, output, session) { observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) + selectInputs1 <- reactiveVal(NULL) + observeEvent(input$gatherLabels, { + output$textFieldsContainer <- renderUI({ + selectInputs <- lapply(unique(colData(vals$counts)[[input$hvgPlotMethod1]]), function(factor) { + local({ + print(factor) + div( + style = "display: flex; align-items: center;", + tags$label( + style = "margin-right: 10px;", + factor + ), + textInput( + inputId = paste0("textField", factor), + label = NULL, + value = "", + width = "300px" + ) + ) + }) + }) + selectInputs1 <- selectInputs + tagList(selectInputs) + }) + print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) + }) + + + observeEvent(input$updatePlotFS1, { + factors <- integer() + text_values <- character() + for (i in 0:length(unique(colData(vals$counts)[[input$hvgPlotMethod1]]))) { + input_id <- paste0("textField", i) + input_value <- input[[input_id]] + if (!is.null(input_value) && nchar(input_value) > 0) { + factors <- c(factors, i) + text_values <- c(text_values, input_value) + } + } + vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values) + print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) + + }) #----------------------------------------------------------------------------- # Page 5.1: Differential Expression #### diff --git a/inst/shiny/ui_04_fs_dimred.R b/inst/shiny/ui_04_fs_dimred.R index a50671c07..ecbe05bed 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -1,3 +1,4 @@ +seurat.version <- packageVersion(pkg = "SeuratObject") shinyPanelFS_DimRed <- fluidPage( tags$script("Shiny.addCustomMessageHandler('close_dropDownDimRedEmbedding', function(x){ $('html').click(); @@ -104,6 +105,47 @@ shinyPanelFS_DimRed <- fluidPage( circle = FALSE, inline = TRUE )), + column(4, dropdown( + fluidRow( + column(width = 12, + fluidRow(actionBttn(inputId = "closeDropDownFS1", + label = NULL, style = "simple", + color = "danger", + icon = icon("times"), size = "xs"), + align = "right"), + selectInput( + inputId = "hvgPlotMethod1", + label = "Cluster Label", + choices = "nothing" + ), + + actionBttn( + inputId = "gatherLabels", + label = "Gather Labels", + style = "bordered", + color = "primary", + size = "sm" + ), + uiOutput("textFieldsContainer"), + textInput( + inputId = "hvgPlotMethod4", + label = "New Cluster Name (optional)", + ), + actionBttn( + inputId = "updatePlotFS1", + label = "Update", + style = "bordered", + color = "primary", + size = "sm" + ) + ) + ), + inputId = "dropDownFS1", + icon = icon("pencil"), + status = "primary", + circle = FALSE, + inline = TRUE + )), column(7, fluidRow(h6("Scatterplot showing the variability of each feature versus its average expression across all cells"), align="center")) ), hr(), diff --git a/man/renameClusters.Rd b/man/renameClusters.Rd new file mode 100644 index 000000000..c39a1943c --- /dev/null +++ b/man/renameClusters.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/miscFunctions.R +\name{renameClusters} +\alias{renameClusters} +\title{Add together two numbers} +\usage{ +renameClusters(inSCE, clusterName, from, to, newClusterName = NULL) +} +\arguments{ +\item{inSCE}{Input \linkS4class{SingleCellExperiment} object.} + +\item{clusterName}{Input} + +\item{From}{value to describe what to map} + +\item{To}{value to describe what to map to} + +\item{newCluster}{value to change name of cluster} +} +\value{ +inSCE object with changed values +} +\description{ +Add together two numbers +} diff --git a/tests/testthat/test-renameCluster.R b/tests/testthat/test-renameCluster.R new file mode 100644 index 000000000..5b194a878 --- /dev/null +++ b/tests/testthat/test-renameCluster.R @@ -0,0 +1,17 @@ +library(singleCellTK) +context("Testing mergeSCColData") +source("C:/Users/Nathan Palamuttam/campbio BU/singleCellTK/R/miscFunctions.R") + +data(scExample, package = "singleCellTK") + +sce <- subsetSCECols(sce, colData = "type != 'EmptyDroplet'") + +colData(sce)$column_name = rownames(colData(sce)) +test_that(desc = "Testing renameClusters", { + renameClusters(inSCE = smallSCE, clusterName = "louvain_0_2", from = c(0), to = c("a")) + colData(sce)$louvain_0_2 + expect_equal(ncol(colData(sce)) + 1, ncol(colData(mergedsce))) +}) + + + From 0bfcaf13f8756ff4eff6ec94ad574dd85e703fd9 Mon Sep 17 00:00:00 2001 From: Nathan Palamuttam <63568423+nathanpalamuttam@users.noreply.github.com> Date: Wed, 7 Feb 2024 11:17:02 -0500 Subject: [PATCH 2/6] Changed map values and fixed UI --- R/miscFunctions.R | 2 +- inst/shiny/server.R | 58 ++++++++++++++++++++++++------------ inst/shiny/ui_04_fs_dimred.R | 5 ++-- 3 files changed, 42 insertions(+), 23 deletions(-) diff --git a/R/miscFunctions.R b/R/miscFunctions.R index c64a0bf2c..7c9ea1683 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -486,7 +486,7 @@ getGenesetNamesFromCollection <- function(inSCE, geneSetCollectionName) { #' @return inSCE object with changed values renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) { clusterLabels <- unique(colData(inSCE)[,clusterName]) - + print(clusterLabels) renamedLabels <- mapvalues(c(clusterLabels), from = c(from), to = c(to)) if (!is.null(newClusterName)) { colData(inSCE)[,newClusterName] <- renamedLabels diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 847b71e62..9094c30c7 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -17,7 +17,6 @@ source("qc_help_pages/ui_doubletFinder_help.R", local = TRUE) # creates several source("qc_help_pages/ui_scrublet_help.R", local = TRUE) # creates several smaller UI components source("qc_help_pages/ui_dc_and_qcm_help.R", local = TRUE) # creates several smaller UI components source("qc_help_pages/ui_scDblFinder_help.R", local = TRUE) # creates several smaller UI components -source(file.path("..","..", "R/miscFunctions.R")) # source("server_partials/server_01_data.R", local = TRUE) # functions for Data section # Define server logic required to draw a histogram @@ -6418,45 +6417,66 @@ shinyServer(function(input, output, session) { observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) + observe({ + shinyOption <- getShinyOption("inputSCEset") + + if (!is.null(shinyOption)) { + # Update choices dynamically based on shinyOption + updateSelectInput(session, "hvgPlotMethod1", choices = colnames(colData(shinyOption))) + } else { + # If shinyOption is NULL, set choices to NULL or an empty vector + updateSelectInput(session, "hvgPlotMethod1", choices = NULL) + } + }) selectInputs1 <- reactiveVal(NULL) observeEvent(input$gatherLabels, { - output$textFieldsContainer <- renderUI({ - selectInputs <- lapply(unique(colData(vals$counts)[[input$hvgPlotMethod1]]), function(factor) { - local({ - print(factor) - div( - style = "display: flex; align-items: center;", - tags$label( - style = "margin-right: 10px;", - factor - ), - textInput( - inputId = paste0("textField", factor), - label = NULL, - value = "", - width = "300px" + if (is.null(vals$counts)) { + print("input an SCE object") + } else { + count <- 0 + print(colnames(colData(vals$counts))) + output$textFieldsContainer <- renderUI({ + selectInputs <- lapply(unique(colData(vals$counts)[[input$hvgPlotMethod1]]), function(factor) { + local({ + print(factor) + div( + style = "display: flex; align-items: center;", + tags$label( + style = "margin-right: 10px;", + factor + ), + textInput( + inputId = paste0("textField", factor), + label = NULL, + value = "", + width = "300px" + ) ) - ) + }) }) }) selectInputs1 <- selectInputs tagList(selectInputs) - }) print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) + } }) observeEvent(input$updatePlotFS1, { factors <- integer() text_values <- character() - for (i in 0:length(unique(colData(vals$counts)[[input$hvgPlotMethod1]]))) { + for (i in unique(colData(vals$counts)[[input$hvgPlotMethod1]])) { input_id <- paste0("textField", i) + print(input_id) input_value <- input[[input_id]] + print(input_value) if (!is.null(input_value) && nchar(input_value) > 0) { factors <- c(factors, i) text_values <- c(text_values, input_value) } } + print(factors) + print(text_values) vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values) print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) diff --git a/inst/shiny/ui_04_fs_dimred.R b/inst/shiny/ui_04_fs_dimred.R index ecbe05bed..14bc0a480 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -113,12 +113,11 @@ shinyPanelFS_DimRed <- fluidPage( color = "danger", icon = icon("times"), size = "xs"), align = "right"), - selectInput( + textInput( inputId = "hvgPlotMethod1", label = "Cluster Label", - choices = "nothing" + #choices = NULL ), - actionBttn( inputId = "gatherLabels", label = "Gather Labels", From e927493709abcf64d1bf45ce254595d58bce54eb Mon Sep 17 00:00:00 2001 From: Nathan Palamuttam <63568423+nathanpalamuttam@users.noreply.github.com> Date: Wed, 14 Feb 2024 13:50:56 -0500 Subject: [PATCH 3/6] Fixed dropdown so it shows columns in SCE Object --- R/miscFunctions.R | 1 - inst/shiny/server.R | 20 +++++++++----------- inst/shiny/ui_04_fs_dimred.R | 8 ++++---- 3 files changed, 13 insertions(+), 16 deletions(-) diff --git a/R/miscFunctions.R b/R/miscFunctions.R index 7c9ea1683..c9f65ea03 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -486,7 +486,6 @@ getGenesetNamesFromCollection <- function(inSCE, geneSetCollectionName) { #' @return inSCE object with changed values renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) { clusterLabels <- unique(colData(inSCE)[,clusterName]) - print(clusterLabels) renamedLabels <- mapvalues(c(clusterLabels), from = c(from), to = c(to)) if (!is.null(newClusterName)) { colData(inSCE)[,newClusterName] <- renamedLabels diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 9094c30c7..497046dc1 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -6417,18 +6417,17 @@ shinyServer(function(input, output, session) { observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) - observe({ - shinyOption <- getShinyOption("inputSCEset") - - if (!is.null(shinyOption)) { - # Update choices dynamically based on shinyOption - updateSelectInput(session, "hvgPlotMethod1", choices = colnames(colData(shinyOption))) + + observeEvent(allImportEntries$samples, { + if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { + options <- colnames(colData(vals$counts)) } else { - # If shinyOption is NULL, set choices to NULL or an empty vector - updateSelectInput(session, "hvgPlotMethod1", choices = NULL) - } + options <- NULL + } + updateSelectInput(session, inputId = "hvgPlotMethod1", choices = options) }) - selectInputs1 <- reactiveVal(NULL) + + observeEvent(input$gatherLabels, { if (is.null(vals$counts)) { print("input an SCE object") @@ -6455,7 +6454,6 @@ shinyServer(function(input, output, session) { }) }) }) - selectInputs1 <- selectInputs tagList(selectInputs) print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) } diff --git a/inst/shiny/ui_04_fs_dimred.R b/inst/shiny/ui_04_fs_dimred.R index 14bc0a480..d0397509b 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -113,11 +113,11 @@ shinyPanelFS_DimRed <- fluidPage( color = "danger", icon = icon("times"), size = "xs"), align = "right"), - textInput( - inputId = "hvgPlotMethod1", + selectInput( + inputId = "hvgPlotMethod1", label = "Cluster Label", - #choices = NULL - ), + choices = NULL + ), actionBttn( inputId = "gatherLabels", label = "Gather Labels", From 9eb0046a131f86c7ca90d0e11ec3cb4bf110d448 Mon Sep 17 00:00:00 2001 From: Nathan Palamuttam <63568423+nathanpalamuttam@users.noreply.github.com> Date: Tue, 27 Feb 2024 23:07:11 -0500 Subject: [PATCH 4/6] Fixed renameClusters function by making optional rename cluster functional --- R/miscFunctions.R | 8 +++++--- inst/shiny/server.R | 31 +++++++++++++++++++++++-------- 2 files changed, 28 insertions(+), 11 deletions(-) diff --git a/R/miscFunctions.R b/R/miscFunctions.R index c9f65ea03..7c5c9a126 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -487,10 +487,12 @@ getGenesetNamesFromCollection <- function(inSCE, geneSetCollectionName) { renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) { clusterLabels <- unique(colData(inSCE)[,clusterName]) renamedLabels <- mapvalues(c(clusterLabels), from = c(from), to = c(to)) + colData(inSCE)[,clusterName] <- mapvalues(colData(inSCE)[,clusterName], from = c(from), to = c(to)) + if (!is.null(newClusterName)) { - colData(inSCE)[,newClusterName] <- renamedLabels - } else { - colData(inSCE)[,clusterName] <- mapvalues(colData(inSCE)[,clusterName], from = c(from), to = c(to)) + print("hel") + colData(inSCE)[, newClusterName] <- colData(inSCE)[, clusterName] } + return(inSCE) } diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 497046dc1..cc7370035 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -6426,7 +6426,17 @@ shinyServer(function(input, output, session) { } updateSelectInput(session, inputId = "hvgPlotMethod1", choices = options) }) - + + observeEvent(vals$counts, { + print("hello") + if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { + options <- colnames(colData(vals$counts)) + } else { + options <- NULL + } + updateSelectInput(session, inputId = "hvgPlotMethod1", choices = options) + }) + observeEvent(input$gatherLabels, { if (is.null(vals$counts)) { @@ -6455,7 +6465,7 @@ shinyServer(function(input, output, session) { }) }) tagList(selectInputs) - print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) + } }) @@ -6465,18 +6475,23 @@ shinyServer(function(input, output, session) { text_values <- character() for (i in unique(colData(vals$counts)[[input$hvgPlotMethod1]])) { input_id <- paste0("textField", i) - print(input_id) input_value <- input[[input_id]] - print(input_value) if (!is.null(input_value) && nchar(input_value) > 0) { factors <- c(factors, i) text_values <- c(text_values, input_value) } } - print(factors) - print(text_values) - vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values) - print(unique(colData(vals$counts)[[input$hvgPlotMethod1]])) + observe({ + newClusterName <- input$hvgPlotMethod4 + + if (is.null(newClusterName)) { + vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values) + } else { + vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values, newClusterName) + } + }) + + print(unique(colData(vals$counts))) }) From f98c3afc6887658889d27e2d8bb96e187420f1b9 Mon Sep 17 00:00:00 2001 From: Nathan Palamuttam Date: Tue, 12 Mar 2024 13:20:10 -0400 Subject: [PATCH 5/6] made renameCluster a module --- R/miscFunctions.R | 1 - inst/shiny/module_renameCluster.R | 110 ++++++++++++++++++++++++++++++ inst/shiny/server.R | 77 +-------------------- inst/shiny/ui.R | 1 + inst/shiny/ui_03_2_cluster.R | 2 + inst/shiny/ui_04_fs_dimred.R | 42 +----------- 6 files changed, 117 insertions(+), 116 deletions(-) create mode 100644 inst/shiny/module_renameCluster.R diff --git a/R/miscFunctions.R b/R/miscFunctions.R index 7c5c9a126..987867854 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -490,7 +490,6 @@ renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) colData(inSCE)[,clusterName] <- mapvalues(colData(inSCE)[,clusterName], from = c(from), to = c(to)) if (!is.null(newClusterName)) { - print("hel") colData(inSCE)[, newClusterName] <- colData(inSCE)[, clusterName] } diff --git a/inst/shiny/module_renameCluster.R b/inst/shiny/module_renameCluster.R new file mode 100644 index 000000000..4c6b3196e --- /dev/null +++ b/inst/shiny/module_renameCluster.R @@ -0,0 +1,110 @@ +renameClusterUI <- function(id) { + ns <- NS(id) + column(4, dropdown( + fluidRow( + column(width = 12, + fluidRow(actionBttn(inputId = ns("closeDropDownFS1"), + label = NULL, style = "simple", + color = "danger", + icon = icon("times"), size = "xs"), + align = "right"), + selectInput( + inputId = ns("ClusterLabelChoices"), + label = "Cluster Label", + choices = NULL + ), + uiOutput(ns("textFieldsContainer")), + textInput( + inputId = ns("NewClusterLabel"), + label = "Create a new cluster label (optional):", + ), + textOutput(ns("outputText")), + actionBttn( + inputId = ns("updatePlotFS1"), + label = "Update", + style = "bordered", + color = "primary", + size = "sm" + ) + ) + ), + inputId = ns("dropDownFS1"), + icon = icon("pencil"), + status = "primary", + circle = FALSE, + inline = TRUE + )) +} + +renameClusterServer <- function(input, output, session, vals = NULL) { + observeEvent(input$closeDropDownFS1, { + session$sendCustomMessage("close_dropDownFS", "") + }) + ns <- session$ns + text_input_values <- reactiveValues() + observeEvent(vals$counts, { + if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { + options <- colnames(colData(vals$counts)) + } else { + options <- NULL + } + updateSelectInput(session, inputId = "ClusterLabelChoices", choices = options) + if (is.null(vals$counts)) { + print("input an SCE object") + } else { + count <- 0 + output$textFieldsContainer <- renderUI({ + selectInputs <- lapply(unique(colData(vals$counts)[[input$ClusterLabelChoices]]), function(factor) { + local({ + div( + style = "display: flex; align-items: center;", + tags$label( + style = "margin-right: 10px;", + factor + ), + textInput( + inputId = ns(paste0("textField", factor)), + label = NULL, + value = text_input_values[[paste0("textField", factor)]], # Set initial value from reactiveValues + width = "300px" + ) + ) + }) + }) + }) + tagList(selectInputs) + } + if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { + options <- colnames(colData(vals$counts)) + } else { + options <- NULL + } + updateSelectInput(session, inputId = "ClusterLabelChoices", choices = options) + }) + output$outputText <- renderText({ + "Note: If this field is left blank, the original cluster label will be updated." + }) + + observeEvent(input$updatePlotFS1, { + factors <- integer() + text_values <- character() + for (i in unique(colData(vals$counts)[[input$ClusterLabelChoices]])) { + input_id <- paste0("textField", i) + input_value <- input[[input_id]] + if (!is.null(input_value) && nchar(input_value) > 0) { + factors <- c(factors, i) + text_values <- c(text_values, input_value) + text_input_values[[input_id]] <- input_value + } + } + newClusterName <- input$NewClusterLabel + if (newClusterName == "") { + vals$counts <- renameClusters(vals$counts, input$ClusterLabelChoices, factors, text_values) + } + else { + vals$counts <- renameClusters(vals$counts, input$ClusterLabelChoices, factors, text_values, newClusterName) + updateTextInput(session, "NewClusterLabel", value = "") + } + }) + +} diff --git a/inst/shiny/server.R b/inst/shiny/server.R index cc7370035..aa6d3efda 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -6414,87 +6414,14 @@ shinyServer(function(input, output, session) { session$sendCustomMessage("close_dropDownFS", "") }) + callModule(module = renameClusterServer, id = "instance1", vals = vals) + callModule(module = renameClusterServer, id = "instance2", vals = vals) observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) - observeEvent(allImportEntries$samples, { - if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { - options <- colnames(colData(vals$counts)) - } else { - options <- NULL - } - updateSelectInput(session, inputId = "hvgPlotMethod1", choices = options) - }) - - observeEvent(vals$counts, { - print("hello") - if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { - options <- colnames(colData(vals$counts)) - } else { - options <- NULL - } - updateSelectInput(session, inputId = "hvgPlotMethod1", choices = options) - }) - - - observeEvent(input$gatherLabels, { - if (is.null(vals$counts)) { - print("input an SCE object") - } else { - count <- 0 - print(colnames(colData(vals$counts))) - output$textFieldsContainer <- renderUI({ - selectInputs <- lapply(unique(colData(vals$counts)[[input$hvgPlotMethod1]]), function(factor) { - local({ - print(factor) - div( - style = "display: flex; align-items: center;", - tags$label( - style = "margin-right: 10px;", - factor - ), - textInput( - inputId = paste0("textField", factor), - label = NULL, - value = "", - width = "300px" - ) - ) - }) - }) - }) - tagList(selectInputs) - - } - }) - observeEvent(input$updatePlotFS1, { - factors <- integer() - text_values <- character() - for (i in unique(colData(vals$counts)[[input$hvgPlotMethod1]])) { - input_id <- paste0("textField", i) - input_value <- input[[input_id]] - if (!is.null(input_value) && nchar(input_value) > 0) { - factors <- c(factors, i) - text_values <- c(text_values, input_value) - } - } - observe({ - newClusterName <- input$hvgPlotMethod4 - - if (is.null(newClusterName)) { - vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values) - } else { - vals$counts <- renameClusters(vals$counts, input$hvgPlotMethod1, factors, text_values, newClusterName) - } - }) - - print(unique(colData(vals$counts))) - - }) - #----------------------------------------------------------------------------- # Page 5.1: Differential Expression #### #----------------------------------------------------------------------------- diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index d0a177c2e..433c46655 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -60,6 +60,7 @@ data("c2BroadSets") #source modules source("module_nonLinearWorkflow.R") source("module_filterTable.R") +source("module_renameCluster.R") docs.base <- paste0("https://www.camplab.net/sctk/v", package.version("singleCellTK"), "/") diff --git a/inst/shiny/ui_03_2_cluster.R b/inst/shiny/ui_03_2_cluster.R index 9b13ceaa5..ef46e0d73 100644 --- a/inst/shiny/ui_03_2_cluster.R +++ b/inst/shiny/ui_03_2_cluster.R @@ -1,3 +1,4 @@ +source("module_renameCluster.R") shinyPanelCluster <- fluidPage( tags$script("Shiny.addCustomMessageHandler('close_dropDownClust', function(x){ $('html').click(); @@ -134,6 +135,7 @@ shinyPanelCluster <- fluidPage( inline = TRUE ) ), + renameClusterUI(id = "instance2"), column( width = 9, fluidRow( diff --git a/inst/shiny/ui_04_fs_dimred.R b/inst/shiny/ui_04_fs_dimred.R index d0397509b..4afd146f9 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -1,3 +1,4 @@ +source("module_renameCluster.R") seurat.version <- packageVersion(pkg = "SeuratObject") shinyPanelFS_DimRed <- fluidPage( tags$script("Shiny.addCustomMessageHandler('close_dropDownDimRedEmbedding', function(x){ @@ -105,46 +106,7 @@ shinyPanelFS_DimRed <- fluidPage( circle = FALSE, inline = TRUE )), - column(4, dropdown( - fluidRow( - column(width = 12, - fluidRow(actionBttn(inputId = "closeDropDownFS1", - label = NULL, style = "simple", - color = "danger", - icon = icon("times"), size = "xs"), - align = "right"), - selectInput( - inputId = "hvgPlotMethod1", - label = "Cluster Label", - choices = NULL - ), - actionBttn( - inputId = "gatherLabels", - label = "Gather Labels", - style = "bordered", - color = "primary", - size = "sm" - ), - uiOutput("textFieldsContainer"), - textInput( - inputId = "hvgPlotMethod4", - label = "New Cluster Name (optional)", - ), - actionBttn( - inputId = "updatePlotFS1", - label = "Update", - style = "bordered", - color = "primary", - size = "sm" - ) - ) - ), - inputId = "dropDownFS1", - icon = icon("pencil"), - status = "primary", - circle = FALSE, - inline = TRUE - )), + renameClusterUI(id = "instance1"), column(7, fluidRow(h6("Scatterplot showing the variability of each feature versus its average expression across all cells"), align="center")) ), hr(), From 82e20b8f4e3f87594dad73e9f3a55e8be79c410e Mon Sep 17 00:00:00 2001 From: nathanpalamuttam Date: Tue, 7 May 2024 11:39:17 -0400 Subject: [PATCH 6/6] update button updates the plot. fix renameClusters method --- R/ggPlotting.R | 1 - R/miscFunctions.R | 13 ++++-- inst/shiny/module_renameCluster.R | 72 ++++++++++++++++++++++--------- inst/shiny/server.R | 47 ++++++++++++++++++-- inst/shiny/ui_03_2_cluster.R | 9 +++- inst/shiny/ui_04_fs_dimred.R | 2 +- 6 files changed, 113 insertions(+), 31 deletions(-) diff --git a/R/ggPlotting.R b/R/ggPlotting.R index a2e9afb3c..41a64252d 100644 --- a/R/ggPlotting.R +++ b/R/ggPlotting.R @@ -411,7 +411,6 @@ plotSCEDimReduceColData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - colorPlot <- SingleCellExperiment::colData(inSCE)[, colorBy] g <- .ggScatter( diff --git a/R/miscFunctions.R b/R/miscFunctions.R index 987867854..1ed91c5e3 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -485,13 +485,18 @@ getGenesetNamesFromCollection <- function(inSCE, geneSetCollectionName) { #' @param newCluster value to change name of cluster #' @return inSCE object with changed values renameClusters <- function(inSCE, clusterName, from, to, newClusterName = NULL) { - clusterLabels <- unique(colData(inSCE)[,clusterName]) - renamedLabels <- mapvalues(c(clusterLabels), from = c(from), to = c(to)) - colData(inSCE)[,clusterName] <- mapvalues(colData(inSCE)[,clusterName], from = c(from), to = c(to)) + # Retrieve cluster label and rename values + clusterLabels <- as.factor(colData(inSCE)[,clusterName]) + renamedLabels <- plyr::mapvalues(clusterLabels, from = from, to = to) + + # Set clusters in the same or new variable if (!is.null(newClusterName)) { - colData(inSCE)[, newClusterName] <- colData(inSCE)[, clusterName] + colData(inSCE)[, newClusterName] <- renamedLabels + } else { + colData(inSCE)[, clusterName] <- renamedLabels } return(inSCE) + } diff --git a/inst/shiny/module_renameCluster.R b/inst/shiny/module_renameCluster.R index 4c6b3196e..506af1a37 100644 --- a/inst/shiny/module_renameCluster.R +++ b/inst/shiny/module_renameCluster.R @@ -1,11 +1,14 @@ renameClusterUI <- function(id) { ns <- NS(id) + #print(table(old_label, new_label)) + #edit cluster labels in the dropdown + #look at updated and previous and see the difference column(4, dropdown( fluidRow( column(width = 12, fluidRow(actionBttn(inputId = ns("closeDropDownFS1"), label = NULL, style = "simple", - color = "danger", + color = "danger", icon = icon("times"), size = "xs"), align = "right"), selectInput( @@ -19,13 +22,15 @@ renameClusterUI <- function(id) { label = "Create a new cluster label (optional):", ), textOutput(ns("outputText")), - actionBttn( - inputId = ns("updatePlotFS1"), - label = "Update", - style = "bordered", - color = "primary", - size = "sm" - ) + withBusyIndicatorUI( + actionBttn( + inputId = ns("clustPlot1"), + label = "Update", + style = "bordered", + color = "primary", + size = "sm" + ) + ), ) ), inputId = ns("dropDownFS1"), @@ -36,25 +41,25 @@ renameClusterUI <- function(id) { )) } -renameClusterServer <- function(input, output, session, vals = NULL) { +renameClusterServer <- function(input, output, session, inSCE = NULL, isCluster = FALSE, clustRedDim = NULL, clustVisRes = NULL, clustVisCol = NULL) { observeEvent(input$closeDropDownFS1, { session$sendCustomMessage("close_dropDownFS", "") }) ns <- session$ns text_input_values <- reactiveValues() - observeEvent(vals$counts, { - if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { - options <- colnames(colData(vals$counts)) + observeEvent(inSCE$counts, { + if (!is.null(inSCE$counts) && !is.null(colnames(colData(inSCE$counts)))) { + options <- colnames(colData(inSCE$counts)) } else { options <- NULL } updateSelectInput(session, inputId = "ClusterLabelChoices", choices = options) - if (is.null(vals$counts)) { + if (is.null(inSCE$counts)) { print("input an SCE object") } else { count <- 0 output$textFieldsContainer <- renderUI({ - selectInputs <- lapply(unique(colData(vals$counts)[[input$ClusterLabelChoices]]), function(factor) { + selectInputs <- lapply(unique(colData(inSCE$counts)[[input$ClusterLabelChoices]]), function(factor) { local({ div( style = "display: flex; align-items: center;", @@ -74,8 +79,8 @@ renameClusterServer <- function(input, output, session, vals = NULL) { }) tagList(selectInputs) } - if (!is.null(vals$counts) && !is.null(colnames(colData(vals$counts)))) { - options <- colnames(colData(vals$counts)) + if (!is.null(inSCE$counts) && !is.null(colnames(colData(inSCE$counts)))) { + options <- colnames(colData(inSCE$counts)) } else { options <- NULL } @@ -84,11 +89,33 @@ renameClusterServer <- function(input, output, session, vals = NULL) { output$outputText <- renderText({ "Note: If this field is left blank, the original cluster label will be updated." }) +# observeEvent(input$updatePlotFS1, { +# factors <- integer() +# text_values <- character() +# for (i in unique(colData(inSCE$counts)[[input$ClusterLabelChoices]])) { +# input_id <- paste0("textField", i) +# input_value <- input[[input_id]] +# if (!is.null(input_value) && nchar(input_value) > 0) { +# factors <- c(factors, i) +# text_values <- c(text_values, input_value) +# text_input_values[[input_id]] <- input_value +# } +# } +# newClusterName <- input$NewClusterLabel +# if (newClusterName == "") { +# inSCE$counts <- renameClusters(inSCE$counts, input$ClusterLabelChoices, factors, text_values) +# print((colData(inSCE$counts)[,input$ClusterLabelChoices])) +# } +# else { +# inSCE$counts <- renameClusters(inSCE$counts, input$ClusterLabelChoices, factors, text_values, newClusterName) +# updateTextInput(session, "NewClusterLabel", value = "") +# } +# }) - observeEvent(input$updatePlotFS1, { + observeEvent(input$clustPlot1, { factors <- integer() text_values <- character() - for (i in unique(colData(vals$counts)[[input$ClusterLabelChoices]])) { + for (i in unique(colData(inSCE$counts)[[input$ClusterLabelChoices]])) { input_id <- paste0("textField", i) input_value <- input[[input_id]] if (!is.null(input_value) && nchar(input_value) > 0) { @@ -99,12 +126,15 @@ renameClusterServer <- function(input, output, session, vals = NULL) { } newClusterName <- input$NewClusterLabel if (newClusterName == "") { - vals$counts <- renameClusters(vals$counts, input$ClusterLabelChoices, factors, text_values) + inSCE$counts <- renameClusters(inSCE$counts, input$ClusterLabelChoices, factors, text_values) + print((colData(inSCE$counts)[,input$ClusterLabelChoices])) } else { - vals$counts <- renameClusters(vals$counts, input$ClusterLabelChoices, factors, text_values, newClusterName) + inSCE$counts <- renameClusters(inSCE$counts, input$ClusterLabelChoices, factors, text_values, newClusterName) updateTextInput(session, "NewClusterLabel", value = "") } + if (isCluster){ + session$sendCustomMessage("button_pressed", list(message = "Button pressed")) + } }) - } diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 4b404c56d..9ddc8c0a4 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -3749,7 +3749,6 @@ shinyServer(function(input, output, session) { }) }) } - # Show downstream analysis options callModule(module = nonLinearWorkflow, id = "nlw-cl", parent = session, de = TRUE, fm = TRUE, pa = TRUE, cv = TRUE, tj = TRUE) } @@ -6413,9 +6412,51 @@ shinyServer(function(input, output, session) { }) session$sendCustomMessage("close_dropDownFS", "") }) + # Corrected syntax with proper closing parenthesis + observeEvent(input$button_pressed, { + req(vals$counts) + choice <- NULL + if (input$clustVisChoicesType == 1) { + # Use result + if (is.null(input$clustVisRes) || + input$clustVisRes == "") { + shinyalert::shinyalert("Error!", "Select the clusters to plot", + type = "error") + } + choice <- input$clustVisRes + } else if (input$clustVisChoicesType == 2) { + if (is.null(input$clustVisCol) || + input$clustVisCol == "") { + shinyalert::shinyalert("Error!", "Select the clusters to plot", + type = "error") + } + choice <- input$clustVisCol + } + if (is.null(input$clustVisReddim) || input$clustVisReddim == "") { + shinyalert::shinyalert("Error!", + "No reduction selected. Select one or run dimension reduction first", + type = "error") + } + if (!is.null(choice) && choice != "" && + !is.null(input$clustVisReddim) && input$clustVisReddim != "") { + output$clustVisPlot <- renderPlotly({ + isolate({ + plotSCEDimReduceColData(inSCE = vals$counts, + colorBy = choice, + conditionClass = "factor", + reducedDimName = input$clustVisReddim, + labelClusters = TRUE, + dim1 = 1, dim2 = 2, + legendTitle = choice) + }) + }) + } + session$sendCustomMessage("close_dropDownClust", "") + }) + + callModule(module = renameClusterServer, id = "renameCluster_featureDim", inSCE = vals, isCluster = FALSE, clustRedDim = NULL, clustVisCol = NULL) + callModule(module = renameClusterServer, id = "renameCluster_cluster", inSCE = vals, isCluster = TRUE, clustRedDim = input$clustVisReddim, clustVisCol = input$clustVisRes) - callModule(module = renameClusterServer, id = "instance1", vals = vals) - callModule(module = renameClusterServer, id = "instance2", vals = vals) observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) diff --git a/inst/shiny/ui_03_2_cluster.R b/inst/shiny/ui_03_2_cluster.R index ef46e0d73..5dd43dac7 100644 --- a/inst/shiny/ui_03_2_cluster.R +++ b/inst/shiny/ui_03_2_cluster.R @@ -3,6 +3,12 @@ shinyPanelCluster <- fluidPage( tags$script("Shiny.addCustomMessageHandler('close_dropDownClust', function(x){ $('html').click(); });"), + tags$script(' + Shiny.addCustomMessageHandler("button_pressed", function(message) { + Shiny.setInputValue("button_pressed", message, {priority: "event"}); + }); +'), + tags$div( class = "container", h1("Clustering"), @@ -135,7 +141,7 @@ shinyPanelCluster <- fluidPage( inline = TRUE ) ), - renameClusterUI(id = "instance2"), + renameClusterUI(id = "renameCluster_cluster"), column( width = 9, fluidRow( @@ -154,6 +160,7 @@ shinyPanelCluster <- fluidPage( ), hr(), br(), + shinyjqui::jqui_resizable( plotlyOutput("clustVisPlot") ) diff --git a/inst/shiny/ui_04_fs_dimred.R b/inst/shiny/ui_04_fs_dimred.R index 4afd146f9..a4e83f1bf 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -106,7 +106,7 @@ shinyPanelFS_DimRed <- fluidPage( circle = FALSE, inline = TRUE )), - renameClusterUI(id = "instance1"), + renameClusterUI(id = "renameCluster_featureDim"), column(7, fluidRow(h6("Scatterplot showing the variability of each feature versus its average expression across all cells"), align="center")) ), hr(),