Skip to content

Commit

Permalink
plots are generated with plotly now and some minor changes
Browse files Browse the repository at this point in the history
  • Loading branch information
fawaz-dabbaghieh committed Feb 2, 2018
1 parent bb7881e commit e0162a8
Show file tree
Hide file tree
Showing 7 changed files with 201 additions and 57 deletions.
125 changes: 72 additions & 53 deletions app/server.r
Original file line number Diff line number Diff line change
Expand Up @@ -9,24 +9,31 @@
#6 maybe start splitting the server into chuncks inside the server folder and source the chuncks (almost DONE!)
#7 Check for shiny as a R package (it's doable, need to understand how packages are organized first)
#8 Having some global variables so I won't need to fetch from DeepBlue many times (DONE!)
#9 Having one legend for subplot and download subplot
#9 Change all the plots to be in Plotly instead of ggplot
#10 Advanced option for plotting (choosing which PCAs to plot and filtering option) (DONE!)
#11 metadata to be interactive upon clicking on list of experiments (DONE!)
#12 RUV for batch effect
#13 select expression, for gene expression data
#14 activate and diactivate tabs and have a workflow for the app
#14 activate and diactivate tabs and have a workflow for the app (Done!)
#15 genomic ranges R package
#16 Have a download button for the adjusted matrix (Done !!)
#17 Need to have the back button only in the calculate matrix page and the next is added once the calculation is done (Done!!)
#18 Fix the corrplot download
#19 Score matrices and tables other than the first, lines don't need to be selected (Done!)


# TODOs -------------------------------------------------------------------
#9 Having one legend for subplot and download subplot
#7 Check for shiny as a R package (it's doable, need to understand how packages are organized first)
#12 RUV for batch effect
#9 Change all the plots to be in Plotly instead of ggplot

#7 Check for shiny as a R package
#12 RUV for batch effect (from Markus' scripts to understand how it works)
#13 select expression, for gene expression data
#14 activate and diactivate tabs and have a workflow for the app
#15 genomic ranges R package

#18 Fix the corrplot download
#It's working, but for some reason the PDFs are taking long time to show
#The plot maybe a bit too big, even thought the pdf file has a small size


