Hotgenes: For Visualizing Differential Expression Analysis

Documented in Shiny_DE_viz

#' R shiny app for visualizing DE analysis
#' @import shiny
#' @import pheatmap
#' @import RColorBrewer
#' @importFrom data.table melt
#' @importFrom plyr ldply
#' @importFrom utils read.csv
#' @param DEseq2_export R object generated by DEseq2_export function
#' @return a shiny object for network visualization.
#' @export
#' @return a shiny UI and server for visualization.
#' @examples Example_Hotgenes_dir<-system.file("extdata",
#' "Example_Hotgenes.Rdata",
#' package = "Hotgenes", mustWork = TRUE)
#' load(Example_Hotgenes_dir)
#' if(interactive()){
#' Shiny_DE_viz(Example_Hotgenes)}

Shiny_DE_viz<-function(DEseq2_export=NULL){


habillage_choices<-c("clust", names(DEseq2_export$design_data))

# Contrast labels
FactoMiner_PCA<-data.frame(row.names=names(DEseq2_export$Output_lists),
name=names(DEseq2_export$Output_lists),
value=names(DEseq2_export$Output_lists),
stringsAsFactors = FALSE)

for(i in names(DEseq2_export$Output_lists)){
FactoMiner_PCA[i,"Total genes"]<-length(DEseq2_export$Output_lists[[i]])
}

FactoMiner_PCA$name<-paste(FactoMiner_PCA$name,
FactoMiner_PCA$`Total genes`,
sep = " genes: ")



# tab2 DE tables ----------------------------------------------------------
DE_coefficients<-DEseq2_export$Output_DE

# Tab3_Pheatmap samples ids -----------------------------------------------
Phea_ids<-colnames(DEseq2_export$Normalized_Expression[[1]])
bxplotIDS<-names(DEseq2_export$Exported_plots)
bxplotIDS<-bxplotIDS[bxplotIDS != "transformation_plots"]

Pheatmap_labels<-FactoMiner_PCA
Volcano_Plots_labels<-FactoMiner_PCA

# tab4 volcano plots



# UI ------------------------------------------------------------------

ui <- fluidPage(
sidebarLayout(sidebarPanel(width = 3,


# tab 1 boxplots ----------------------------------------------------------

conditionalPanel('input.dataset === "bxplotIDS"',
downloadButton(outputId = "downalpha", label = "Download the plot"),

radioButtons(inputId = "Norm_viz",
label = "Visualize Normalization methods:",
inline  = FALSE,
choices =  bxplotIDS,
selected = bxplotIDS[1])),


# tab 2 PCA ---------------------------------------------------------------
conditionalPanel('input.dataset === "FactoMiner_PCA"',
downloadButton(outputId = "down1", label = "Download the plot"),

radioButtons(inputId = "PCA_Norm_selection",
label = "Normalization selection:",
inline  = TRUE,
choices =  names(DEseq2_export$Normalized_Expression),
selected = names(DEseq2_export$Normalized_Expression)[1]),

checkboxGroupInput(inputId = "Contrasts",
label = "Contrasts selection:",
inline  = FALSE,
choiceNames =  FactoMiner_PCA[,1],
choiceValues = FactoMiner_PCA[,2],
selected = FactoMiner_PCA[1,2]),

sliderInput(inputId = "point_size",
label = "point size",
value = 3,
min = 1,
max = 10,
step = 1),

sliderInput(inputId = "label_size",
label = "label size:",
value = 3,
min = 1,
max = 10,
step = 1),

sliderInput(inputId = "ellipse.level",
label = "ellipse level:",
value = 0.5,
min = 0,
max = 1,
step = 0.05),

sliderInput(inputId = "ellipse.alpha",
label = "ellipse alpha:",
value = 0,
min = 0,
max = 1,
step = 0.05),

radioButtons(inputId = "habillage_id",
label = "Color by:",
inline  = FALSE,
choices =  habillage_choices),

radioButtons(inputId = "Biplot",
label = "Show Genes:",
inline  = FALSE,
choices =  c(FALSE, TRUE)),

# number of genes to show
numericInput(inputId = "Var",
label = "# of Genes:",
value = 10,
min = 1,
max = 30000,
step = 1)),


# tab3 DE frames -----------------------------------------------------------
conditionalPanel('input.dataset === "DE_coefficients"',

radioButtons(inputId = "DE_Contrasts",
label = "Contrasts selection:",
inline  = FALSE,
choices =  names(DE_coefficients) )),


# tab 4 volcano plots -----------------------------------------------------

conditionalPanel('input.dataset === "Volcano_Plots_labels"',

                 
numericInput(inputId = "stuffer",
label = "x/y limit adj:",
value = 0.5, 
min = 0,
max = 10, 
step = 0.5),                 
                 
numericInput(inputId = "pval_cut",
label = "p value cut off:",
value = 0.1, 
min = 0,
max = 1, 
step = 0.01),

numericInput(inputId = "FCcutoff",
label = "lfc off:",
value = 0, 
min = 0,
max = 10000, 
step = 0.1),

radioButtons(inputId = "Vplot_contrast",
label = "Contrasts selection:",
inline  = FALSE,
choiceNames =  Volcano_Plots_labels[,1],
choiceValues = Volcano_Plots_labels[,2],
selected = Volcano_Plots_labels[1,2])),


# Tab 5 Pheatmap -----------------------------------------------------------
conditionalPanel('input.dataset === "Pheatmap_labels"', 
downloadButton(outputId = "down2", label = "Download the plot"),

#input hotlist #annotations1
fileInput(inputId = "hotlist",
label = "Upload Hotlist",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),

#input annotations1
fileInput(inputId = "annotations",
label = "Upload PhenoData",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),

radioButtons(inputId = "annotation_legend",
label = "Show annotation legend:",
inline  = TRUE,
choices =  c(TRUE, FALSE)),

# Input: contrasts
radioButtons(inputId = "DE_Contrasts2",
label = "Contrasts selection:",
inline  = FALSE,
choiceNames =  Pheatmap_labels[,1],
choiceValues = Pheatmap_labels[,2],
selected = Pheatmap_labels[1,2]),

radioButtons(inputId = "Norm_selection",
label = "Normalization selection:",
inline  = TRUE,
choices =  names(DEseq2_export$Normalized_Expression),
selected = names(DEseq2_export$Normalized_Expression)[1]),

radioButtons(inputId = "col_pal",
label = "Color schemes:",
inline  = TRUE,
choices =  c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu",  "RdYlBu"),
selected = c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu",  "RdYlBu")[6]),

# number of genes to show
sliderInput(inputId = "CR",
label = "Color Ramp:",
value = 10,
min = 1,
max = 50,
step = 1),


radioButtons(inputId = "CC",
label = "Cluster:",
inline  = TRUE,
choices =  c(TRUE, FALSE)),

# Cut rows
sliderInput(inputId = "col_cut",
label = "Sample groups:",
value = 2,
min = 1,
max = 10,
step = 1),


# Cut rows
sliderInput(inputId = "row_cut",
label = "Gene groups:",
value = 2,
min = 1,
max = 10,
step = 1),


# point size
sliderInput(inputId = "W",
label = "Cell Width:",
value = 10,
min = 1,
max = 30,
step = 1),

# label_size
sliderInput(inputId = "H",
label = "Cell Height:",
value = 10,
min = 1,
max = 30,
step = 1),

# number of genes to show
numericInput(inputId = "Var2",
label = "Top significant Genes:",
value = 10,
min = 1,
max = 30000,
step = 1),

# number of genes to show
numericInput(inputId = "lfc",
label = "Abs lfc cut:",
value = 0,
min = 0,
max = 20,
step = 1),


checkboxGroupInput(inputId = "Samples",
label = "Sample selection:",
inline  = TRUE,
choices =  Phea_ids,
#choiceValues = Phea_ids[,2],
selected = Phea_ids)) ),



# tabs and mainpanels -----------------------------------------------------

# tab1
mainPanel(tabsetPanel(id = 'dataset',

tabPanel(title = "Normalization QC",
value="bxplotIDS",plotOutput(outputId = "G_plots"),
plotOutput(outputId = "Exporto_plots")),

# tab2
tabPanel(title = "Search for Hotgenes",
value = "FactoMiner_PCA", plotOutput(outputId = "PCA_plot"),
DT::dataTableOutput("tab1.1_Query"),DT::dataTableOutput("tab1.2_Query")),

# tab3
tabPanel("DE_coefficients", 
DT::dataTableOutput("tab2_Query")),

# tab4
tabPanel(title = "Volcano_Plots", 
value = "Volcano_Plots_labels",
plotOutput(outputId = "v_plot",
width = "100%", height = "700px")),

# tab5
tabPanel(title = "Heatmap", 
value = "Pheatmap_labels",
plotOutput(outputId = "pheat_plot",
width = "100%", height = "700px")) ))))


# server --------------------------------------------------------------


server <- function(input, output, session) {

# Tab2
output$tab2_Query<- DT::renderDataTable({
DT::datatable(DE_coefficients[[input$DE_Contrasts]],filter = 'top',
extensions = 'Buttons',
options = list(dom = 'Bfrtip',pageLength = -1,
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) })

# Tab1.1
output$tab1.1_Query<- DT::renderDataTable({
DT::datatable(output_Conditions_table(),
rownames = FALSE, filter = 'top',
extensions = 'Buttons',
options = list(dom = 'Bfrtip',pageLength = -1,
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) })



# Tab1.2
output$tab1.2_Query<- DT::renderDataTable({gene_tab()})
gene_tab<-reactive({ DT::datatable(output_Gene_table(),
rownames = FALSE, filter = 'top',
selection = list(target = 'cell'),
extensions = 'Buttons',
options = list(dom = 'Bfrtip', pageLength = -1,
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) })

# tab4 volcano plots

# volcano plot ------------------------------------------------------------


Vplot_p <- reactive({
Vplot(Hotgenes_input=DEseq2_export, 
pval_cut=input$pval_cut, 
FCcutoff=input$FCcutoff,
stuffer=input$stuffer,
contrast=input$Vplot_contrast) 
})

output$v_plot <- renderPlot({Vplot_p()})


# Tab3_Pheatmap pheatmap
# output tab1 plot
hotlist_input<-reactive({

input_file_path<-input$hotlist
if(!is.null(input_file_path)){
hot1 <- read.csv(input_file_path$datapath, stringsAsFactors=FALSE)
hotlist<-unique(hot1$Genes)
}else if(is.null(input_file_path)){
hotlist=NULL}
print(hotlist)
})

annotation_input<-reactive({

annotations_file_path<-input$annotations
if(!is.null(annotations_file_path)){
annotations <- data.frame(read.csv(annotations_file_path$datapath,
row.names=1, stringsAsFactors=FALSE))
}else if(is.null(annotations_file_path)){
annotations=NULL}
print(annotations)

})





# pheatmap ----------------------------------------------------------------


pheat_p <- reactive({

dm<-Pheatmap_Viz(DE_Input = DEseq2_export,
# filename= "ph.pdf",
hotList = hotlist_input(),
samples_ids = input$Samples,
ncut=input$Var2,
readouts=input$Norm_selection,
selected_contrast=input$DE_Contrasts2,
lfc_cut=input$lfc)


pheatmap(dm,
annotation_legend=as.logical(input$annotation_legend),
annotation_col=annotation_input(),
scale = "row",
border_color= "white",
cutree_rows=input$row_cut,
cutree_cols=input$col_cut,
fontsize_row=input$H,
fontsize_col=input$W,
cellwidth=input$W,
cellheight=input$H,
treeheight_row=10,
treeheight_col=10,
cluster_cols=as.logical(input$CC),
cluster_rows=TRUE,
color = colorRampPalette(rev(brewer.pal(n = 9, name =input$col_pal)))(input$CR))


})

output$pheat_plot <- renderPlot({pheat_p()})



# FactoMiner --------------------------------------------------------------


output_temp<-reactive({

PCA_report<-FactoWrapper(Output_DEseq2 = DEseq2_export,
readouts=input$PCA_Norm_selection,
habillage_selection=input$habillage_id,
#readouts="rlog",
biplot=input$Biplot,
#View_by_sample=TRUE,
Top_var=input$Var,
ellipse.level=input$ellipse.level,
ellipse.alpha=input$ellipse.alpha,
label_sel=c("ind", "var"),
selected_contrast=input$Contrasts,
labelsize = input$label_size,
pointsize = input$point_size  )
})

# downalpha plot
output$downalpha <- downloadHandler(
filename =  function() {
paste("Norm_plots", "pdf", sep=".")
},
# content is a function with argument file.content writes the plot to the device
content = function(file) {

pdf(file) # open the pdf device
print(output_norm())
dev.off()  # turn the device off
} )




## call the plot function when downloading the image
output$down1 <- downloadHandler(
filename =  function() {
paste("PCA_plot", "pdf", sep=".")
},
# content is a function with argument file.content writes the plot to the device
content = function(file) {

pdf(file) # open the pdf device
print(output_temp())
dev.off()  # turn the device off
} )


## call the plot function when downloading the image
output$down2 <- downloadHandler(
filename =  function() {
paste("heatmap", "pdf", sep=".")
},
# content is a function with argument file.content writes the plot to the device
content = function(file) {
pdf(file) # open the pdf device
print(pheat_p())
dev.off()  # turn the device off
} )


# output tab alpha G_plots

output$G_plots<-renderPlot({
DEseq2_export$Exported_plots$transformation_plots
})


# output tab alpha   Exporto_plots
output_norm <- reactive({
DEseq2_export$Exported_plots[input$Norm_viz]
})


output$Exporto_plots<-renderPlot({
output_norm()
})


# output tab1 plot
output$PCA_plot <- renderPlot({
output_temp()$res_PPI_pa_1
})


# output tab1 cat table
output_Conditions_table <- reactive({
Conditions_table<-Categorical_Table(output_temp()$res.hcpc,2)
print(Conditions_table)
})

# output tab1 gene table
output_Gene_table <- reactive({
Quanti_Table_2<-Quanti_Table(output_temp()$res.hcpc,2)
print(Quanti_Table_2)
})


}
shinyApp(ui, server)
}