MapValues functionality

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(

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)
+
+}

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"))
+    }
+  })
+}

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 ####
   #-----------------------------------------------------------------------------

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"), "/")

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")
           )

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(),

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)))
+})
+
+
+