Skip to content

Commit

Permalink
new functions, layout and help pages within the app
Browse files Browse the repository at this point in the history
  • Loading branch information
@fdabbagh
fdabbagh committed Mar 31, 2018
1 parent 97577c3 commit 525e58b
Show file tree
Hide file tree
Showing 24 changed files with 615 additions and 144 deletions.
44 changes: 33 additions & 11 deletions app/server.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,10 @@
#27 Supervised SVA (use the method with the std of ranks) (Done I think)
#28 Add a place to choose outliers that can be used then in the RUV test and other tests (Done I think)
#29 Hide next buttong for Batch Effect tab until there's a batch effect matrix

#30 Show user the original number of rows of the raw matrix then the filtered one so they can change the cutt-off
#31 validate for the variation cuttoff not more than 1
#32 add a validate that user can't used houskeeping genes list for not gene expression
#Documentation in html using https://html-online.com/editor/ or https://html5-editor.net/

#Problems
# Can't use the std of ranks for the control on score matrix because they have some negative values
Expand Down Expand Up @@ -93,9 +96,15 @@ function(input, output, session) {
help_md <- markdown_pages[grep(input$tabs, markdown_pages)]

output$help_output <- renderUI({
includeMarkdown(file.path("..","help",help_md))
# includeMarkdown(file.path("..","help",help_md))
includeHTML(file.path("..","help",help_md))
})
})
# output$myImage <- renderImage({
#
# list(src = "../help/ezgif.com-gif-to-mp4.gif",
# contentType = 'image/gif')
# })
# logging in --------------------------------------------------------------

source(file.path("..","server","logging_in.r"), local = TRUE)
Expand Down Expand Up @@ -243,6 +252,7 @@ function(input, output, session) {
input$k_rank, sep = "-")]] <-

