diff --git a/app/server.r b/app/server.r index dcd5aaf..b5608d5 100644 --- a/app/server.r +++ b/app/server.r @@ -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) @@ -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")) @@ -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 @@ -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 ----------------------------------------------------------- @@ -244,7 +302,6 @@ function(input, output, session) { } ) - # Plotting matrix after batch effect -------------------------------------- #plotting the matrix after batch effect @@ -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, @@ -318,7 +376,7 @@ function(input, output, session) { }) }) - + # Plotting pie chart ------------------------------------------------------ observeEvent(filtered_score_matrix(),{ diff --git a/app/ui.r b/app/ui.r index 7a93a76..ca6cce9 100644 --- a/app/ui.r +++ b/app/ui.r @@ -1,3 +1,4 @@ +#New UI with shiny dashboard library(plotly) library(shiny) library(shinyBS) @@ -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 ----------------------------------------------------------- @@ -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(\'\'); + }) + ')), + 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( @@ -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", @@ -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(), @@ -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 ---------------------------------------------------- @@ -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") + ) ), diff --git a/functions/combat_batch_effect.r b/functions/combat_batch_effect.r index 40eb930..89f2d2f 100644 --- a/functions/combat_batch_effect.r +++ b/functions/combat_batch_effect.r @@ -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 diff --git a/functions/plot_correlation.r b/functions/plot_correlation.r index 23ba3a8..c6a41de 100644 --- a/functions/plot_correlation.r +++ b/functions/plot_correlation.r @@ -13,7 +13,6 @@ plot_correlation <- function(filtered_score_matrix, } - arguments <- list(correlation_matrix, order = "hclus", title = plot_title, diff --git a/functions/plot_pca_labels.r b/functions/plot_pca_labels.r index f6294ed..d2d8297 100644 --- a/functions/plot_pca_labels.r +++ b/functions/plot_pca_labels.r @@ -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) @@ -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)) + @@ -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")) } \ No newline at end of file diff --git a/functions/sva_batch_effect.r b/functions/sva_batch_effect.r new file mode 100644 index 0000000..33b4f5e --- /dev/null +++ b/functions/sva_batch_effect.r @@ -0,0 +1,67 @@ +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 to make 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)){ + 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) +} \ No newline at end of file diff --git a/server/calculate_score_matrix.r b/server/calculate_score_matrix.r index 2755be9..bf83b87 100644 --- a/server/calculate_score_matrix.r +++ b/server/calculate_score_matrix.r @@ -47,18 +47,18 @@ observeEvent(filtered_score_matrix(),{ if(calculated_matrix() == FALSE){ shinyjs::show(id = "downloadMatrix") - insertUI(selector = "#score_matrix_tab_nav", where = "beforeBegin", - ui = tags$div(id = "inserted_nav_score_matrix", - 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() - )) - + # insertUI(selector = "#score_matrix_tab_nav", where = "beforeBegin", + # ui = tags$div(id = "inserted_nav_score_matrix", + # 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() + # )) + shinyjs::show(id = "score_matrix_next_tab") calculated_matrix(TRUE) } }) @@ -67,10 +67,16 @@ observeEvent(filtered_score_matrix(),{ observeEvent(input$score_matrix_previous_tab,{ updateTabItems(session, "tabs", "list_experiments_tab") + header <- paste("List Experiments") + shinyjs::html("pageHeader", header) + }) observeEvent(input$score_matrix_next_tab,{ updateTabItems(session, "tabs", "plot_matrix_tab") + header <- paste("Plotting PCA") + shinyjs::html("pageHeader", header) + }) # Download matrix --------------------------------------------------------- diff --git a/server/correlation_plot.r b/server/correlation_plot.r index eb65141..969565e 100644 --- a/server/correlation_plot.r +++ b/server/correlation_plot.r @@ -18,7 +18,6 @@ observeEvent(input$plot_corr,{ }) - #Corr plot download handler output$corr_plot_down <- downloadHandler( filename = function() { @@ -44,8 +43,14 @@ output$corr_plot_down <- downloadHandler( observeEvent(input$corr_plot_previous_tab,{ updateTabItems(session, "tabs", "plot_matrix_tab") + header <- paste("Plotting PCA") + shinyjs::html("pageHeader", header) + }) observeEvent(input$corr_plot_next_tab,{ updateTabItems(session, "tabs", "batch_effect_tab") + header <- paste("Calculating Batch Effect") + shinyjs::html("pageHeader", header) + }) diff --git a/server/listing_experiments.r b/server/listing_experiments.r index 8e5d114..18ec7cb 100644 --- a/server/listing_experiments.r +++ b/server/listing_experiments.r @@ -25,7 +25,6 @@ observeEvent(all_experiments(),{ fluidRow(column(width = 12, offset = 11, bsButton("list_experiments_next_tab",label = "Next", icon = icon("arrow-right"), style = "default") - )), br() ) @@ -60,4 +59,6 @@ output$table <- DT::renderDataTable({ observeEvent(input$list_experiments_next_tab,{ updateTabItems(session, "tabs", "score_matrix_tab") + header <- paste("Calculate Score Matrix") + shinyjs::html("pageHeader", header) }) diff --git a/server/listing_genomes.r b/server/listing_genomes.r index e2fc188..a64dd24 100644 --- a/server/listing_genomes.r +++ b/server/listing_genomes.r @@ -14,4 +14,6 @@ observeEvent(input$genome, { updateSelectInput(session, inputId = 'chr', choices = c("",deepblue_info(id = genomes$id[grep(input$genome, genomes$name)], user_key = user_key)$chromosomes$name)) + + }) \ No newline at end of file diff --git a/server/logging_in.r b/server/logging_in.r index 857eae9..1a4f0d6 100644 --- a/server/logging_in.r +++ b/server/logging_in.r @@ -53,6 +53,10 @@ observeEvent(input$log_in_btn, { updateTabItems(session, "tabs", "list_experiments_tab") + header <- paste("Listing Experiments") + shinyjs::html("pageHeader", header) + + #Used to check if the experiments and matrix has been listed in order to add the nav buttons #This will be changed to TRUE once the experiments or matrix are listed, so in case the user #lists other experiments or matrices it stays true and it won't add other nav buttons @@ -60,6 +64,9 @@ observeEvent(input$log_in_btn, { calculated_matrix(FALSE) shinyjs::hide(id = "downloadMatrix") + shinyjs::hide(id = "downloadAdjustedMatrix") + shinyjs::hide(id = "score_matrix_next_tab") + }) diff --git a/www/styles.css b/www/styles.css new file mode 100644 index 0000000..cf1ed9a --- /dev/null +++ b/www/styles.css @@ -0,0 +1,24 @@ +.myClass { +line-height: 50px; +text-align: left; +font-family: "Georgia", Times, "Times New Roman", serif; +padding: 0 15px; +color: white; +font-size: 2vw; + } +@media (min-width: 1200px) { + .myClass { + line-height: 50px; + text-align: left; + font-family: "Georgia", Times, "Times New Roman", serif; + padding: 0 15px; + color: white; + font-size: x-large + } +} + +.main-header .logo { + font-family: "Georgia", Times, "Times New Roman", serif; + font-weight: bold; + font-size: 24px; +}