.Rhistory

pt.size = input$pt_size,
label = TRUE
)
}, height = function() {
# Dynamic height based on input
height_val <- as.numeric(gsub("px", "", input$dim_plot_height))
if (is.na(height_val) || height_val < 400) height_val <- 600
return(height_val)
}, width = function() {
# Dynamic width based on input
width_val <- as.numeric(gsub("px", "", input$dim_plot_width))
if (is.na(width_val) || width_val < 400) width_val <- 800
return(width_val)
})
# Update cluster choices for marker gene analysis
updateSelectInput(
session,
"test_cluster",
choices = levels(values$seurat_processed$seurat_clusters),
selected = levels(values$seurat_processed$seurat_clusters)[1]
)
updateSelectInput(
session,
"reference_cluster",
choices = levels(values$seurat_processed$seurat_clusters),
selected = levels(values$seurat_processed$seurat_clusters)[2]
)
# Update visualization grouping choices
current_choices <- c("Clusters" = "seurat_clusters")
# Check if cell types already exist
if ("cell_type" %in% colnames(values$seurat_processed@meta.data)) {
current_choices <- c(current_choices, "Cell Types" = "cell_type")
}
updateSelectInput(
session,
"group_by_viz",
choices = current_choices,
selected = "seurat_clusters"
)
}, error = function(e) {
showNotification(
paste("Error in clustering:", e$message),
type = "error",
duration = NULL
)
})
})
})
# Find marker genes
observeEvent(input$find_markers_btn, {
req(values$seurat_processed)
withProgress(message = 'Finding marker genes...', value = 0, {
tryCatch({
if (input$marker_type == "all") {
# Find markers for all clusters
values$marker_genes <- AllMarkers(
values$seurat_processed,
logfc.threshold = as.numeric(input$logfc_threshold),
only.pos = as.logical(input$only_pos)
)
} else {
# Find markers for specific clusters
values$marker_genes <- Spcfc_Markers(
values$seurat_processed,
logfc.threshold = as.numeric(input$logfc_threshold),
only.pos = as.logical(input$only_pos),
cluster1 = input$test_cluster,
cluster2 = input$reference_cluster
)
}
# Display marker genes table with styling for dark background
output$markers_table <- DT::renderDataTable({
req(values$marker_genes)
DT::datatable(
values$marker_genes,
options = list(
pageLength = 15,
scrollX = TRUE,
scrollY = '500px',
dom = 'Bfrtlip',
autoWidth = TRUE,
columnDefs = list(
list(width = '150px', targets = c(0, 1)),
list(className = 'dt-center', targets = "_all")
)
),
class = 'cell-border stripe hover',
rownames = FALSE,
selection = 'single',
style = 'bootstrap4'
) %>%
DT::formatStyle(
columns = names(values$marker_genes),
backgroundColor = '#343a40',
color = 'white',
fontSize = '14px'
) %>%
DT::formatRound(
columns = c('p_val', 'avg_log2FC', 'p_val_adj', 'pct.1', 'pct.2', 'pct_diff'),
digits = 3
)
})
# FIXED: Plot top markers heatmap with proper gene names and cluster labels
output$marker_heatmap <- renderPlot({
req(values$marker_genes, values$seurat_processed)
# Get top markers per cluster based on user input
if (input$marker_type == "all") {
# Use user-defined number of genes per cluster
top_markers <- values$marker_genes %>%
group_by(cluster) %>%
top_n(input$n_genes_heatmap, wt = avg_log2FC) %>%
pull(gene)
# Ensure we have actual gene names that exist in the object
available_genes <- top_markers[top_markers %in% rownames(values$seurat_processed)]
if (length(available_genes) == 0) {
showNotification("No marker genes found in the dataset", type = "warning")
return(NULL)
}
# Create a much simpler and more visible heatmap
p <- DoHeatmap(
values$seurat_processed,
features = available_genes,
group.by = "seurat_clusters",
size = 6,        # Larger gene label text
angle = 0,       # Horizontal gene labels
hjust = 0.5,     # Center gene labels
draw.lines = TRUE,
lines.width = 2,
group.bar.height = 0.02
) +
scale_fill_gradient2(
low = "blue",
mid = "white",
high = "red",
midpoint = 0,
name = "Expression",
guide = guide_colorbar(
title.position = "top",
title.hjust = 0.5,
barwidth = 1,
barheight = 15,
frame.colour = "black",
ticks.colour = "black"
)
) +
theme_minimal() +
theme(
# Y-axis (gene names) - make them very visible
axis.text.y = element_text(
size = 12,
color = "black",  # Changed to black for better contrast
face = "bold"
),
# X-axis (remove cell names, keep cluster labels)
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
# Legend styling - make it very visible
legend.text = element_text(size = 14, color = "black"),
legend.title = element_text(size = 16, color = "black", face = "bold"),
legend.background = element_rect(fill = "white", color = "black", linewidth = 1),
# Plot background - white for maximum contrast
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
# Plot title
plot.title = element_text(
size = 18,
color = "black",
face = "bold",
hjust = 0.5
),
# Panel and grid
panel.grid = element_blank(),
axis.title = element_blank()
) +
ggtitle(paste("Top", input$n_genes_heatmap, "markers per cluster"))
return(p)
} else {
# For specific clusters
top_markers <- values$marker_genes %>%
top_n(input$n_genes_heatmap, wt = avg_log2FC) %>%
pull(gene)
# Ensure we have actual gene names that exist in the object
available_genes <- top_markers[top_markers %in% rownames(values$seurat_processed)]
if (length(available_genes) == 0) {
showNotification("No marker genes found in the dataset", type = "warning")
return(NULL)
}
# Create a subset with just the two clusters of interest
Idents(values$seurat_processed) <- "seurat_clusters"
cells_use <- WhichCells(values$seurat_processed,
idents = c(input$test_cluster, input$reference_cluster))
# Subset data for just these two clusters
sub_obj <- subset(values$seurat_processed, cells = cells_use)
# Create heatmap
p <- DoHeatmap(
sub_obj,
features = available_genes,
group.by = "seurat_clusters",
size = 6,        # Larger gene label text
angle = 0,       # Horizontal gene labels
hjust = 0.5,     # Center gene labels
draw.lines = TRUE,
lines.width = 2,
group.bar.height = 0.02
) +
scale_fill_gradient2(
low = "blue",
mid = "white",
high = "red",
midpoint = 0,
name = "Expression",
guide = guide_colorbar(
title.position = "top",
title.hjust = 0.5,
barwidth = 1,
barheight = 15,
frame.colour = "black",
ticks.colour = "black"
)
) +
theme_minimal() +
theme(
# Y-axis (gene names) - make them very visible
axis.text.y = element_text(
size = 12,
color = "black",  # Changed to black for better contrast
face = "bold"
),
# X-axis (remove cell names, keep cluster labels)
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
# Legend styling - make it very visible
legend.text = element_text(size = 14, color = "black"),
legend.title = element_text(size = 16, color = "black", face = "bold"),
legend.background = element_rect(fill = "white", color = "black", linewidth = 1),
# Plot background - white for maximum contrast
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
# Plot title
plot.title = element_text(
size = 18,
color = "black",
face = "bold",
hjust = 0.5
),
# Panel and grid
panel.grid = element_blank(),
axis.title = element_blank()
) +
ggtitle(paste("Top", input$n_genes_heatmap, "markers:", input$test_cluster, "vs", input$reference_cluster))
return(p)
}
}, height = function() {
max(800, input$heatmap_height)
}, width = function() {
max(1000, input$heatmap_width)
})
}, error = function(e) {
showNotification(
paste("Error finding markers:", e$message),
type = "error",
duration = NULL
)
})
})
})
# Download marker genes
output$download_markers_btn <- downloadHandler(
filename = function() {
"marker_genes.csv"
},
content = function(file) {
req(values$marker_genes)
write.csv(values$marker_genes, file)
}
)
# Dynamic UI for manual annotation
output$cluster_annotation_ui <- renderUI({
req(values$seurat_processed)
if (!"seurat_clusters" %in% colnames(values$seurat_processed@meta.data)) {
return(p("Please run clustering first."))
}
clusters <- levels(as.factor(values$seurat_processed$seurat_clusters))
# Create text inputs for each cluster
input_list <- lapply(clusters, function(cluster) {
textInput(
inputId = paste0("cluster_", cluster, "_annotation"),
label = paste("Cluster", cluster, ":"),
value = paste0("Cell_type_", cluster),
placeholder = "Enter cell type..."
)
})
do.call(tagList, input_list)
})
# FIXED: Apply manual annotations with proper cell mapping
observeEvent(input$apply_manual_annotation, {
req(values$seurat_processed)
tryCatch({
# Check if clustering has been done
if (!"seurat_clusters" %in% colnames(values$seurat_processed@meta.data)) {
showNotification(
"Please run clustering first before annotating cell types.",
type = "warning",
duration = 5
)
return()
}
clusters <- levels(as.factor(values$seurat_processed$seurat_clusters))
# Collect annotations from text inputs
annotations <- sapply(clusters, function(cluster) {
input_id <- paste0("cluster_", cluster, "_annotation")
annotation <- input[[input_id]]
if (is.null(annotation) || annotation == "") {
return(paste0("Cell_type_", cluster))  # Default if empty
}
return(annotation)
})
# Create cell type mapping
# Get the current cluster assignments for each cell
current_clusters <- as.character(values$seurat_processed$seurat_clusters)
# Map cluster numbers to cell type names
cell_types <- annotations[current_clusters]
# Add cell types to metadata using proper cell names
values$seurat_processed@meta.data$cell_type <- cell_types
# Store the annotation mapping
values$cluster_annotations <- data.frame(
cluster = clusters,
cell_type = annotations,
stringsAsFactors = FALSE
)
# Update visualization choices to include cell types
current_choices <- c("Clusters" = "seurat_clusters", "Cell Types" = "cell_type")
updateSelectInput(
session,
"group_by_viz",
choices = current_choices,
selected = "cell_type"  # Auto-select the new annotations
)
# Show success notification
showNotification(
"Cell type annotations applied successfully!",
type = "message",
duration = 5
)
# Update annotation plot
output$annotation_plot <- renderPlot({
req(values$seurat_processed)
Seurat::DimPlot(
values$seurat_processed,
reduction = 'umap',
group.by = 'cell_type',
pt.size = input$pt_size,
label = TRUE,
repel = TRUE
) +
ggtitle("Manual Cell Type Annotations") +
theme(plot.title = element_text(hjust = 0.5))
})
# Create summary table
output$celltype_summary_table <- DT::renderDataTable({
req(values$seurat_processed)
# Count cells per cell type
cell_counts <- table(values$seurat_processed$cell_type)
summary_df <- data.frame(
Cell_Type = names(cell_counts),
Cell_Count = as.numeric(cell_counts),
Percentage = round(as.numeric(cell_counts) / sum(cell_counts) * 100, 2),
stringsAsFactors = FALSE
)
DT::datatable(
summary_df,
options = list(
pageLength = 15,
dom = 't',
autoWidth = TRUE
),
style = 'bootstrap4',
rownames = FALSE
) %>%
DT::formatStyle(
columns = names(summary_df),
backgroundColor = '#343a40',
color = 'white',
fontSize = '14px'
)
})
}, error = function(e) {
showNotification(
paste("Error applying annotations:", e$message),
type = "error",
duration = 10
)
print(paste("Annotation error details:", e$message))
})
})
# UPDATED: Gene visualization with user-selected grouping
output$gene_plot <- renderPlot({
req(values$seurat_processed)
# Check what type of plot to create
if (input$plot_type == "dimplot") {
# UMAP plot colored by selected grouping variable
if (input$group_by_viz %in% colnames(values$seurat_processed@meta.data)) {
Seurat::DimPlot(
values$seurat_processed,
reduction = 'umap',
group.by = input$group_by_viz,
pt.size = input$pt_size,
label = TRUE,
repel = TRUE
) +
ggtitle(paste("UMAP colored by",
ifelse(input$group_by_viz == "seurat_clusters", "Clusters", "Cell Types"))) +
theme(plot.title = element_text(hjust = 0.5))
} else {
# Fallback to clusters if selected grouping doesn't exist
Seurat::DimPlot(
values$seurat_processed,
reduction = 'umap',
group.by = "seurat_clusters",
pt.size = input$pt_size,
label = TRUE,
repel = TRUE
) +
ggtitle("UMAP colored by Clusters") +
theme(plot.title = element_text(hjust = 0.5))
}
} else if (length(input$gene_select) > 0) {
# Gene expression plots
if (input$plot_type == "feature") {
# Feature plot
Seurat::FeaturePlot(
values$seurat_processed,
reduction = 'umap',
features = input$gene_select,
pt.size = input$pt_size
)
} else if (input$plot_type == "violin") {
# Violin plot with selected grouping
group_var <- input$group_by_viz
if (!group_var %in% colnames(values$seurat_processed@meta.data)) {
group_var <- "seurat_clusters"  # Fallback
}
if (length(input$gene_select) <= 3) {
Seurat::VlnPlot(
values$seurat_processed,
features = input$gene_select,
group.by = group_var,
pt.size = 0
)
} else {
# For more than 3 genes, use stacked violin plots
Seurat::VlnPlot(
values$seurat_processed,
features = input$gene_select,
group.by = group_var,
stack = TRUE,
flip = TRUE
)
}
}
} else {
# Default plot when no genes selected
if (input$group_by_viz %in% colnames(values$seurat_processed@meta.data)) {
Seurat::DimPlot(
values$seurat_processed,
reduction = 'umap',
group.by = input$group_by_viz,
pt.size = input$pt_size,
label = TRUE,
repel = TRUE
) +
ggtitle(paste("UMAP colored by",
ifelse(input$group_by_viz == "seurat_clusters", "Clusters", "Cell Types"))) +
theme(plot.title = element_text(hjust = 0.5))
} else {
# Fallback plot
Seurat::DimPlot(
values$seurat_processed,
reduction = 'umap',
group.by = "seurat_clusters",
pt.size = input$pt_size,
label = TRUE,
repel = TRUE
) +
ggtitle("UMAP colored by Clusters") +
theme(plot.title = element_text(hjust = 0.5))
}
}
}, height = function() {
# Dynamic height based on input
height_val <- as.numeric(gsub("px", "", input$viz_plot_height))
if (is.na(height_val) || height_val < 400) height_val <- 600
return(height_val)
}, width = function() {
# Dynamic width based on input
width_val <- as.numeric(gsub("px", "", input$viz_plot_width))
if (is.na(width_val) || width_val < 400) width_val <- 800
return(width_val)
})
# Download annotated Seurat object
output$download_annotated_obj_btn <- downloadHandler(
filename = function() {
"annotated_seurat_object.rds"
},
content = function(file) {
req(values$seurat_processed)
saveRDS(values$seurat_processed, file)
}
)
}
# Run the Shiny app
shinyApp(ui = ui, server = server)