Commit fc4f8fc9 authored by Lena Hersemann's avatar Lena Hersemann

added option to visualize different count types in the violin plot

parent 94e88239
......@@ -20,6 +20,7 @@ load_pack(data.table)
load_pack(ggrepel)
load_pack(gridExtra)
load_pack(Seurat)
load_pack(rlist)
# Determine data directory from execution context ---------------------------------------------------------------------
......@@ -36,7 +37,7 @@ if (!dir.exists(dataPath)) { stop("required cluster_comp_folder not found") }
# check presence of all required data
all_files <- list.files(dataPath, pattern = ".txt")
files_req <- c("cluster_info", "cluster_marker_genes", "scaled_counts", "tsne_info")
files_req <- c("cluster_info", "cluster_marker_genes", "counts", "tsne_info")
if (any(!str_detect(all_files, paste0(files_req, collapse = "|")))) { stop("ATTENTION: please make sure cluster_info_*.txt, cluster_marker_genes_*.txt, scaled_counts.txt and tsne_info_*.txt exist in your working directory") }
......@@ -79,14 +80,13 @@ marker_info <- do.call(rbind, lapply(names(marker_data), function(x) marker_data
ungroup()
count_data <- data.table::fread(paste0(dataPath, "/scaled_counts.txt"))
gene_info <- select(count_data, ensembl_gene_id, external_gene_name, start_position, end_position, chromosome_name, description) %>%
mutate(description = str_replace_all(description, "\\[Source:MGI Symbol;Acc:MGI:[:digit:]*]", ""))
#scaled_data <- data.table::fread(paste0(dataPath, "/scaled_counts.txt"))
seo_data <- readRDS(paste0(dataPath, "/counts.rds"))
gene_info <- seo_data$genes %>% mutate(description = str_replace_all(description, "\\[Source:MGI Symbol;Acc:MGI:[:digit:]*]", ""))
seo_data <- list.remove(seo_data, "genes")
heatmap_data <- MinMax(seo_data$scaled, min = -2.5, max = 2.5)
count_data <- select(count_data, -c(external_gene_name, start_position, end_position, chromosome_name, description))
count_data <- count_data %>% column2rownames("ensembl_gene_id") %>% as.matrix()
count_data <- MinMax(count_data, min = -2.5, max = 2.5)
start_cluster_name = unique(marker_info$cluster_name)[1]
......@@ -152,7 +152,10 @@ app <- shinyApp(
tabPanel("TSNE",
radioButtons("vis_method", label = "", choiceNames = c("expression", "cluster"), choiceValues = c("expression", "cluster"), inline = TRUE, selected = "expression"),
plotOutput(outputId = "tsne", height = "auto")),
tabPanel("Violin plot", plotOutput(outputId = "violin", height = "auto")),
tabPanel("Violin plot",
checkboxGroupInput("count_type", label = "Visualize additional count type(s)", choiceNames = names(seo_data)[-4], choiceValues = names(seo_data)[-4], inline = TRUE, selected = "regressed"),
br(),
plotOutput(outputId = "violin")),
tabPanel("Heatmap", plotOutput(outputId = "heatmap", height = 800))
)
)
......@@ -191,7 +194,7 @@ app <- shinyApp(
outHeatmapData <- reactive({
selected_gene <- unique(gene_info[ which(gene_info$external_gene_name == input$choosen_gene),]$ensembl_gene_id)
heatmap_data <- count_data[selected_gene,]
heatmap_data <- heatmap_data[selected_gene,]
heatmap_data <- as.data.frame(heatmap_data) %>%
transmute(cell_id = rownames(.), score = heatmap_data) %>%
gather(cell_id, score) %>%
......@@ -309,23 +312,39 @@ app <- shinyApp(
plotting_violin <- function(data) {
plotting_violin <- function(data, type) {
plot_rows <- if (length(selected_samples()) > 1) { floor(length( selected_samples() )/2) } else { as.numeric(1) }
lapply(append(selected_samples(), "legend"), function(x){
data %>%
filter(str_detect(cluster_name, x)) %>%
ggplot(aes(as.factor(cluster_num), score, fill = as.factor(cluster_num))) +
geom_violin() +
theme(legend.position="none") +
selected_gene <- unique(gene_info[ which(gene_info$external_gene_name == input$choosen_gene),]$ensembl_gene_id)
types <- append(input$count_type, "regressed")
# types <- "regressed"
violin_data <- do.call(rbind, lapply(names(seo_data), function(x) {
# violin_data <- do.call(rbind, lapply(c("regressed"), function(x) {
d <- as.matrix(data[[x]])
d <- d[which(rownames(d) == selected_gene),]
d %<>% as.data.frame()
colnames(d) <- "expression"
d %>% mutate(cell_id = rownames(.), type = paste0(x))
})) %>%
na.omit() %>%
left_join(cluster_info %>% select(cell_id, cluster_num, cluster_name))
lapply(selected_samples(), function(c){
violin_data %>%
filter(str_detect(cluster_name, c)) %>%
filter(str_detect(type, paste0(types, collapse = "|"))) %>%
ggplot(aes(as.factor(cluster_num), expression, fill = as.factor(cluster_num))) + geom_violin() +
theme(legend.position="none", legend.title=element_blank()) +
xlab("") +
ggtitle(paste(x))
}) %>% grid.arrange(grobs = ., nrow = plot_rows)
ggtitle(paste(c)) +
facet_wrap(~type, nrow = 1, scale = "free")
}) %>% grid.arrange(grobs = ., ncol = 1)
}
output$violin <- renderPlot({ plotting_violin(outHeatmapData()) },
height = function(){400* if (length(selected_samples()) > 1) { floor(length( selected_samples() )/2) } else { as.numeric(1.5) }})
output$violin <- renderPlot({ plotting_violin(seo_data, input$count_type )},
height = function(){ 400* length(selected_samples()) })
......
Markdown is supported
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