Skip to content

Commit

Permalink
updates and fixex 23/January
Browse files Browse the repository at this point in the history
  • Loading branch information
fawaz-dabbaghieh committed Jan 23, 2018
1 parent 12414c2 commit bb7881e
Show file tree
Hide file tree
Showing 12 changed files with 290 additions and 57 deletions.
80 changes: 69 additions & 11 deletions app/server.r
View file
Original file line number Diff line number Diff line change
@@ -1,23 +1,32 @@

# TODOs -------------------------------------------------------------------
# for this weekend
# Done TODOs -------------------------------------------------------------------

#1 Only show download tabs and button after the data or plot has been generated so the user won't get an error (DONE!)
#2 when login again remove previous/next from second page (DONE! I think, will test for several cases later)
#3 remove the matrix and the output should be null again (Maybe use shinyjs::hide() then show again) (not really important now)
#4 Why correlation plot doesn't work (Haven't worked yet) maybe use do.call (Working now :-) DONE! )
#5 Do the batch effect with SVA and Supervised SVA
#5 Do the batch effect with SVA and Supervised SVA (Almost Done!)
#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 Figuring out the two plots comparison thing (almost DONE!)
#9 Having one legend for subplot and download subplot
#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
#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!!)

# 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
#13 select expression, for gene expression data
#14 activate and diactivate tabs and have a workflow for the app
#15 genomic ranges R package


#New UI with shiny dashboard
library(foreach)
Expand Down Expand Up @@ -56,9 +65,9 @@ function(input, output, session) {
genomes <- c()
listed_experiments <- reactiveVal(FALSE)
calculated_matrix <- reactiveVal(FALSE)
calculated_adjusted_matrix <- reactiveVal(FALSE)
logged_in <- reactiveVal("")



observe(hideTab(inputId = "plot_box", target = "Download Plot"))
observe(hideTab(inputId = "corr_plot_box", target = "Downlad Plot"))
observe(hideTab(inputId = "batch_plot_box", target = "Download Plot"))
Expand Down Expand Up @@ -168,23 +177,67 @@ function(input, output, session) {

batch_adjusted_matrix <- combat_batch_effect(filtered_score_matrix = filtered_score_matrix(),
batch = input$batch,
adj_var = input$adj_var,
adjustment_var = input$adj_var,
interest_var = input$interest_var)

})
output$batch_matrix_summary <- DT::renderDataTable({
matrix_summary_table(matrix_summary = summary(batch_adjusted_matrix()),
col_names = colnames(batch_adjusted_matrix()))
})

#Show the download button
observeEvent(batch_adjusted_matrix(), {
if(calculated_adjusted_matrix() == FALSE){
shinyjs::show(id = "downloadAdjustedMatrix")

calculated_adjusted_matrix(TRUE)
}

})

observeEvent(input$batch_effect_previous_tab,{
updateTabItems(session, "tabs", "corr_plot_tab")

header <- paste("Correlation Plot")
shinyjs::html("pageHeader", header)

})
observeEvent(input$batch_effect_next_tab,{
updateTabItems(session, "tabs", "batch_effect_plot_tab")

header <- paste("Batch Effect Plot")
shinyjs::html("pageHeader", header)

})

# Download Adjusted matrix ---------------------------------------------------------

#Download matrix as text file
output$downloadAdjustedMatrix <- downloadHandler(
filename = "adjusted_matrix_and_metadata.zip",

content = function(fname) {
#changing working directory to temp to save the files before zipping them
current_wd = getwd()
tempdir = tempdir()
setwd(tempdir)

write.table(batch_adjusted_matrix(),
"adjusted_data_matrix.tsv", row.names = FALSE, col.names = TRUE,
sep = "\t")

write.table(attr(batch_adjusted_matrix(), "meta"),
"matrix_metadata.tsv",
sep = "\t", row.names = FALSE, col.names = TRUE)

zip(zipfile = fname,files = c("adjusted_data_matrix.tsv", "matrix_metadata.tsv"))

setwd(current_wd)

}
)

# Plotting first matrix ---------------------------------------------------

#plot data
Expand All @@ -210,11 +263,16 @@ function(input, output, session) {

observeEvent(input$plot_matrix_previous_tab,{
updateTabItems(session, "tabs", "score_matrix_tab")

header <- paste("Calculate Score Matrix")
shinyjs::html("pageHeader", header)
})

observeEvent(input$plot_matrix_next_tab,{
updateTabItems(session, "tabs", "corr_plot_tab")

header <- paste("Correlation Plot")
shinyjs::html("pageHeader", header)
})

# Download first plot -----------------------------------------------------------
Expand Down Expand Up @@ -244,7 +302,6 @@ function(input, output, session) {
}
)


