How to modify the plot sizes in shiny app? - r

Question

I built a shiny app which present several plot types. However, the plots are cut from the top, and they are too wide. I tried modifying the width and height in the plotOutput function, did not work.
My code:
ui <- fluidPage(theme = shinytheme('united'),
titlePanel(title = h3("Graphs - ordered chronologically", align="center")),
selectInput("Plot",
"Choose what plots to present",
choices = list(Heatmap = "Heatmap", PCA = "PCA", VolcanoPlot = "VolcanoPlot", GSEA = 'GSEA')),
submitButton(text = "Show plots"),
verticalLayout( plotOutput(outputId = "PART.1", width = '70%'))
)
The problem is most prominent with the Heatmaps and Volcano plots. The volcano plot is cut from the top, and the heatmaps are too stretched wide:
How can I fix this? thank you.
EDIT:
A minimal version of my code:
library(data.table)
library(dplyr)
library(shiny)
library(shinythemes)
library(plotly)
library(compGenomRData)
library(BiocManager)
library(DESeq2)
library(org.Hs.eg.db)
library(TxDb.Hsapiens.UCSC.hg19.knownGene)
library(EnsDb.Hsapiens.v86)
library(AnnotationHub)
library(AnnotationDbi)
library(pheatmap)
library(EnhancedVolcano)
library(ggplot2)
library(FactoMineR)
library(devtools)
library(clusterProfiler)
library(ggnewscale)
library(enrichplot)
library(msigdbr)
library(readxl)
library(ExperimentHub)
library(annotate)
ui <- fluidPage(theme = shinytheme('united'),
titlePanel(title = h3("Graphs - ordered chronologically", align="center")),
selectInput("Plot",
"Choose which plots to present",
choices = list(Heatmap = "Heatmap", PCA = "PCA", VolcanoPlot = "VolcanoPlot", GSEA = 'GSEA')),
submitButton(text = "Show plots"),
verticalLayout( plotOutput(outputId = "PART.1", width = '70%'),
plotOutput(outputId = "PART.2", width = '70%'),
plotOutput(outputId = "PART.3", width = '70%'),
plotOutput(outputId = "PART.4", width = '70%'),
plotOutput(outputId = "PART.5", width = '70%'),
plotOutput(outputId = "PART.6", width = '70%'),
plotOutput(outputId = "PART.7", width = '70%'))
)
server <- function(input, output) {
# RNA-seq data
raw_counts <- frea
d('E-MTAB-7805-raw-counts.tsv', data.table = F)
metadata <- fread('E-MTAB-7805-experiment-design.tsv' ,data.table = F)
A=duplicated(raw_counts$`Gene ID`) # Check for duplicates and remove them
raw_counts = raw_counts[!A,]
A=duplicated(raw_counts$`Gene Name`) # Check for duplicates and remove them
raw_counts = raw_counts[!A,]
Hugo.Symbol <- raw_counts[,c(1:2)]
rownames(raw_counts) <- raw_counts$`Gene Name` # renaming rownames
raw_counts <- raw_counts[, -c(1:2)]
# metadata
C = duplicated(metadata$Run) # Check for duplicates and remove them
metadata = metadata[!C,]
rownames(metadata) <- metadata$Run
metadata <- metadata[,-1]
ind <- order(colnames(raw_counts), rownames(metadata))
raw_counts <- raw_counts[,ind]
# filter
target1 <- c("0 day", "1 day")
Meta_filter1 <- metadata %>% dplyr::filter(`Factor Value[time]` %in% target1)
Counts_filter1 <- raw_counts[intersect(names(raw_counts), rownames(Meta_filter1))]
rownames(Counts_filter1) <- Hugo.Symbol$`Gene Name`
# annotate
Meta_filter1$group <- plyr::mapvalues(Meta_filter1$`Factor Value[time]`, c("0 day", "1 day"),
c("CTRL", "CASE"))
ind <- order(colnames(Counts_filter1), rownames(Meta_filter1))
Counts_filter1 <- Counts_filter1[,ind]
dds <- DESeqDataSetFromMatrix(countData = Counts_filter1,
colData = Meta_filter1,
design = ~ group)
dds = DESeq(dds)
res = results(dds)
res$symbol <- rownames(res)
resOrder <- res[order(res$padj),]
# heatmap
dds.symbol = dds
rownames(dds.symbol) = mapIds(org.Hs.eg.db,
keys=rownames(dds),
column="SYMBOL",
keytype="SYMBOL",
multiVals="first")
rownames(dds.symbol)[is.na(rownames(dds.symbol))] = rownames(dds)[is.na(rownames(dds.symbol))]
rownames(dds.symbol) = make.unique(rownames(dds.symbol))
selectUp <- resOrder$symbol[resOrder$log2FoldChange>0][1:20]
selectDown <- resOrder$symbol[resOrder$log2FoldChange<0][1:20]
select = c(selectUp,selectDown)
df <- data.frame(row.names = colnames(dds.symbol),
group = colData(dds.symbol)$group)
normcounts = assay(vst(dds.symbol,blind=T, nsub = 2000))
# Functional enrichment
res = res[!is.na(res1$padj),]
mygenes <- rownames(res)
lfc = res1$log2FoldChange # get gene symbol
names(lfc) <- rownames(res)
lfc <- sort(lfc, decreasing = TRUE)
hallmarks <- msigdbr(species = "Homo sapiens", category = "H") %>%
dplyr::select(gs_name, gene_symbol)
## Output
output$PART.1 <- renderPlot({
if (input$Plot == 'Heatmap') {
pheatmap(normcounts[select,], cluster_rows=TRUE,
show_colnames = FALSE,cluster_cols=TRUE,
annotation_col=df, scale = 'row',cutree_cols = 2,cutree_rows = 2)
} else if (input$Plot == 'PCA') {
Var <- apply(normcounts, 1, var)
selectedVarGenes <- names(Var[order(Var, decreasing = T)][1:1000])
M <- t(normcounts[selectedVarGenes,])
pcaResults = prcomp(M)
qplot(pcaResults$x[,1],pcaResults$x[,2], col=dds1$group,size=2)
} else if (input$Plot == 'VolcanoPlot') {
EnhancedVolcano(resOrder,
lab = resOrder$symbol,
x = 'log2FoldChange',
y = 'padj',
labSize=4,
FCcutoff=2 )
} else {
em <- GSEA(lfc, TERM2GENE = hallmarks)
dotplot(em)
}
})
shinyApp(ui = ui, server = server)

Answer 1

Maybe if you include a call to par before calling pheatmap can help:
par(mar=c(5,4,6,2)) # bottom, left, top, right
pheatmap(
normcounts[select,], cluster_rows=TRUE,
show_colnames = FALSE, cluster_cols=TRUE,
annotation_col=df, scale = 'row',
cutree_cols = 2,cutree_rows = 2
)