ruv_batch_effect(filtered_score_matrix = filtered_score_matrix(),
experiments = all_experiments()[[1]],
outliers = input$outliers,
project = input$project,
regularization_par = input$regularization_par,
Expand Down Expand Up @@ -283,15 +293,15 @@ function(input, output, session) {
observeEvent(input$batch_effect_previous_tab,{
updateTabItems(session, "tabs", "corr_plot_tab")

header <- paste("Correlation Plot")
shinyjs::html("pageHeader", header)
# 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)
# header <- paste("Batch Effect Plot")
# shinyjs::html("pageHeader", header)

})

Expand Down Expand Up @@ -330,7 +340,8 @@ function(input, output, session) {

plotly_pca <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = filtered_score_matrix(),
name = "Raw Matrix",
name = paste("Raw Matrix", input$epigenetic_mark,
input$project),
project = input$project,
type_of_score = input$type_of_score,
color_by = input$color_by,
Expand Down Expand Up @@ -360,16 +371,16 @@ function(input, output, session) {
# }else{
updateTabItems(session, "tabs", "score_matrix_tab")

header <- paste("Calculate Score Matrix")
shinyjs::html("pageHeader", header)
# 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)
# header <- paste("Correlation Plot")
# shinyjs::html("pageHeader", header)
})

# Download first plot -----------------------------------------------------------
Expand Down Expand Up @@ -461,6 +472,7 @@ function(input, output, session) {
p1 <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = filtered_score_matrix(),
project = input$project,
name = "Raw Matrix",
type_of_score = input$type_of_score,
color_by = input$color_by,
epigenetic_mark = input$epigenetic_mark,
Expand All @@ -471,6 +483,7 @@ function(input, output, session) {
p2 <- plotly_pca(experiments_info_meta = experiments_info_meta(),
filtered_score_matrix = batch_adjusted_matrix()[[input$corrected_matrices]],
project = input$project,
name = input$corrected_matrices,
type_of_score = input$type_of_score,
color_by = input$color_by_batch,
epigenetic_mark = input$epigenetic_mark,
Expand Down Expand Up @@ -501,5 +514,14 @@ function(input, output, session) {
updateTabItems(session, "tabs", "batch_effect_tab")

})

# Extra Stuff ------------------------------------------------------

#Updating the pageHeader according to which tab we're on
#tab_panel_header just returns the tab name using the tab i
observeEvent(input$tabs,{
# browser()
header <- paste(tab_panel_header(tab_panel = input$tabs))
shinyjs::html("pageHeader", header)
})
}
93 changes: 75 additions & 18 deletions app/ui.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
)
),


# Sidebar items -----------------------------------------------------------

dashboardSidebar(
Expand All @@ -40,7 +41,21 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
dashboardBody(
# Log-in popup ------------------------------------------------------------
useShinyjs(),
#
# #help modal style
# tags$style(".modal-content {background-color:#ECEFF4;}
# .modal-header {padding: 10px 16px;
# background-color: #3C8DBC;
# color: white;}"),

# #Login modal style
# tags$style("#login_popup .modal-header {padding: 10px 16px;
# background-colo: #3C8DBC;}"),

#help modal style
tags$style(".modal-header {padding: 12px 16px;
background-color: #3C8DBC;
color: white;}"),
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div id="pageHeader" class="myClass"></div>\');
Expand All @@ -62,7 +77,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
style="display:inline-block; vertical-align: middle;",
#The ? buttong and the popover that will come up from clicking
bsButton("user_key_info",label = "", icon = icon("question"), style = "default", size = "extra-small"),
bsPopover("user_key_info", title = "info", content = "You can login with your user key, or stay anonymous",
bsPopover("user_key_info", title = "info", content = "You can login with your user key, or stay anonymous using anonymous_key",
placement = "right", trigger = "focus")
)
),
Expand All @@ -74,6 +89,10 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
bsModal(id="help_page", title = "Help!", trigger = "info",
#In Server I will check which tab is it and output the html
#of the help part of that tab
# htmlOutput("help_output"),
# #Cats Cat
# imageOutput("myImage"),
#
uiOutput("help_output"),
size = "large"

Expand All @@ -87,7 +106,13 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",

tags$div(id = 'login_warning',

HTML('<br></br><p><font size = "4" color = black> Please Log-in first, so you can list experiments </font></p>')
HTML('<br>
</br>
<p>
<font size = "5" color = black> Please Log-in first, you can use the key "anonymous_key"
or your own key in case you were registered.<br /> You can also register
<a target="_blank" href="http://deepblue.mpi-inf.mpg.de/register.php"> here</a>
</font></p>')

),
tags$div(id = 'addOptions'),
Expand All @@ -114,7 +139,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",

)),
br(),
shinydashboard::box(collapsible = TRUE,
shinydashboard::box(collapsible = TRUE,width = 8,
radioButtons("type_of_score", "Choose method to calculate scoring matrix",
choices = c("Tiling Regions" = "tiling",
"Annotations" = "annotation")),
Expand All @@ -131,11 +156,13 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
selected = "5000")),
selectInput('chr', 'Select a Chromosome, or leave empty for the whole genome', c(""), multiple = TRUE),
# tags$div(id = 'addChromosomes'),
actionButton("show_input_check", "Calculate Score matrix")
fluidRow(column(width = 8, offset = 9,
actionButton("show_input_check", "Calculate Score matrix"),
style = "default"))

),

shinydashboard::box(collapsible = TRUE,
shinydashboard::box(collapsible = TRUE,width = 4,

selectInput('aggregation', "Select Aggregation function",
c("min", "max", "sum", "mean", "var", "sd", "median", "count", "boolean"),
Expand All @@ -149,12 +176,14 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
numericInput("variance","row variation cutoff", value = "0.05")

),

downloadButton("downloadMatrix", "Download Data")
fluidRow(column(width = 4,offset = 6,
downloadButton("downloadMatrix", "Download Data"),
style = "default"))

),
bsModal(id ="input_check", title = "Input Check", trigger = "show_input_check",
textOutput(outputId = "warning_message"),
# uiOutput(outputID = " warning_message"),
actionButton("calculate_matrix", "Continue!")
),

Expand Down Expand Up @@ -261,9 +290,12 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
fluidPage(
selectInput("key_pie", "Select Key to check the value distribution", c("")),
plotlyOutput("batch_pie_plot", width = "auto", height = "auto"))),
br(),br(),
# br(),br(),
selectInput("corrected_matrices", "Batch Corrected Matrices", choices = NULL),
actionButton("calculate_batch_matrix", "Adjust matrix")
fluidRow(column(width = 6, offset = 6),
actionButton("calculate_batch_matrix", "Adjust matrix"),
style = "default")
# actionButton("calculate_batch_matrix", "Adjust matrix")
),
shinydashboard::box(width = 6,
conditionalPanel(
Expand Down Expand Up @@ -292,9 +324,31 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
numericInput("regularization_par",
"Regularization parameter for the unwanted variation (nu.coeff)", value = 0.00001),

radioButtons("house_keeping_genes", "Method to estimate House Keeping Genes",
choices = c("Estimate using rank analysis" = "estimate_hkg",
"Use a predefined list" = "use_hkg_list")),
# radioButtons("house_keeping_genes", "Method to estimate House Keeping Genes",
# choices = c("Estimate using rank analysis" = "estimate_hkg",
# "Use a predefined list" = "use_hkg_list")),
#This html is generated from the previous radiobuttons function
#I just wanted to have a href there and I tweaked the raw html and re-introduced it
div(
HTML('<div id="house_keeping_genes" class="form-group shiny-input-radiogroup shiny-input-container">
<label class="control-label" for="house_keeping_genes">Method to estimate House Keeping Genes</label>
<div class="shiny-options-group">
<div class="radio">
<label>
<input type="radio" name="house_keeping_genes" value="estimate_hkg" checked="checked"/>
<span>Estimate using rank analysis</span>
</label>
</div>
<div class="radio">
<label>
<input type="radio" name="house_keeping_genes" value="use_hkg_list"/>
<span>Use a predefined <a href="https://www.nanostring.com/application/files/7014/8943/0117/TN_Normalization_of_Expression_Data.pdf" target="_blank" rel="noopener">list</a></span>
</label>
</div>
</div>
</div>')
),


conditionalPanel(
condition = "input.house_keeping_genes == 'estimate_hkg'",
Expand All @@ -305,13 +359,16 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",

numericInput("quantile_prob",
"Quantile probability used in the rank analysis estimation [0,1]",
value = 0.005, min = 0, max = 1),

numericInput("k_rank", "Desired rank for the estimated unwanted variation term",
value = 5)
)
value = 0.005, min = 0, max = 1)

),

numericInput("k_rank", "Desired rank for the estimated unwanted variation term",
value = 5)
),
downloadButton("downloadAdjustedMatrix", "Download Data")
fluidRow(column(width = 6, offset = 6),
downloadButton("downloadAdjustedMatrix", "Download Data"),
style = "default")
)
),

Expand Down
13 changes: 5 additions & 8 deletions functions/combat_batch_effect.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,14 +5,13 @@ combat_batch_effect <- function(filtered_score_matrix,
project,
interest_var){


if(project == "TEPIC reprocessed IHEC data"){
outliers <- unique(c(outliers,"R_ENCBS150HBC_ENCBS376RZJ",
"R_ENCBS559QNR_ENCBS568FYY_ENCBS945MCY",
"R_ENCBS853LFM","E_520VFV"))
}
# filtered_matrix <- filtered_score_matrix$data
metadata <- attr(filtered_score_matrix, "meta")
metadata <- as.data.frame(attr(filtered_score_matrix, "meta"))

validate(
need(!anyNA(metadata[,batch]), message = paste(batch, "has NAs and cannot be used in combat")),
Expand All @@ -23,12 +22,11 @@ combat_batch_effect <- function(filtered_score_matrix,

row_sum<-apply(filtered_score_matrix,1,sum)
if(!length(which(row_sum == 0)) == 0){
filtered_score_matrix<-filtered_score_matrix[-which(row_sum==0),]
filtered_score_matrix<-filtered_score_matrix[!(row_sum == 0),]
}
if(outliers != ""){
filtered_score_matrix <- filtered_score_matrix[,-match(outliers,colnames(filtered_score_matrix))]
metadata <- metadata[-match(outliers, metadata[,"experiment"]),]

if(length(outliers) != 0){
filtered_score_matrix <- filtered_score_matrix[,!(colnames(filtered_score_matrix) %in% outliers)]
metadata <- metadata[!(colnames(filtered_score_matrix) %in% outliers),]
}

#validation of the inptus
Expand Down Expand Up @@ -94,7 +92,6 @@ combat_batch_effect <- function(filtered_score_matrix,
)
})


attr(batch_adjusted_matrix, "meta") <- metadata

return(batch_adjusted_matrix)
Expand Down
12 changes: 6 additions & 6 deletions functions/inserted_ui.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,19 +26,19 @@ inserted_ui <- function(user_key,user_name,echo, id, genomes) {
ui = tags$div(

id = id,
shinydashboard::box(collapsible = TRUE,

shinydashboard::box(collapsible = TRUE,width = 9,
selectInput('genome', "Select Genome",
c(genomes$name)),

selectInput('project', 'Select Project',choices = ""),
selectInput('epigenetic_mark', 'Select a Data Type',
c("","Gene Expression",deepblue_list_epigenetic_marks(user_key = user_key)$name),
multiple = F),

actionButton('list_exper_btn', "List Experiments"),

checkboxInput("filter_coverage", "Filter coverage files", TRUE)
fluidRow(column(width = 9, offset = 9,
checkboxInput("filter_coverage", "Filter coverage files", TRUE),
actionButton('list_exper_btn', "List Experiments"),
style = "default"))
)
)
)
Expand Down
Loading

0 comments on commit 525e58b

Please sign in to comment.