# Plotting matrix after batch effect --------------------------------------

#plotting the matrix after batch effect
Expand Down Expand Up @@ -302,7 +359,8 @@ function(input, output, session) {
epigenetic_mark = input$epigenetic_mark,
color_by = input$color_by,
first_pc = input$first_pc,
second_pc = input$second_pc)
second_pc = input$second_pc,
show_legend = FALSE)

second_plot <- plot_pca_labels(experiments_info_meta = experiments_info_meta(),
project = input$project,
Expand All @@ -318,7 +376,7 @@ function(input, output, session) {
})

})

# Plotting pie chart ------------------------------------------------------

observeEvent(filtered_score_matrix(),{
Expand Down
55 changes: 38 additions & 17 deletions app/ui.r
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
#New UI with shiny dashboard
library(plotly)
library(shiny)
library(shinyBS)
Expand All @@ -9,13 +10,13 @@ library(shinydashboard)
# Header ------------------------------------------------------------------
dashboardPage(title = "Batch Effect Analysis and Visualization",


dashboardHeader(
title = "Batch Effect Analysis",
title = "Batch Effect Analysis", titleWidth = 300,
tags$li(class = "dropdown",
# 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 All @@ -36,6 +37,16 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
# Log-in popup ------------------------------------------------------------
useShinyjs(),

tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div id="pageHeader" class="myClass"></div>\');
})
')),
tags$head(
# Include our custom CSS
includeCSS("../www/styles.css")
),

bsModal(id ="login_popup", title = "Log-in", trigger = "login",
#Having the textInput then the question mark next to it
div(
Expand Down Expand Up @@ -82,8 +93,16 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
# score matrix tab------------------------------------------------------------
tabItem(tabName = "score_matrix_tab",

tags$div(id = "score_matrix_tab_nav"),
# tags$div(id = "score_matrix_tab_nav"),

fluidRow(column(width = 12, offset = 10,
bsButton("score_matrix_previous_tab",label = "Previous", icon = icon("arrow-left"),
style = "default"),
bsButton("score_matrix_next_tab",label = "Next", icon = icon("arrow-right"),
style = "default")

)),
br(),
shinydashboard::box(collapsible = TRUE,
radioButtons("type_of_score", "Choose method to calculate scoring matrix",
choices = c("Tiling Regions" = "tiling",
Expand Down Expand Up @@ -129,7 +148,6 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
style = "default"),
bsButton("plot_matrix_next_tab",label = "Next", icon = icon("arrow-right"),
style = "default")

)),
br(),

Expand All @@ -152,18 +170,6 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
"HTML (Interactive)" = "html")),
downloadButton(outputId = "plot_down", label = "Download plot"))
)
# box(
# radioButtons("plot_down_exten", label = "Choose file extension",
# choices = c("PDF (static)" = "pdf",
# "HTML (Interactive)" = "html")),
# downloadButton(outputId = "plot_down", label = "Download plot")),
# box(collapsible = TRUE, title = "PC plot", status = "primary",
# solidHeader = TRUE, width = 12, collapsed = TRUE,
#
# actionButton("plot_btn", "Plot"),
# plotlyOutput('plot', width = "auto", height = "450px")
# )

),

# Correlation plot tab ----------------------------------------------------
Expand Down Expand Up @@ -226,7 +232,22 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
selectInput('batch', "Select a batch to adjust for",c("")),
selectInput("adj_var", "Adjustment Variable",c("")),
selectInput("interest_var", "Variable of interest", c(""))
)
),
conditionalPanel(
condition = "input.batch_effect_choice == 'sva'",

selectInput("adj_var", "Adjustment Variable",c("")),
selectInput("interest_var", "Variable of interest", c(""))
),
conditionalPanel(
condition = "input.batch_effect_choice == 'supervised_sva'",

selectInput('batch', "Select a batch to adjust for",c("")),
selectInput("adj_var", "Adjustment Variable",c("")),
selectInput("interest_var", "Variable of interest", c(""))
),
downloadButton("downloadAdjustedMatrix", "Download Data")


)
),
Expand Down
60 changes: 49 additions & 11 deletions functions/combat_batch_effect.r
View file
Original file line number Diff line number Diff line change
@@ -1,34 +1,72 @@
combat_batch_effect <- function(filtered_score_matrix, batch, adj_var, interest_var){
combat_batch_effect <- function(filtered_score_matrix,
batch,
adjustment_var,
interest_var){

if(adj_var == ""){adj_var = NULL}
if(interest_var == ""){interest_var = NULL}

# filtered_matrix <- filtered_score_matrix$data
metadata <- attr(filtered_score_matrix, "meta")
validate(
need(nlevels(as.factor(metadata[,batch])) > 1, message = paste(batch,"has less than 2 level",
"check levels using the pie chart"))
)
#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(as.factor(metadata[,adj_var])) > 1, message = paste(adj_var,"has less than 2 level",
"check levels using the pie chart"))
)
}
}

if(typeof(filtered_score_matrix) == "characte"){
print("It's a character matrix, needs to be converted to double")
if(interest_var == ""){
interest_var = NULL
}else{
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"))
)
validate(
need(nlevels(as.factor(metadata[,inter_var])) > 1, message = paste(inter_var,"has less than 2 level",
"check levels using the pie chart"))
)
}
}

#building the model matrix for ComBat
if(is.null(adj_var)){
if(is.null(adjustment_var)){
if(is.null(interest_var)){
#No adjustment and no interest vars
modcombat = model.matrix(~1, data = metadata)
}else{
modcombat = model.matrix(~as.factor(metadata$interest_var), data = metadata)
#No adjustment but interest vars
modcombat = model.matrix(as.formula(paste0("~", paste(interest_var, collapse = "+"))), data = metadata)
}
}else{
if(is.null(interest_var)){
modcombat = model.matrix(~as.factor(metadata$adj_var), data = metadata)
#No interest but adjustment vars
modcombat = model.matrix(as.formula(paste0("~", paste(adjustment_var, collapse = "+"))), data = metadata)
}else{
modcombat = model.matrix(~as.factor(metadata$adj_var)+as.factor(metadata$interest_var),
data = metadata)
#adjustment and interest vars
modcombat = model.matrix(as.formula(paste0("~", paste(
paste(interest_var, collapse = " + "),"+", paste(adjustment_var, collapse = " + ")
)
)),data = metadata)
}
}

batch_adjusted_matrix <- ComBat(dat=filtered_score_matrix,
batch=as.double(as.factor(metadata[,batch])),
mod=modcombat, par.prior=TRUE, prior.plots=FALSE)
mod=modcombat, par.prior=TRUE, prior.plots=FALSE)

attr(batch_adjusted_matrix, "meta") <- metadata

Expand Down
1 change: 0 additions & 1 deletion functions/plot_correlation.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ plot_correlation <- function(filtered_score_matrix,

}


arguments <- list(correlation_matrix,
order = "hclus",
title = plot_title,
Expand Down
11 changes: 8 additions & 3 deletions functions/plot_pca_labels.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@ plot_pca_labels <- function(experiments_info_meta,filtered_score_matrix,project,
first_pc="1", second_pc="2",
epigenetic_mark = "Not Selected",
legend_position = "right",
legend_direction = "vertical"){
legend_direction = "vertical",
show_legend = TRUE){

#calculating PCA
pca <- prcomp(filtered_score_matrix, center = TRUE, scale. = TRUE)
Expand All @@ -25,11 +26,11 @@ plot_pca_labels <- function(experiments_info_meta,filtered_score_matrix,project,
label <- "experiment"
}

ggplot(plot.data, aes_string(x = paste0("PC",first_pc),
plot <- ggplot(plot.data, aes_string(x = paste0("PC",first_pc),
y = paste0("PC",second_pc),
label = label,
color = color_by))+
geom_point(size = 5, alpha = 0.5) +
geom_point(size = 5, alpha = 0.5)+
# geom_label_repel(data = plot.data)+
theme_bw() +
ggtitle(paste("Tiling Regions", epigenetic_mark)) +
Expand All @@ -40,4 +41,8 @@ plot_pca_labels <- function(experiments_info_meta,filtered_score_matrix,project,
xlab(paste(paste0("PC", first_pc," ", "("), round(pca$sdev[as.integer(first_pc)]^2/sum(pca$sdev^2), 2) * 100, "%)")) +
ylab(paste(paste0("PC", second_pc," ", "("), round(pca$sdev[as.integer(second_pc)]^2/sum(pca$sdev^2), 2) * 100, "%)"))

if(show_legend){
return(plot)
}
return(plot + theme(legend.position = "none"))
}
Loading

0 comments on commit bb7881e

Please sign in to comment.