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 3e3ca09f1..1ed91c5e3 100644 --- a/R/miscFunctions.R +++ b/R/miscFunctions.R @@ -475,3 +475,28 @@ 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) { + + # 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] <- renamedLabels + } else { + colData(inSCE)[, clusterName] <- renamedLabels + } + + return(inSCE) + +} diff --git a/inst/shiny/module_renameCluster.R b/inst/shiny/module_renameCluster.R new file mode 100644 index 000000000..506af1a37 --- /dev/null +++ b/inst/shiny/module_renameCluster.R @@ -0,0 +1,140 @@ +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", + 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")), + withBusyIndicatorUI( + actionBttn( + inputId = ns("clustPlot1"), + 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, 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(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(inSCE$counts)) { + print("input an SCE object") + } else { + count <- 0 + output$textFieldsContainer <- renderUI({ + selectInputs <- lapply(unique(colData(inSCE$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(inSCE$counts) && !is.null(colnames(colData(inSCE$counts)))) { + options <- colnames(colData(inSCE$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(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$clustPlot1, { + 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 = "") + } + if (isCluster){ + session$sendCustomMessage("button_pressed", list(message = "Button pressed")) + } + }) +} diff --git a/inst/shiny/server.R b/inst/shiny/server.R index e168e8a38..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,11 +6412,57 @@ 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) observeEvent(input$closeDropDownFS, { session$sendCustomMessage("close_dropDownFS", "") }) + + #----------------------------------------------------------------------------- # 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..5dd43dac7 100644 --- a/inst/shiny/ui_03_2_cluster.R +++ b/inst/shiny/ui_03_2_cluster.R @@ -1,7 +1,14 @@ +source("module_renameCluster.R") 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"), @@ -134,6 +141,7 @@ shinyPanelCluster <- fluidPage( inline = TRUE ) ), + renameClusterUI(id = "renameCluster_cluster"), column( width = 9, fluidRow( @@ -152,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 a50671c07..a4e83f1bf 100644 --- a/inst/shiny/ui_04_fs_dimred.R +++ b/inst/shiny/ui_04_fs_dimred.R @@ -1,3 +1,5 @@ +source("module_renameCluster.R") +seurat.version <- packageVersion(pkg = "SeuratObject") shinyPanelFS_DimRed <- fluidPage( tags$script("Shiny.addCustomMessageHandler('close_dropDownDimRedEmbedding', function(x){ $('html').click(); @@ -104,6 +106,7 @@ shinyPanelFS_DimRed <- fluidPage( circle = FALSE, inline = TRUE )), + 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(), 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))) +}) + + +