Commit b3338591 authored by Lena Hersemann's avatar Lena Hersemann

added shinyApp to explore quality metrics

parent c2894784
#!/usr/bin/env bash
export SCRIPT_DIRECTORY="$(dirname "$0")/"
/usr/local/bin/Rscript -<<"EOF" ${SCRIPT_DIRECTORY}
args = commandArgs(trailingOnly = TRUE)
# LOAD packages --------------------------------------------------------------------------------------------------------
devtools::source_url("https://git.mpi-cbg.de/bioinfo/datautils/raw/v1.45/R/core_commons.R")
load_pack(destiny)
load_pack(plotly)
load_pack(shiny)
load_pack(data.table)
load_pack(rlist)
# Determine data directory from execution context ---------------------------------------------------------------------
dataPath= args[1]
#dataPath = "."
#-----------------------------------------------------------------------------------------------------------------------
# load all required data
all_files <- list.files(dataPath)
files_req <- c("dm.rds", "pca.rds", "cell_infos.txt")
if (any(!files_req %in% all_files)) { stop("ATTENTION: please make sure dm.rds, pca.rds and cell_infos.txt exist in your working directory") }
dm <- readRDS("dm.rds")
pca <- readRDS("pca.rds")
infos <- if(file.exists("scater_quality_metrics.txt")) {
read_tsv("scater_quality_metrics.txt")
} else {
read_tsv("cell_infos.txt")
}
# extract information on numeric values for the violin plots
infos_num <- infos %>% column_to_rownames("cell_id") %>% select_if(is.numeric) %>% mutate(cell_id = rownames(.)) %>%
push_left("cell_id") %>% gather(feature, value, -cell_id) %>% mutate(type = "numeric") %>% na.omit()
# extract information on the non-numeric values for the subsetting
infos_char <- infos %>% column_to_rownames("cell_id") %>% select_if(funs(!is.numeric(.))) %>% mutate(cell_id = rownames(.)) %>%
push_left("cell_id") %>% gather(feature, value, -cell_id) %>% mutate(type = "non_numeric") %>% na.omit()
infos <- rbind(infos_num, infos_char)
# select metrics suitable for subsetting and prepare radioButtons choices
info_groups <- infos %>% filter(type == "non_numeric") %>% select(-cell_id) %>% group_by(feature) %>% unique() %>% summarize(count = n()) %>% filter(between(count, 2,5)) %$% feature
radio_choices <- lapply(setNames(info_groups, info_groups), function(x) {
which(info_groups == x)
})
radio_choices <- list.append(radio_choices, "no subsetting" = length(radio_choices) + 1)
select_choices <- infos %>% filter(type == "numeric")
# combine dm data with all metrics
dm %<>% as.data.frame() %>% mutate(cell_id = rownames(.)) %>% select(cell_id, DC1:DC10) %>% right_join(infos, by = "cell_id")
# combine PCA data with all metrics
pca %<>% as.data.frame() %>% mutate(cell_id = rownames(.)) %>% select(cell_id, PC1:PC10) %>% right_join(infos, by = "cell_id")
app <- shinyApp(
ui <- navbarPage(title = "Explore Quality Metrics", id = "tabs",
tabPanel(title = "Violin plot",
sidebarPanel(width = 3,
selectInput(inputId = "choosen_metric", label = "Choose metrics",
choices = unique(select_choices$feature), selected = c("nGene", "nUMI", "percent.mito"),
multiple = TRUE, selectize=TRUE),
br(),
br(),
radioButtons("choosen_subsetting", label = "Choose data subsetting",
choices = radio_choices,
selected = length(radio_choices)),
br(),
tableOutput(outputId = "subset_summary")
),
mainPanel("",
fixedRow(
column(12, HTML(paste('<br/>')),
plotOutput(outputId = "violin_plot", height = "auto")
)
)
)
),
tabPanel(title = "Diffusion map",
sidebarPanel(width = 3,
selectInput(inputId = "choosen_metric_dm", label = "Choose metrics", choices = unique(infos$feature), multiple = FALSE, selected = "nGene", selectize=TRUE),
br(),
br()
),
mainPanel("",
fixedRow(
column(12, HTML(paste('<br/>')),
plotlyOutput(outputId = "dm")
)
)
)
),
tabPanel(title = "PCA",
sidebarPanel(width = 3,
selectInput(inputId = "choosen_metric_pca", label = "Choose metrics", choices = unique(infos$feature), multiple = FALSE, selected = "nGene", selectize=TRUE),
br(),
br()
),
mainPanel("",
fixedRow(
column(12, HTML(paste('<br/>')),
plotlyOutput(outputId = "pca")
)
)
)
)
),
server <- function(input, output, session) {
## VIOLIN PLOTS
output$violin_plot <- renderPlot({
infos_features <- infos %>% filter(feature %in% input$choosen_metric & type == "numeric")
# infos_features <- infos %>% filter(feature %in% c("nUMI", "nGene"))
if (input$choosen_subsetting == length(radio_choices)) {
vp <- infos_features %>% ggplot(aes(feature, as.numeric(value))) + geom_violin() +
xlab("") + facet_wrap(~feature, scale = "free", ncol = 2)
} else {
subset_var <- radio_choices[as.numeric(input$choosen_subsetting)] %>% names()
infos_subset <- infos %>% filter(feature == subset_var) %>% select(cell_id, value)
# infos_subset <- infos %>% filter(feature == "phase") %>% select(cell_id, value)
colnames(infos_subset) <- c("cell_id", "subsets")
infos_features <- left_join(infos_features, infos_subset, by = "cell_id")
# infos_features$subsets <- factor(infos_features$subsets,levels = unique(infos_features$subsets))
vp <- infos_features %>% ggplot(aes(feature, as.numeric(value), fill = subsets)) + geom_violin() +
xlab("") + facet_wrap(~feature, scale = "free", ncol = 2)
}
vp + theme(strip.text.x = element_text(size = 20), axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
panel.spacing = unit(2, "lines"),
axis.text.y=element_text(size = 12),
legend.text=element_text(size=14),
legend.title=element_blank()) +
ylab("")
}, height = function(){400*ceiling(length(input$choosen_metric)/2)})
output$subset_summary <- renderTable({
if (input$choosen_subsetting != length(radio_choices)){
subset_var <- radio_choices[as.numeric(input$choosen_subsetting)] %>% names()
# subset_var <- radio_choices[as.numeric("2")] %>% names()
infos_sum <- infos %>% filter(feature == subset_var) %>% count(value)
colnames(infos_sum) <- c(subset_var, "count")
infos_sum
}
})
## DIFFUSION MAP
output$dm <- renderPlotly({
dm_data <- dm %>% filter(feature == input$choosen_metric_dm)
# dm_data <- dm %>% filter(feature == "nGene")
if(unique(dm_data$type) == "numeric"){
plot_ly(dm_data, x = ~DC1, y = ~DC2, z = ~DC3, color = ~as.numeric(value), size = I(5), type = "scatter3d") %>%
layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
} else {
plot_ly(dm_data, x = ~DC1, y = ~DC2, z = ~DC3, color = ~as.factor(value), size = I(5), type = "scatter3d") %>%
layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
}
})
## PCA
output$pca <- renderPlotly({
pca_data <- pca %>% filter(feature == input$choosen_metric_pca)
# pca_data <- pca %>% filter(feature == "nGene")
if(unique(pca_data$type) == "numeric"){
plot_ly(pca_data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.numeric(value), size = I(5), type = "scatter3d") %>%
layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
} else {
plot_ly(pca_data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.factor(value), size = I(5), type = "scatter3d") %>%
layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
}
})
}
)
#runApp(app, launch.browser=TRUE, port=5357)
runApp(app, launch.browser=TRUE)
EOF
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