Skip to content

Commit

Permalink
Merge pull request #717 from akshayarav/devel
Browse files Browse the repository at this point in the history 
Made changes to the SingleCellTK GUI for BubblePlot plotting
  • Loading branch information
@joshua-d-campbell
joshua-d-campbell authored Jan 5, 2024
2 parents b0884e6 + 91a9191 commit d448443
Show file tree
Hide file tree
Showing 7 changed files with 195 additions and 85 deletions.
16 changes: 11 additions & 5 deletions R/plotBubble.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
#' @param ylab The y-axis label
#' @param colorLow The color to be used for lowest value of mean expression
#' @param colorHigh The color to be used for highest value of mean expression
#' @param scale Option to scale the data. Default: /code{FALSE}. Selected assay will not be scaled.
#' @return A ggplot of the bubble plot.
#' @importFrom rlang .data
#' @importFrom reshape2 melt
Expand All @@ -21,14 +22,14 @@
#' displayName="feature_name", groupNames="type", title="cell type test",
#' xlab="gene", ylab="cluster", colorLow="white", colorHigh="blue")
#' @export
plotBubble <- function(inSCE, useAssay="logcounts", featureNames, displayName=NULL, groupNames="cluster", title="", xlab=NULL, ylab=NULL, colorLow="white", colorHigh="blue"){
plotBubble <- function(inSCE, useAssay="logcounts", featureNames, displayName=NULL, groupNames="cluster", title="", xlab=NULL, ylab=NULL, colorLow="white", colorHigh="blue", scale = FALSE){
metrics <- runClusterSummaryMetrics(inSCE, useAssay=useAssay, featureNames=featureNames,
displayName=displayName, groupNames=groupNames)
displayName=displayName, groupNames=groupNames, scale = scale)
.ggBubble(avgExpr = metrics$avgExpr, percExpr = metrics$percExpr, colorLow = colorLow,
colorHigh = colorHigh, title = title)
colorHigh = colorHigh, title = title, xlab=xlab, ylab=ylab)
}

