Skip to content
Snippets Groups Projects
Commit ba363fd9 authored by Benjamin Knight's avatar Benjamin Knight
Browse files

Commiting so I don't lose changes, still slighlty buggy on the ordering but... 

Commiting so I don't lose changes, still slighlty buggy on the ordering but other changes have been implemented in ui and dont want to lose them
parent 1e204678
Branches
Tags
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
vizapp/shinyapp/functions/helperFunctions.R
+ 50
− 26
View file @ ba363fd9
......@@ -6,32 +6,56 @@ library(gtools)
library(patchwork)
library(scales)
createCustomIdents <- function(obj, groupVars = character()) {
# Ensure groupVars is a character vector
groupVars <- as.character(unlist(groupVars))
# Check that all groupVars exist in the object's meta.data
missing_cols <- setdiff(groupVars, colnames(obj@meta.data))
if (length(missing_cols) > 0) {
stop("These grouping columns are not in obj@meta.data: ", paste(missing_cols, collapse = ", "))
}
if (length(groupVars) == 0) {
# No grouping specified => treat all cells as one group
obj$Custom_Ident <- factor("All_Cells")
} else {
# Build a character vector per cell by pasting the values of the selected metadata columns together
combined <- apply(obj@meta.data[, groupVars, drop = FALSE], 1, function(rowvals) {
paste(rowvals, collapse = "_")
})
# Determine factor levels according to first appearance (or sort them if desired)
lvl_order <- unique(combined)
obj$Custom_Ident <- factor(combined, levels = lvl_order)
}
# Set the active identities to the new custom ident
createCustomIdents <- function(
obj,
groupVars = character(), # e.g. c("Y","X")
valOrderList = list(), # e.g. list(Y = c("a","b","c"), X = c("2","1"))
sep = "_"
) {
# 1) sanitize
groupVars <- as.character(groupVars)
missing <- setdiff(groupVars, names(obj@meta.data))
if(length(missing)) stop("Missing cols: ", paste(missing, collapse=","))
# 2) build the per‐cell labels
labels <- apply(
obj@meta.data[, groupVars, drop=FALSE],
1,
paste,
collapse = sep
)
# 3) for each grouping var, pick its level‐order:
# if the user gave you valOrderList[[var]] use that,
# otherwise fall back to the object's unique values in appearance order
value_lists <- lapply(groupVars, function(var) {
user_levels <- valOrderList[[var]]
if(!is.null(user_levels) && length(user_levels)>0) {
user_levels
} else {
unique(obj@meta.data[[var]])
}
})
# give them names so expand.grid lines up
names(value_lists) <- groupVars
# 4) build the *nested* cartesian product in the exact variable order
grid_df <- expand.grid(
value_lists,
KEEP.OUT.ATTRS = FALSE,
stringsAsFactors = FALSE
)
lvl_strings <- apply(grid_df[, groupVars, drop=FALSE], 1, paste, collapse = sep)
# 5) only keep the combos that actually occur in your data
present <- unique(labels)
final_levels <- intersect(lvl_strings, present)
# 6) make your new factor, set identities
obj$Custom_Ident <- factor(labels, levels = final_levels)
Seurat::Idents(obj) <- obj$Custom_Ident
obj$idents <- obj$Custom_Ident
obj$idents <- obj$Custom_Ident
return(obj)
}
vizapp/shinyapp/functions/my_ui.R
+ 46
− 103
View file @ ba363fd9
......@@ -95,6 +95,18 @@ giveChoicesMetaNone <- function(x) {
return(as.list(cat_cols))
}
getCustomIdentChoices <- function(seurat_obj, include_none = TRUE) {
# make sure the active identity has been set to your Custom_Ident
lvls <- levels(Idents(seurat_obj))
print("the filtered choices for custom ident filtering are:")
print(lvls)
if (include_none) {
lvls <- c(lvls, "None")
}
return(lvls)
}
####################
####################
saveViolinPlots <- function(
......@@ -160,53 +172,46 @@ saveViolinPlots <- function(
####################
####################
saveDimPlots <- function(seuratObject, fileName = "plot", format = 'png',
split.by = NULL, shape.by = NULL, group.by = 'idents',
label = FALSE, reduction = 'umap', colors = NULL) {
saveDimPlots <- function(seuratObject,
fileName = "plot",
format = "png",
split.by = NULL,
shape.by = NULL,
group.by = "idents",
label = FALSE,
reduction = "umap",
colors = NULL, # <- add back
pt.size = 0.5) { # <- expose for UI
infoList <- getInfo(seuratObject)
if (infoList$nClusters > 100) {
message('Too many clusters for the DimPlot!')
message("Too many clusters for the DimPlot!")
return(NULL)
}
# Choose number of columns for subplotting.
ncol_value <- if (is.null(split.by)) 1 else 12
# Call DimPlot. Pass the colors (palette) if provided.
p <- DimPlot(seuratObject,
pt.size = 0.1, # use desired pt.size, here adjusted from your UI definition
label = label,
split.by = split.by,
group.by = group.by,
shape.by = shape.by,
ncol = ncol_value,
reduction = reduction,
repel = TRUE)
# If colors are provided, enforce the same palette.
if (!is.null(colors)) {
p <- p + scale_color_manual(values = colors, limits = names(colors))
}
# Optionally, you may include theme changes as in your UI version:
p <- p + theme(aspect.ratio = 1)
# Save the plot in each desired format.
for (i in c('png', 'ps', 'pdf')) {
if (grepl(i, format)) {
if (is.null(split.by)) {
ggsave(paste0(fileName, '.', i), plot = p, height = 20, width = 20)
} else {
ggsave(paste0(fileName, '.', i), plot = p,
height = min(48, max(4, ceiling(infoList$nClusters / 12) * 4)),
width = min(48, max(4, infoList$nClusters * 4)))
}
}
}
return(p)
ncol_val <- if (is.null(split.by)) 1 else 12
p <- DimPlot(
seuratObject,
pt.size = pt.size,
label = label,
split.by = split.by,
group.by = group.by,
shape.by = shape.by,
ncol = ncol_val,
reduction = reduction,
repel = TRUE
) + theme(aspect.ratio = 1)
if (!is.null(colors))
p <- p + scale_color_manual(values = colors, limits = names(colors),na.translate = FALSE)
## No need to ggsave when plotting in the UI; comment out or keep if you still export
# ...
p
}
####################
####################
saveFeaturePlots <- function(seuratObject, features, group.by = NULL, shape.by = NULL,
......@@ -644,68 +649,6 @@ getAverageExpressions=function(seuratObject,geneDescriptions,features=NULL,log)
}
getAvgExp=function(seuratObject,cells,colID,geneDescriptions,features,log) {
if (is.null(colID)) {
colID='Altogether'
cells$Altogether='all'
}
features=unique(features)
stats=cells%>%count(!!as.name(colID))
rownames(stats)=stats[,1]
ids=1:(dim(stats)[1])
names(ids)=rownames(stats)
if (colID=='Altogether')
Idents(seuratObject)='all'
else
Idents(seuratObject)=paste0('ID',ids[cells[,colID]],'@',cells[,colID])
expressions=AverageExpression(seuratObject,assays='RNA',features=features) #By default this uses non-scaled values. #This function doesn't preserve column names of expressions. a 'g' can be added as prefix.
if (length(features)==1)
rownames(expressions[['RNA']])=features
if (log==T){
expressions[['RNA']]=log2(expressions[['RNA']]+1) #Added by BC
}
expressions[['RNA']]=data.frame(expressions[['RNA']][,mixedsort(colnames(expressions[['RNA']])),drop=F],check.names=F)
colnames(expressions[['RNA']])=paste0(rownames(stats),'(n=',stats$n,')')
if (!is.null(geneDescriptions))
expressions[['RNA']]=cbind2(name=paste0('"',left_join(data.frame(gene=rownames(expressions[['RNA']])),geneDescriptions,by=c('gene'='SYMBOL'))$name,'"'),expressions[['RNA']])
return(expressions)
}
getAverageExpressions=function(seuratObject,geneDescriptions,features=NULL,log) {
vars=c('ident','orig.ident','nCount_RNA','nFeature_RNA','percent.mt','percent.rp')
if ('Phase' %in% colnames(seuratObject@meta.data))
vars=c(vars,'Phase','S.Score','G2M.Score','CC.Difference')
cells=FetchData(seuratObject,vars=vars)
colnames(cells)[1:2]=c('Cluster','Sample')
cells$ClusteredSample=paste0(cells$Cluster,'_',cells$Sample)
if ('Phase' %in% colnames(seuratObject@meta.data)) {
cells$PhasedSample=paste0(cells$Phase,'_',cells$Sample)
cells$PhasedCluster=paste0(cells$Phase,'_',cells$Cluster)
cells$PhasedClusteredSample=paste0(cells$Phase,'_',cells$Cluster,'_',cells$Sample)
}
cells=cbind(cells,Embeddings(seuratObject,reduction="pca")[,1:2],Embeddings(seuratObject,reduction="umap")[,1:2]) #Added by ZZY on 1/30/2023.
altogether.expressions=getAvgExp(seuratObject,cells,NULL,geneDescriptions,features,log)
samples.expressions=getAvgExp(seuratObject,cells,'Sample',geneDescriptions,features,log)
clusters.expressions=getAvgExp(seuratObject,cells,'Cluster',geneDescriptions,features,log)
sample_clusters.expressions=getAvgExp(seuratObject,cells,'ClusteredSample',geneDescriptions,features,log)
if ('Phase' %in% colnames(seuratObject@meta.data)) {
phases.expressions=getAvgExp(seuratObject,cells,'Phase',geneDescriptions,features,log)
sample_phases.expressions=getAvgExp(seuratObject,cells,'PhasedSample',geneDescriptions,features,log)
cluster_phases.expressions=getAvgExp(seuratObject,cells,'PhasedCluster',geneDescriptions,features,log)
sample_cluster_phases.expressions=getAvgExp(seuratObject,cells,'PhasedClusteredSample',geneDescriptions,features,log)
} else {
phases.expressions=NULL
sample_phases.expressions=NULL
cluster_phases.expressions=NULL
sample_cluster_phases.expressions=NULL
}
return(list(altogether.expressions=altogether.expressions,samples.expressions=samples.expressions,clusters.expressions=clusters.expressions,sample_clusters.expressions=sample_clusters.expressions,phases.expressions=phases.expressions,sample_phases.expressions=sample_phases.expressions,cluster_phases.expressions=cluster_phases.expressions,sample_cluster_phases.expressions=sample_cluster_phases.expressions))
}
####################
getAverageExpressionsV2 = function(seuratObject,geneDescriptions,features=NULL,log) {
vars=c('ident','nCount_RNA','nFeature_RNA','percent.mt','percent.rp')
......
vizapp/shinyapp/server.R
+ 482
− 191
View file @ ba363fd9
This diff is collapsed.
vizapp/shinyapp/ui.R
+ 14
− 19
View file @ ba363fd9
......@@ -92,23 +92,12 @@ ui <- fluidPage(
)
),
fluidRow(
column(6,
tags$div(title = "Divides cells into their phase in the cell cycle.",
checkboxInput("phasing", "Cell Cycle Phasing", value = FALSE)
)
),
column(6,
tags$div(title = "Toggle on for log-transformed data. Toggle off for normalized data.",
checkboxInput("log", "Log Transformation", value = FALSE)
)
)
),
selectInput("group", "Group by",
choices = c("none" = "none",
"cluster" = "idents",
"sample" = "orig.ident",
"both" = "both"),
selected = "none", multiple = FALSE),
fluidRow(
column(6,
selectInput("img_f", "Image Download Format",
......@@ -128,12 +117,15 @@ ui <- fluidPage(
column(6,
numericInput("width", "Image Download Width", value = 10)
),
conditionalPanel(condition = "output.finished",
column(12, actionButton("apply_changes", "Apply changes")),
column(12, downloadButton("download_data_table", "Download Expression Data")),
column(12, downloadButton("download_single_cell_data", "Download Single Cell Data"))
),
conditionalPanel(
condition = "output.finished",
div(class = "autoscale-button-row",
actionButton( "apply_changes", "Apply changes" ),
downloadButton( "download_data_table", "Avg Expression Data" ),
downloadButton( "download_single_cell_data", "Single Cell Expression Data")
)
)
)
),
tabPanel("Help",
strong("Dimension Reduction Plots:"),
......@@ -208,9 +200,9 @@ ui <- fluidPage(
div(style = "overflow-x: auto; width: 100%;",
uiOutput("dimension_ui")
),
div(style = "overflow: auto; width: 100%; height: 100%;",
#div(style = "overflow: auto; width: 100%; height: 100%;",
uiOutput("feature_ui")
)
# )
)
),
fluidRow(
......@@ -349,7 +341,10 @@ ui <- fluidPage(
),
fluidRow(
column(6, downloadButton("DE_rdata", "Download Differential Expression Object")),
column(6, tableOutput("DETable"))
)
,
fluidRow(
column(12, tableOutput("DETable"))
)
)
)
......
vizapp/shinyapp/www/filter.js
+ 47
− 50
View file @ ba363fd9
......@@ -4,70 +4,67 @@ function escapeSelector(selector) {
}
function initSortableForRow(rowID) {
// Strip the "filter_row_" prefix to get the actual filter ID.
var filterID = rowID.replace("filter_row_", "");
// Find all available lists in the row whose id starts with "avail_"
// filterID = "1" from "filter_row_1"
var filterID = rowID.replace(/^filter_row_/, "");
// find each available list in this row
$("#" + rowID).find("ul[id^='avail_']").each(function() {
var availList = $(this);
// Expected id format: "avail_<varSelected>_<filterID>"
var idParts = availList.attr("id").split("_");
if (idParts.length < 3) {
console.log("Unexpected ID format for available list: " + availList.attr("id"));
var availID = $(this).attr("id"); // e.g. "avail_seurat_clusters_1"
var m = availID.match(/^avail_(.+)_\d+$/); // capture "seurat_clusters"
if (!m) {
console.warn("Unexpected avail_ id:", availID);
return;
}
var varSelected = idParts[1];
var rawAvailID = "avail_" + varSelected + "_" + filterID;
var rawSelID = "sel_" + varSelected + "_" + filterID;
var rawHiddenID = "hidden_" + varSelected + "_" + filterID;
// Escape IDs to handle special characters (e.g. dots)
var availSelector = "#" + escapeSelector(rawAvailID);
var selSelector = "#" + escapeSelector(rawSelID);
var hiddenSelector = "#" + escapeSelector(rawHiddenID);
console.log("Initializing dynamic row: " + rowID + " for variable: " + varSelected);
console.log("Available list selector: " + availSelector, $(availSelector).prop("outerHTML"));
console.log("Selected list selector: " + selSelector, $(selSelector).prop("outerHTML"));
// If sortable is already initialized, destroy it.
if ($(availSelector).hasClass("ui-sortable")) {
$(availSelector).sortable("destroy");
}
if ($(selSelector).hasClass("ui-sortable")) {
$(selSelector).sortable("destroy");
}
// Initialize the available list.
$(availSelector).sortable({
var varSelected = m[1]; // "seurat_clusters"
var rawAvailID = "avail_" + varSelected + "_" + filterID;
var rawSelID = "sel_" + varSelected + "_" + filterID;
var hiddenID = "hidden_" + varSelected + "_" + filterID;
// escape and wire up your sortable exactly as before...
var availSel = "#" + escapeSelector(rawAvailID);
var chosenSel = "#" + escapeSelector(rawSelID);
var hiddenSel = "#" + escapeSelector(hiddenID);
// destroy+re‑init
if ($(availSel).hasClass("ui-sortable")) $(availSel).sortable("destroy");
if ($(chosenSel).hasClass("ui-sortable")) $(chosenSel).sortable("destroy");
$(availSel).sortable({
connectWith: "ul",
placeholder: "sortable-placeholder"
}).disableSelection();
// Initialize the selected list.
$(selSelector).sortable({
$(chosenSel).sortable({
connectWith: "ul",
placeholder: "sortable-placeholder",
update: function(event, ui) {
if ($(this).children("li.sortable-item").length === 0) {
if ($(this).children("li.default-message").length === 0) {
$(this).append('<li class="default-message">Drop here</li>');
}
} else {
$(this).find("li.default-message").remove();
}
var selected = $(this).children("li.sortable-item").map(function() {
return $(this).data("value");
}).get();
var selectedStr = selected.join(',');
$(hiddenSelector).val(selectedStr).trigger('change');
console.log("Updated hidden input " + hiddenSelector + " with value: " + selectedStr);
update: function(e, ui) {
var vals = $(this).children("li.sortable-item")
.map(function(){ return $(this).data("value"); })
.get();
$(hiddenSel).val(vals.join(",")).trigger("change");
}
}).disableSelection();
});
}
// when the user clicks the modal’s Save button, grab each row’s selected li values
$(document).on('click', '#apply_filters', function(){
var allVals = {};
// for each filter‐row wrapper
$('.filter-row-wrapper').each(function(){
// the id is filter_row_<ID>
var rowID = $(this).find('.filter-row').attr('id');
var id = rowID.replace('filter_row_','');
// collect the <li> data‑values in the selected list in order
var vals = $(this)
.find('.selected-values li.sortable-item')
.map(function(){ return $(this).data('value'); })
.get();
allVals[id] = vals;
});
// send one tidy object to Shiny
Shiny.setInputValue('capture_vals', allVals, {priority:'event'});
});
// done
// Initialize sorting of the entire filter rows container.
function initRowSorting() {
......
vizapp/shinyapp/www/style.css
+ 24
− 0
View file @ ba363fd9
......@@ -269,3 +269,27 @@ body, html {
align-items: center; /* centers vertically */
padding-right: 10px; /* adds space to the right */
}
#download7 {
margin-top: 10px;
}
#download2 {
margin-top: 10px;
}
/* only autoscale & flex‑wrap the three sidebar buttons/download links */
.autoscale-button-row {
display: flex;
flex-wrap: wrap;
justify-content: space-between;
gap: 0.5rem; /* gutter if they wrap */
margin-top: 0.5rem; /* optional spacing above */
}
.autoscale-button-row .btn,
.autoscale-button-row .shiny-download-link {
font-size: clamp(1rem, 1.5vw, 1.2rem) !important;
white-space: normal;
line-height: 1.2;
}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment