diff --git a/app.R b/app.R index c7db957..2956968 100755 --- a/app.R +++ b/app.R @@ -55,24 +55,34 @@ celltypeList <- c("Astrocytes") ################################################### -ui <- navbarPage("Visualize NSCI scRNAseq Data", theme = shinytheme("slate"), +ui <- navbarPage(title=" ",theme = shinytheme("slate"), windowTitle="AlzApp: Visualize FTD scRNAseq Data", #shinythemes::themeSelector(), tabPanel("Overall Dataset", + + # Logos + div( + img(src="IDEA_Logo_WHITE.png",align="right",width="200px"), + img(src="NSCI_Full_Logo.png",align="left",width="150px") + ), + + # Application title - titlePanel("Tool for Exploration and Visualization of Frontotemporal Dementia scRNAseq Data"), - tags$div(class="header", checked=NA, - tags$h6("This application draws on a large dataset of single-cell RNA Seq data made available by Bowles et al. with the Neural Stem Cell Institute, as described in the 2021 paper"), - tags$a(href="https://doi.org/10.1016/j.cell.2021.07.003", "ELAVL4, splicing, and glutamatergic dysfunction + fixedRow(h2("Tool for Exploring scRNAseq Data from Frontotemporal Dementia Organoids", align="center"), + div(align="center", + h6("This application exposes the large dataset of single-cell RNA Sequencing data from dementia-affected brain organoids + described in the paper"), + a(href="https://doi.org/10.1016/j.cell.2021.07.003", "ELAVL4, splicing, and glutamatergic dysfunction precede neuron loss in MAPT mutation cerebral - organoids."), - tags$h6("Use the \"Gene Explorer\" and \"Cell Explorer\" top-level views to visualize dataset trends by individual gene or cell type."), - tags$hr() + organoids (Bowles et al. 2021)."), + h6("Use the \"Gene Explorer\" and \"Cell Explorer\" top-level views + to visualize dataset trends by individual gene or cell type.")), + hr() ), fixedRow( splitLayout(cellWidths = c("50%", "50%"), - cellArgs = list(style = "padding: 15px"), + cellArgs = list(style = "text-align:center;padding:15px"), tagList(tags$p("Dimensional reduction plot of the full dataset of ~370,000 single cells, colored by neuronal cell type"), plotOutput("CellFeaturePlot",height="450px")), @@ -110,7 +120,7 @@ ui <- navbarPage("Visualize NSCI scRNAseq Data", theme = shinytheme("slate"), ), tabPanel(title = "Time Trends - Expression Distributions", - fixedRow(tags$p("Expression distributions over time, by cell type and variant"), + fixedRow(tags$p("Expression distributions over time, by variant"), plotOutput("GeneVlnPlots",height="600px",width="70%"),align="center") ) @@ -130,17 +140,19 @@ ui <- navbarPage("Visualize NSCI scRNAseq Data", theme = shinytheme("slate"), plotOutput("CellTypeExplorerPlots",height="600px"),align="center") ), tabPanel(title= "Cell Type Marker Genes", - tags$h5("Left, marker genes distinguishing this cell type from all other cell types represented in the dataset, - as ranked by average log2 fold change. Right, REVIGO semantic summarization of the top 100 enriched GO terms for the genes differentially expressed in this cell type."), + + HTML("

Left, marker genes distinguishing this cell type from all other cell types represented in the dataset, + as ranked by average log2 fold change. Right, REVIGO semantic summarization of GO terms enriched + in the top 100 cell type marker genes.