.ggBubble <- function(avgExpr, percExpr, groupNames=NULL, featureNames=NULL, colorLow="white", colorHigh="blue", title=""){
.ggBubble <- function(avgExpr, percExpr, groupNames=NULL, featureNames=NULL, colorLow="white", colorHigh="blue", title="", xlab="Features", ylab="Clusters"){
if(is.null(featureNames)) {
if(is.null(rownames(avgExpr))) {
stop("'featureNames' must be supplied or the 'rownames' of the average expression matrix must be set.")
Expand Down Expand Up @@ -65,7 +66,12 @@ plotBubble <- function(inSCE, useAssay="logcounts", featureNames, displayName=NU
gg <- ggplot2::ggplot(df, ggplot2::aes(x = .data[['featureNames']], y = .data[['groupNames']])) +
ggplot2::geom_point(ggplot2::aes(color=.data[['avgExpr']], size=.data[['percExpr']])) +
ggplot2::ggtitle(title) +
ggplot2::xlab(xlab) +
ggplot2::ylab(ylab) +
ggplot2::scale_color_gradient2(low=colorLow, high=colorHigh)
.ggSCTKTheme(gg)
g <- .ggSCTKTheme(gg)

g <- g + ggplot2::theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
g
}

24 changes: 18 additions & 6 deletions R/runClusterSummaryMetrics.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
#' @param featureNames A string or vector of strings with each gene to aggregate.
#' @param displayName A string that is the name of the column used for genes.
#' @param groupNames The name of a colData entry that can be used as groupNames.
#' @param scale Option to scale the data. Default: /code{FALSE}. Selected assay will not be scaled.
#' @return A dataframe with mean expression and percent of cells in cluster that
#' express for each cluster.
#' @examples
Expand All @@ -15,8 +16,11 @@
#' displayName="feature_name", groupNames="type")
#' @export

runClusterSummaryMetrics <- function(inSCE, useAssay="logcounts", featureNames, displayName=NULL, groupNames="cluster"){

runClusterSummaryMetrics <- function(inSCE, useAssay="logcounts", featureNames, displayName=NULL, groupNames="cluster", scale = FALSE){
if(isTRUE(scale)){
runNormalization(inSCE=inSCE, useAssay=useAssay, scale = TRUE, normalizationMethod = NULL, transformation = NULL,
pseudocountsBeforeNorm = NULL, pseudocountsBeforeTransform = NULL)
}
if (!groupNames %in% names(SingleCellExperiment::colData(inSCE))) {
stop("Specified variable '", groupNames, "' not found in colData(inSCE)")
}
Expand All @@ -40,16 +44,24 @@ runClusterSummaryMetrics <- function(inSCE, useAssay="logcounts", featureNames,
warning("Specified genes '", toString(falseGenes), "' not found in ", warning)
}

tempSCE <- inSCE[featureNames, ]


if(isTRUE(scale)){
tempSCE <- runNormalization(inSCE=tempSCE, outAssayName = "scaled", useAssay=useAssay,scale = TRUE, normalizationMethod = NULL, transformation = NULL,
pseudocountsBeforeNorm = NULL, pseudocountsBeforeTransform = NULL)
useAssay <- "scaled"
}

avgExpr <- assay(scuttle::aggregateAcrossCells(inSCE, ids=SingleCellExperiment::colData(inSCE)[,groupNames],
avgExpr <- assay(scuttle::aggregateAcrossCells(tempSCE, ids=SingleCellExperiment::colData(inSCE)[,groupNames],
statistics="mean", use.assay.type=useAssay,
subset.row=featureNames))
subset.row=NULL))



percExpr <- assay(scuttle::aggregateAcrossCells(inSCE, ids=SingleCellExperiment::colData(inSCE)[,groupNames],
percExpr <- assay(scuttle::aggregateAcrossCells(tempSCE, ids=SingleCellExperiment::colData(inSCE)[,groupNames],
statistics="prop.detected", use.assay.type=useAssay,
subset.row=featureNames))
subset.row=NULL))


df <- data.frame(featureNames = featureNames)
Expand Down
4 changes: 2 additions & 2 deletions R/runNormalization.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,8 +48,8 @@
#' outAssayName = "logcounts")
runNormalization <- function(inSCE,
useAssay = "counts",
outAssayName = "customNormalizedAssay",
normalizationMethod = NULL,
outAssayName = "logcounts",
normalizationMethod = "logNormCounts",
scale = FALSE,
seuratScaleFactor = 10000,
transformation = NULL,
Expand Down
77 changes: 65 additions & 12 deletions inst/shiny/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3797,6 +3797,7 @@ shinyServer(function(input, output, session) {
})
}
session$sendCustomMessage("close_dropDownClust", "")

})

#-----------------------------------------------------------------------------
Expand Down Expand Up @@ -5712,35 +5713,87 @@ shinyServer(function(input, output, session) {
req(vals$counts)
selectInput(
'bpCluster',
"Select Feature to Cluster on",
"",
colnames(colData(vals$counts)), multiple = FALSE, width = '550px')
})

output$bpRowUI <- renderUI({
req(vals$counts)
selectNonNARowData <- names(apply(rowData(vals$counts), 2, anyNA)[apply(rowData(vals$counts), 2, anyNA) == FALSE])
selectInput(
"bpRow",
"Select Row Data Name",
selectNonNARowData, selected = names(rowData(vals$counts))[1], multiple = FALSE, width = '550px')
observe({
req(vals$counts)

if (!is.null(metadata(vals$counts)$featureDisplay) && metadata(vals$counts)$featureDisplay %in% names(rowData(vals$counts))) {
featureDisplayValue <- metadata(vals$counts)$featureDisplay
updateSelectizeInput(session, "bpFeatures", choices = rowData(vals$counts)[[featureDisplayValue]], server = TRUE)
}
})

observeEvent(input$bpRow, {
observeEvent(input$plotBubbleplot, {
req(vals$counts)
updateSelectizeInput(session, "bpFeatures", choices = rowData(vals$counts)[[input$bpRow]], server = TRUE)
output$Bubbleplot <- renderPlot({
isolate({
plotBubble(inSCE=vals$counts, useAssay=input$bpAssay, featureNames=input$bpFeatures,
displayName=input$bpRow, groupNames=input$bpCluster, title=input$bpTitle,
xlab=input$bpX, ylab=input$bpY, colorLow=input$bpLow, colorHigh=input$bpHigh, scale=input$scaleBubble)
})
})
})

observeEvent(input$plotBubbleplot, {
observeEvent(input$updateBubbleplot, {
req(vals$counts)
output$Bubbleplot <- renderPlot({
isolate({
plotBubble(inSCE=vals$counts, useAssay=input$bpAssay, featureNames=input$bpFeatures,
displayName=input$bpRow, groupNames=input$bpCluster, title=input$bpTitle,
xlab=input$bpX, ylab=input$bpY, colorLow=input$bpLow, colorHigh=input$bpHigh)
xlab=input$bpX, ylab=input$bpY, colorLow=input$bpLow, colorHigh=input$bpHigh, scale=input$scaleBubble)
})
})
})

# #COG For BubblePlot
# observeEvent(input$closeDropDownBubble, {
# session$sendCustomMessage("close_dropDownBubble", "")
# })
#
# observeEvent(input$bubblePlot, {
# req(vals$counts)
# choice <- NULL
# if (input$bubbleVisChoicesType == 1) {
# # Use result
# if (is.null(input$bubbleVisRes) ||
# input$bubbleVisRes == "") {
# shinyalert::shinyalert("Error!", "Select the clusters to plot",
# type = "error")
# }
# choice <- input$bubbleVisRes
# } else if (input$bubbleVisChoicesType == 2) {
# # Use colData
# if (is.null(input$bubbleVisCol) ||
# input$bubbleVisCol == "") {
# shinyalert::shinyalert("Error!", "Select the clusters to plot",
# type = "error")
# }
# choice <- input$bubbleVisCol
# }
# if (is.null(input$bubbleVisReddim) || input$bubbleVisReddim == "") {
# shinyalert::shinyalert("Error!",
# "No reduction selected. Select one or run dimension reduction first",
# type = "error")
# }
# if (!is.null(choice) && choice != "" &&
# !is.null(input$bubbleVisReddim) && input$bubbleVisReddim != "") {
# output$bubbleVisPlot <- renderPlotly({
# isolate({
# plotSCEDimReduceColData(inSCE = vals$counts,
# colorBy = choice,
# conditionClass = "factor",
# reducedDimName = input$bubbleVisReddim,
# labelClusters = TRUE,
# dim1 = 1, dim2 = 2,
# legendTitle = choice)
# })
# })
# }
# session$sendCustomMessage("close_dropDownBubble", "")

#-----------------------------------------------------------------------------
# Page 4: Batch Correction ####
#-----------------------------------------------------------------------------
Expand Down
149 changes: 91 additions & 58 deletions inst/shiny/ui_08_4_bubbleplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,73 +5,106 @@ shinyPanelBubbleplot <- fluidPage(
p("Generic bubbleplot plotting panel for customized figure.",
style = "color:grey;"),
panel(
h3("Assay to Plot"),

fluidRow(
column(width = 4,
hr(),
# Subset ####
h3("Select Cell Annotation"),
uiOutput("bpClusterUI"),
h3("Feature"),
fluidRow(
column(width = 12,
selectizeInput(
inputId = "bpAssay",
label = "Select input matrix:",
choices = NULL,
selected = NULL,
multiple = FALSE,
options = NULL)
)
),
selectizeInput(
inputId = "bpAssay",
label = "Select input matrix:",
choices = NULL,
selected = NULL,
multiple = FALSE,
options = NULL)
)
),

hr(),
# Subset ####
h3("Cluster/Feature Subsetting"),
p("Select cluster and features of interests", style = "color:grey;"),
tabsetPanel(
tabPanel(
title = "Cluster",
uiOutput("bpClusterUI")),
tabPanel(
title = "Feature",
uiOutput('bpRowUI'),
selectizeInput(
'bpFeatures',
"Select Features",
choices = NULL, multiple = TRUE, width = '550px')
'bpFeatures',
"Select Features",
choices = NULL, multiple = TRUE, width = '550px'),
h5(style="display: inline-block; margin-top: 0px; margin-bottom: 20px","Scale Data"),
switchInput(
inputId = "scaleBubble",
onLabel = "Yes",
offLabel = "No",
value=FALSE,
size="mini",
inline = TRUE
),
withBusyIndicatorUI(actionButton("plotBubbleplot", "Plot Bubbleplot")),
hr(),
),
),
hr(),

# Others ####
h3("Bubbleplot Setting"),
p("Settings for title, label, color scheme and etc.",
style = "color:grey;"),
panel(
fluidRow(
column(width = 4,
textInput("bpTitle", "Title", NULL)
)
),
fluidRow(
column(width = 4,
textInput("bpX", "X-axis Label", NULL)
),
column(width = 4,
textInput("bpY", "Y-axis Label", NULL)

column(
width = 3,
dropdown(
fluidRow(
column(
width = 12,
fluidRow(actionBttn(inputId = "closeDropDownBubble", label = NULL, style = "simple", color = "danger", icon = icon("times"), size = "xs"), align = "right"),
panel(
fluidRow(
column(width = 4,
textInput("bpTitle", "Title", NULL)
)
),
fluidRow(
column(width = 4,
textInput("bpX", "X-axis Label", NULL)
),
column(width = 4,
textInput("bpY", "Y-axis Label", NULL)
)
),
fluidRow(
column(
width = 4,
colourpicker::colourInput('bpLow', 'Low color', value = 'white')
),
column(
width = 4,
colourpicker::colourInput('bpHigh', 'High color', value = 'blue')
)
)
),
withBusyIndicatorUI(
actionBttn(
inputId = "updateBubbleplot",
label = "Update",
style = "bordered",
color = "primary",
size = "sm"
)
),
)
),
inputId = "dropDownBubble",
icon = icon("cog"),
status = "primary",
circle = FALSE,
inline = TRUE
)
),
fluidRow(
column(
width = 4,
colourpicker::colourInput('bpLow', 'Low color', value = 'white')
),
column(
width = 4,
colourpicker::colourInput('bpHigh', 'High color', value = 'blue')

column(
8,
wellPanel(
h5(strong("Plotting Region")),
div(
style = 'height:800px;',
plotOutput("Bubbleplot")
),
hr(),
)
)
),
hr(),
withBusyIndicatorUI(actionButton("plotBubbleplot", "Plot Bubbleplot")),
div(
style = 'height:800px;',
plotOutput("Bubbleplot")
)

)
)
)
5 changes: 4 additions & 1 deletion man/plotBubble.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit d448443

Please sign in to comment.