#New UI with shiny dashboard
library(foreach)
Expand Down Expand Up @@ -93,7 +100,7 @@ function(input, output, session) {

output$summary <- DT::renderDataTable({
DT::datatable(summary_df(), filter = list(position = 'top', clear = FALSE),
selection = 'none', options = list(
selection = 'none',selection = 'none', options = list(
search = list(regex = TRUE, caseInsensitive = TRUE),
pageLength = 10)
)
Expand Down Expand Up @@ -241,25 +248,27 @@ function(input, output, session) {
# Plotting first matrix ---------------------------------------------------

#plot data
plot_pca <- eventReactive(input$plot_btn, {
first_pca_plot <- eventReactive(input$plot_btn, {
#get plot

plot_pca_labels <- plot_pca_labels(experiments_info_meta = experiments_info_meta(),
project = input$project,
filtered_score_matrix = filtered_score_matrix(),
epigenetic_mark = input$epigenetic_mark,
color_by = input$color_by,
first_pc = input$first_pc,
second_pc = input$second_pc)

plotly_pca <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = filtered_score_matrix(),
project = input$project,
type_of_score = input$type_of_score,
color_by = input$color_by,
epigenetic_mark = input$epigenetic_mark,
first_pc = input$first_pc,
second_pc = input$second_pc,
show_legend = TRUE)


showTab(inputId = "plot_box", target = "Download Plot")


return(plot_pca_labels)
return(plotly_pca)
})

output$plot <- renderPlotly(plot_pca())
output$plot <- renderPlotly(first_pca_plot())

observeEvent(input$plot_matrix_previous_tab,{
updateTabItems(session, "tabs", "score_matrix_tab")
Expand All @@ -281,22 +290,23 @@ function(input, output, session) {
filename = function() {

if(input$plot_down_exten == "pdf"){
paste0("Tiling Regions"," ", input$epigenetic_mark,".pdf")
paste0(input$type_of_score," ", input$epigenetic_mark,".pdf")

}else{
paste0("Tiling Regions"," ", input$epigenetic_mark,".html")
paste0(input$type_of_score," ", input$epigenetic_mark,".html")
}
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {

if(input$plot_down_exten == "pdf"){
pdf(file) # open the pdf device
print(plot_pca())
dev.off() # turn the device off
export(first_pca_plot(), file = file)
# pdf(file) # open the pdf device
# print(plot_pca())
# dev.off() # turn the device off
}else{
plot_pca_plotly <- plotly_build(plot_pca())
htmlwidgets::saveWidget(as_widget(plot_pca_plotly), file = file)
# plot_pca_plotly <- plotly_build(plot_pca())
htmlwidgets::saveWidget(as_widget(first_pca_plot()), file = file)

}
}
Expand All @@ -307,13 +317,16 @@ function(input, output, session) {
#plotting the matrix after batch effect
plot_pca_batch <- eventReactive(input$plot_batch, {
#get plot
plot_pca_batch <- plot_pca_labels(experiments_info_meta = experiments_info_meta(),
project = input$project,
filtered_score_matrix = batch_adjusted_matrix(),
epigenetic_mark = input$epigenetic_mark,
color_by = input$color_by_batch,
first_pc = input$first_pc_batch,
second_pc = input$second_pc_batch)

plot_pca_batch <- plotly_pca <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = batch_adjusted_matrix(),
project = input$project,
type_of_score = input$type_of_score,
color_by = input$color_by_batch,
epigenetic_mark = input$epigenetic_mark,
first_pc = input$first_pc_batch,
second_pc = input$second_pc_batch,
show_legend = TRUE)


showTab(inputId = "batch_plot_box", target = "Download Plot")
Expand All @@ -328,7 +341,7 @@ function(input, output, session) {
filename = function() {

if(input$plot_batch_down_exten == "pdf"){
paste0("Tiling Regions after Batch"," ", input$epigenetic_mark,".pdf")
paste0(input$type_of_score," ","after Batch"," ", input$epigenetic_mark,".pdf")

}else{
paste0("Tiling Regions after Batch"," ", input$epigenetic_mark,".html")
Expand All @@ -338,9 +351,11 @@ function(input, output, session) {
content = function(file) {

if(input$plot_batch_down_exten == "pdf"){
pdf(file) # open the pdf device
print(plot_pca_batch())
dev.off() # turn the device off
export(plot_pca_batch(), file = file)
#
# pdf(file) # open the pdf device
# print(plot_pca_batch())
# dev.off() # turn the device off
}else{
plot_pca_plotly <- plotly_build(plot_pca_batch())
htmlwidgets::saveWidget(as_widget(plot_pca_plotly), file = file)
Expand All @@ -353,26 +368,30 @@ function(input, output, session) {
# Comparing plots ---------------------------------------------------------

observeEvent(input$compare_plot, {
first_plot <- plot_pca_labels(experiments_info_meta = experiments_info_meta(),
project = input$project,
filtered_score_matrix = filtered_score_matrix(),
epigenetic_mark = input$epigenetic_mark,
color_by = input$color_by,
first_pc = input$first_pc,
second_pc = input$second_pc,
show_legend = FALSE)

second_plot <- plot_pca_labels(experiments_info_meta = experiments_info_meta(),
project = input$project,
filtered_score_matrix = batch_adjusted_matrix(),
epigenetic_mark = input$epigenetic_mark,
color_by = input$color_by,
first_pc = input$first_pc,
second_pc = input$second_pc)
p1 <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = filtered_score_matrix(),
project = input$project,
type_of_score = input$type_of_score,
color_by = input$color_by,
epigenetic_mark = input$epigenetic_mark,
first_pc = input$first_pc,
second_pc = input$second_pc,
show_legend = TRUE)

p2 <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = batch_adjusted_matrix(),
project = input$project,
type_of_score = input$type_of_score,
color_by = input$color_by_batch,
epigenetic_mark = input$epigenetic_mark,
first_pc = input$first_pc_batch,
second_pc = input$second_pc_batch,
show_legend = FALSE)

output$two_plots <- renderPlotly({
subplot(plotly_build(first_plot), plotly_build(second_plot),
shareX = TRUE, shareY = TRUE) %>% layout(title = "Comparing Plots", showlegend = TRUE)
subplot(p1, p2,
shareX = TRUE, shareY = TRUE) %>% layout(title = "Comparing Plots")
})

})
Expand Down
3 changes: 2 additions & 1 deletion app/ui.r
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
# tags$li(class = "dropdown", textOutput("logged_user"), style = "padding-top: 15px; padding-bottom: 15px; color: #fff;"),
tags$li(class = "dropdown", actionLink("login", textOutput("logintext")))
)

),

# Sidebar items -----------------------------------------------------------
Expand Down Expand Up @@ -193,6 +192,8 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",

),
tabPanel("Downlad Plot",
numericInput("pdf_width", label = "Width", value = 10),
numericInput("pdf_height", label = "Height", value = 10),
downloadButton(outputId = "corr_plot_down", label = "Download Corr. plot")

)
Expand Down
4 changes: 3 additions & 1 deletion functions/plot_pca_labels.r
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
#Plotting the score matrix with the relevant metadata with it

plot_pca_labels <- function(experiments_info_meta,filtered_score_matrix,project,
plot_pca_labels <- function(experiments_info_meta,
filtered_score_matrix,
project,
color_by = "biosource_name",
first_pc="1", second_pc="2",
epigenetic_mark = "Not Selected",
Expand Down
53 changes: 53 additions & 0 deletions functions/plotly_pca.r
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
plotly_pca <- function(experiments_info_meta,filtered_score_matrix, project,type_of_score,
color_by = "biosource_name",
epigenetic_mark = "No Epigenetic mark selected",
first_pc="1",
second_pc="2",
show_legend = T){

#calculating PCA
pca <- prcomp(filtered_score_matrix, center = TRUE, scale. = TRUE)

#preparing the plot data by taking the PCAs and adding metadata
plot.data <- as.data.frame(pca$rotation) %>%
tibble::rownames_to_column(var = "experiment") %>%
dplyr::left_join(experiments_info_meta, by=c("experiment"))

# #Getting colour pallet
# colourCount <- 9
# getPalette <- colorRampPalette(brewer.pal(colourCount, "Set1"))

if(project == "DEEP"){
label <- "DEEP_SAMPLE_ID"
hover = ~paste("Sample ID: ", DEEP_SAMPLE_ID,
'</br>Biosource Name: ', biosource_name)
}else{
label <- "experiment"
hover = ~paste("Sample ID: ", experiment,
'</br>Biosource Name: ', biosource_name)
}

x_lab <- paste0(paste0("PC", first_pc," ", "("),
round(pca$sdev[as.integer(first_pc)]^2/sum(pca$sdev^2), 2) * 100, "%)")

y_lab <- paste0(paste0("PC", second_pc," ", "("),
round(pca$sdev[as.integer(second_pc)]^2/sum(pca$sdev^2), 2) * 100, "%)")

browser()
p <-
plot.data %>%
arrange(plot.data[,color_by]) %>%
plot_ly(x = as.formula(paste0("~","PC", first_pc)),
text = hover,
color = as.formula(paste0("~",color_by)),
legendgroup = as.formula(paste0("~",color_by)),
colors = brewer.pal(9, "Set1"),
marker = list(size = 17.5)) %>%
add_markers(y = as.formula(paste0("~","PC", second_pc)), showlegend = show_legend) %>%
layout(title = paste("2 PCs plot", type_of_score, epigenetic_mark),
yaxis = list(title = y_lab, zeroline = FALSE),
xaxis = list(title = x_lab, zeroline = FALSE))

return(p)

}
68 changes: 68 additions & 0 deletions functions/supervised_sva_batch_effect.r
Original file line number Diff line number Diff line change
@@ -0,0 +1,68 @@
supervised_sva_batch_effect <- function(filtered_score_matrix,
adjustment_var,
interest_var){


# filtered_matrix <- filtered_score_matrix$data
metadata <- attr(filtered_score_matrix, "meta")

#validation of the inptus
#The variable selected should have more than 1 level
if(adjustment_var == ""){
adjustment_var = NULL
}else{
for (adj_var in adjustment_var){

validate(
need(!anyNA(metadata[,adj_var]), message = paste(adj_var, "has NAs and cannot be used to make the model"))
)
validate(
need(nlevels(metadata[,adj_var]) > 1, message = paste(adj_var,"has less than 2 level",
"check levels using the pie chart"))
)
}
}

if(interest_var == ""){
validate(
need(FALSE, message = "You need to choose a variable of interest for the full model in SVA")
)
}else{
for (inter_var in interest_var){

validate(
need(!anyNA(metadata[,inter_var]), message = paste(inter_var, "has NAs and cannot be used for the model"))
)
validate(
need(nlevels(metadata[,inter_var]) > 1, message = paste(inter_var,"has less than 2 level",
"check levels using the pie chart"))
)
}
}

if(is.null(adjustment_var)){
#No interest variable, mod0 is the intercept, full mod is the interest_var
mod0 <- model.matrix(~1, data = metadata)
mod <- model.matrix(as.formula(paste0("~", paste(interest_var, collapse = "+"))),
data = metadata)

}else{
mod0 <- model.matrix(as.formula(paste0("~", paste(adjustment_var, collapse = "+"))),
data = metadata)

mod <- model.matrix(as.formula(paste0("~", paste(
paste(interest_var, collapse = " + "),"+", paste(adjustment_var, collapse = " + ")
)
)),data = metadata)
}
n.sv <- num.sv(filtered_score_matrix, mod, method = "leek")
showNotification(paste("The number of latent factors estimated is", n.sv), duration = 3)

sva_object <- sva(filtered_score_matrix, mod, mod0, n.sv = n.sv)

batch_adjusted_matrix <- sva_object$sv

attr(batch_adjusted_matrix, "meta") <- metadata

return(batch_adjusted_matrix)
}
3 changes: 2 additions & 1 deletion functions/sva_batch_effect.r
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ sva_batch_effect <- function(filtered_score_matrix,
for (inter_var in interest_var){

validate(
need(!anyNA(metadata[,inter_var]), message = paste(inter_var, "has NAs and cannot be used to make the model"))
need(!anyNA(metadata[,inter_var]), message = paste(inter_var, "has NAs and cannot be used for the model"))
)
validate(
need(nlevels(metadata[,inter_var]) > 1, message = paste(inter_var,"has less than 2 level",
Expand All @@ -41,6 +41,7 @@ sva_batch_effect <- function(filtered_score_matrix,
}

if(is.null(adjustment_var)){
#No interest variable, mod0 is the intercept, full mod is the interest_var
mod0 <- model.matrix(~1, data = metadata)
mod <- model.matrix(as.formula(paste0("~", paste(interest_var, collapse = "+"))),
data = metadata)
Expand Down
2 changes: 1 addition & 1 deletion server/correlation_plot.r
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ output$corr_plot_down <- downloadHandler(
# content is a function with argument file. content writes the plot to the device
content = function(file) {

pdf(file) # open the pdf device
pdf(file, width = input$pdf_width, height = input$pdf_height) # open the pdf device

# correlation_plot()
plot_correlation(filtered_score_matrix = filtered_score_matrix(),
Expand Down

0 comments on commit e0162a8

Please sign in to comment.