"), tags$em("Only Astrocyte statistics available currently- data for more cell types coming soon!"), tags$hr(), sidebarLayout( sidebarPanel( selectInput(inputId = "celltype", - label = "Cell type", + label = "Select a cell type:", choices = celltypeList), dataTableOutput("celltypeTable"), - style = "padding: 10px;" + style = "padding: 25px;" ), mainPanel( @@ -150,18 +162,22 @@ ui <- navbarPage("Visualize NSCI scRNAseq Data", theme = shinytheme("slate"), plotOutput("REVIGOtree",height="450px")), tagList(tags$p("Semantic distances between enriched GO terms"), - plotOutput("REVIGOscatter",height="450px")) + plotOutput("REVIGOscatter",height="450px"),) ) ),fixedRow(splitLayout(cellWidths=c("45%","45%"), cellArgs = list(style = "padding: 15px"), tagList(tags$p(" ")), tagList(tags$p("Dot size, GO term significance."), - tags$p("Labels, most-populated reduced term categories.")) + tags$p("Labels, most-populated reduced term categories."), + br(),br(),br(), + div(tags$p("Read more about REVIGO visualizations "), + a(href="http://revigo.irb.hr/FAQ.aspx#q01", "here."))) ) ) ) ) + ) ) @@ -187,11 +203,13 @@ server <- function(input, output, session) { plot <- ggplot(celltype_data,aes_string(x = 'UMAP_1', y = 'UMAP_2', color = 'CellType')) + geom_point(size = 0.1, alpha = 0.1) + - scale_colour_discrete(name = "Cell type") + + scale_colour_discrete(name = "Cell Type") + xlab("UMAP 1") + ylab("UMAP 2") + - theme_minimal() + - guides(colour = guide_legend(override.aes = list(size=5))) - #coord_fixed(ratio = 1) + + guides(colour = guide_legend(override.aes = list(size=4,alpha=1),byrow=T)) + + theme(legend.text = element_text(size=10), legend.title=element_text(size=10), + legend.spacing.y = unit(0.9, 'cm')) + + coord_fixed(ratio = 1) + + theme_minimal() #coord_fixed(xlim=c(-11,11),ylim=c(-11,11)) + plot @@ -205,6 +223,11 @@ server <- function(input, output, session) { labs( x = "Developmental Timepoint of Organoid Cells", y = "Proportion of Cells", fill="Cell Type" ) + + + guides(fill = guide_legend(override.aes = list(size=4,alpha=1),byrow=T)) + + theme(legend.text = element_text(size=10), legend.title=element_text(size=10), + legend.spacing.y = unit(0.9, 'cm')) + + theme_minimal() @@ -242,17 +265,24 @@ server <- function(input, output, session) { gene_plot_data <- FetchData(seurat.all, c('Age','Mt','CellType',input$gene)) gene_plot_data <- setCellTypeNames(gene_plot_data) - ggplot(gene_plot_data, aes(x=Age, y=input$gene, fill=Mt)) + + ggplot(gene_plot_data, aes(x=Age, y=.data[[input$gene]], fill=Mt)) + geom_violin(trim=FALSE) + scale_fill_brewer(palette="Paired",name="Variant") + facet_wrap(~CellType, scales="free") + labs(x="Developmental Timepoint",y="Expression Level") + theme_minimal() + # ggplot(plotdata1, aes(x=Age, y=input$gene, fill=Mt)) + + # geom_violin(trim=FALSE) + scale_fill_brewer(palette="Paired",name="Variant") + + # scale_y_continuous(breaks=c(0,1,2,3),name=sprintf("%s Expression Level",input$gene)+ + # ylab("Expression Level") + + # xlab("Developmental Timepoint") + + # theme_minimal() + # }) # plot expression of input gene over time for each celltype by variant # as line graphs output$CellTypesByVariant <- renderPlot({ expression_means_for_this_gene <- G6cells %>% - select(all_of(input$gene),Mt,Age,CellType) %>% + dplyr::select(all_of(input$gene),Mt,Age,CellType) %>% group_by(Age, CellType, Mt) %>% summarise(mean_expr = mean(.data[[input$gene]])) @@ -287,7 +317,7 @@ server <- function(input, output, session) { output$CellTypeExplorerPlots <- renderPlot({ plot2 <- ggplot(celltype_data,aes_string(x = 'UMAP_1', y = 'UMAP_2', color="CellType")) + # render scatterplot, optionally adjust point size - geom_point(size = 0.1,alpha=0.2) + + geom_point(size = 0.1,alpha=0.3) + # adjust plot aspect ratio coord_fixed(ratio = 1) + # specify color gradient and a name for the associated legend @@ -308,9 +338,9 @@ server <- function(input, output, session) { #showdata <- celltype_data %>% filter(CellType==input$celltype) showdata <- tibble::rownames_to_column(celltype_markers) colnames(showdata)[1] <- "Gene" - showdata <- showdata %>% filter(avg_log2FC>=2) %>% select(Gene,avg_log2FC,p_val) + showdata <- showdata %>% filter(avg_log2FC>=2) %>% dplyr::select(Gene,avg_log2FC,p_val) showdata - }) + }, options=list(searching=F)) # Show GO output for the celltype marker genes of input celltype # output$GOtable <- renderDataTable({ @@ -336,7 +366,7 @@ server <- function(input, output, session) { simMatrix <- readRDS(sprintf("REVIGO_simMatrix_%s.rds",ct_select)) reducedTerms <- readRDS(sprintf("REVIGO_reducedTerms_%s.rds",ct_select)) - rrvgo::scatterPlot(simMatrix, reducedTerms) + scatterPlot(simMatrix, reducedTerms) }) output$REVIGOtree <- renderPlot({ @@ -345,7 +375,7 @@ server <- function(input, output, session) { # File read-in must be here because data depends on a reactive input value reducedTerms <- readRDS(sprintf("REVIGO_reducedTerms_%s.rds",ct_select)) - rrvgo::treemapPlot(reducedTerms) + treemapPlot(reducedTerms) }) } diff --git a/www/IDEA_Logo_WHITE.png b/www/IDEA_Logo_WHITE.png new file mode 100644 index 0000000..8aff50e Binary files /dev/null and b/www/IDEA_Logo_WHITE.png differ diff --git a/www/NSCI_Full_Logo.png b/www/NSCI_Full_Logo.png new file mode 100644 index 0000000..e26d7f5 Binary files /dev/null and b/www/NSCI_Full_Logo.png differ