output$DP_sidebar_FilterTab1 <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)){return()}
filter <- NULL
tag <- rv$current.obj@experimentData@other$mvFilter.method
if (!is.null(tag)) { filter <- tag}
tagList(
h4("Missing values filtering options")
,hr()
,radioButtons("ChooseFilters","",
choices = gFiltersList,
selected = filter)
,conditionalPanel(
condition='input.ChooseFilters != "None"',
uiOutput("seuilNADelete"))
,actionButton("perform.filtering.MV",
"Perform filtering MV")
)
})
output$DP_sidebar_FilterTab2 <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)){return()}
tagList(
h4("String based filtering options")
,hr()
,h4("Filter contaminants"),
uiOutput("id_Contaminants"),
uiOutput("choosePrefixContaminants"),
br(),
h4("Filter reverse"),
uiOutput("id_Reverse"),
uiOutput("choosePrefixReverse"),
br(),
actionButton("perform.filtering.Contaminants",
"Perform string based filtering")
)
})
output$DP_sidebar_FilterTab3 <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)){return()}
tagList(
h4("Filtered data display")
,hr()
,radioButtons("ChooseTabAfterFiltering",
"Choose the data to display",
choices=
list("Quantitative data" = "quantiData",
"Meta data" = "MetaData"))
,radioButtons("ChooseViewAfterFiltering",
"Choose the type of filtered data",
choices=
list("Deleted on missing values" = "MissingValues",
"Deleted contaminants" = "Contaminants",
"Deleted reverse" = "Reverse"))
,br(),br()
,checkboxInput("nDigitsMV",
"Show full length intensities"
, value = FALSE)
)
})
#----------------------------------------------
output$VizualizeFilteredData <- DT::renderDataTable({
rv$current.obj
input$nDigitsMV
input$ChooseViewAfterFiltering
input$ChooseTabAfterFiltering
if (is.null(input$ChooseTabAfterFiltering)
||is.null(input$ChooseViewAfterFiltering)
||is.null(input$nDigitsMV)
||(is.null(rv$current.obj))) {return()}
if (is.null(input$nDigitsMV)){nDigits = 1e100}
else {nDigitsMV = 3}
data <- NULL
if ((input$ChooseViewAfterFiltering == "MissingValues")
&& !is.null(rv$deleted.mvLines))
{
obj <- rv$deleted.mvLines
if(input$ChooseTabAfterFiltering == "quantiData" )
{
data <- cbind(ID = rownames(Biobase::fData(obj)),
round(Biobase::exprs(obj), digits=nDigitsMV))
}else {data <- cbind(ID = rownames(Biobase::fData(obj)),
Biobase::fData(obj))}
} else if ((input$ChooseViewAfterFiltering == "Contaminants")
&& !is.null(rv$deleted.contaminants)) {
obj <- rv$deleted.contaminants
if(input$ChooseTabAfterFiltering == "quantiData" )
{data <- cbind(ID = rownames(Biobase::fData(obj)),
round(Biobase::exprs(obj), digits=nDigitsMV))
}else {data <- cbind(ID = rownames(Biobase::fData(obj)),
Biobase::fData(obj))}
} else if ((input$ChooseViewAfterFiltering == "Reverse")
&& !is.null(rv$deleted.reverse)){
obj <- rv$deleted.reverse
if(input$ChooseTabAfterFiltering == "quantiData" )
{data <- cbind(ID = rownames(Biobase::fData(obj)),
round(Biobase::exprs(obj), digits=nDigitsMV))
}else {data <- cbind(ID = rownames(Biobase::fData(obj)),
Biobase::fData(obj))}
}
#if (!is.null(data)){
DT::datatable(data,
options=list(pageLength=DT_pagelength,
orderClasses = TRUE,
autoWidth=FALSE)
)
#dat
#}
})
#########################################################
##' Show the widget (slider input) for filtering
##' @author Samuel Wieczorek
output$seuilNADelete <- renderUI({
input$ChooseFilters
if (is.null(rv$current.obj)) {return(NULL) }
if (input$ChooseFilters==gFilterNone) {return(NULL) }
choix <- list()
vMax <- GetMaxValueThresholdFilter()
choix[[1]] <- 0
for (i in 2:(vMax+1)){
choix[[i]] <- i-1
}
ch <- NULL
tag <- rv$current.obj@experimentData@other$mvFilter.threshold
if (!is.null(tag)) { ch <- tag}
else {ch <- choix[[1]]}
selectInput("seuilNA",
"Keep lines with at least x intensity values",
choices = choix,
selected = ch)
})
output$GlobalPieChart <- renderPlot({
rv$current.obj
input$idBoxContaminants
input$idBoxReverse
input$prefixReverse
input$prefixContaminants
if (is.null(rv$current.obj)) {return()}
p <- rep("",4)
if (is.null(input$idBoxContaminants)) {p[1] <- ""}
else {p[1] <-input$idBoxContaminants}
if (is.null(input$idBoxReverse)) {p[2] <- ""}
else {p[2] <-input$idBoxReverse}
if (is.null(input$prefixContaminants)) {p[3] <- ""}
else {p[3] <-input$prefixContaminants}
if (is.null(input$prefixReverse)) {p[4] <- ""}
else {p[4] <-input$prefixReverse}
result = tryCatch(
{
proportionConRev(rv$current.obj,p[1], p[3], p[2],p[4])
}
#, warning = function(w) {
# shinyjs::info(conditionMessage(w))
#}
, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
})
#########################################################
UpdateFilterWidgets <- function(){
isolate({
rv$current.obj
if (length(rv$current.obj@processingData@processing) > 0){
val <- match (gReplaceAllZeros ,
rv$current.obj@processingData@processing)
updateCheckboxInput(session, "replaceAllZeros",value=val)
val <- match (gLogTransform,
rv$current.obj@processingData@processing)
#updateCheckboxInput(session,"log2transform",value=val)
r <- grep(pattern = gFilterTextPrefix,
rv$current.obj@processingData@processing,
fixed=TRUE, value=FALSE)
if ( length(r) > 0)
{
listMots <- unlist(strsplit(
rv$current.obj@processingData@processing[r], split=" "))
updateSliderInput(session,
inputId = "seuilNA",
value = listMots[6])
updateRadioButtons(session,
inputId = "ChooseFilters",
selected = listMots[3])
}
else
{
updateRadioButtons(session,
inputId = "ChooseFilters",
selected = gFilterNone)
}
}
else{
updateCheckboxInput(session, "replaceAllZeros",value=F)
updateRadioButtons(session,
inputId = "ChooseFilters",
selected = gFilterNone)
}
updateSelectInput(session,"typeImputation",selected= c("none"))
updateSelectInput(session, "normalization.family",selected = c("None"))
})
}
######################################
##' Function to compute the maximum value for the filter
##' @author Samuel Wieczorek
GetMaxValueThresholdFilter <- function(){
input$ChooseFilters
vMax <- 0
result = tryCatch(
{
isolate({
if (input$ChooseFilters == gFilterWholeMat) {
vMax <- ncol(Biobase::exprs(rv$current.obj))}
else if (input$ChooseFilters == gFilterAllCond
|| input$ChooseFilters == gFilterOneCond){
ll <- NULL
for (i in 1:length(unique(Biobase::pData(rv$current.obj)$Label))){
ll <- c(ll, length(which(
Biobase::pData(rv$current.obj)$Label==
unique(Biobase::pData(rv$current.obj)$Label)[i])))
}
vMax <- min(ll)
}
return(vMax)
})
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
}
## Perform missing values filtering
observeEvent(input$perform.filtering.MV,{
if (is.null(input$perform.filtering.MV) ){return()}
if (input$perform.filtering.MV == 0){return()}
isolate({
result = tryCatch(
{
if (input$ChooseFilters == gFilterNone){
rv$current.obj <- rv$dataset[[input$datasets]]
} else {
keepThat <- mvFilterGetIndices(rv$dataset[[input$datasets]],
input$ChooseFilters,
as.integer(input$seuilNA))
if (!is.null(keepThat))
{
rv$deleted.mvLines <-
rv$dataset[[input$datasets]][-keepThat]
rv$current.obj <-
mvFilterFromIndices(rv$dataset[[input$datasets]],
keepThat,
GetFilterText(input$ChooseFilters,
as.integer(input$seuilNA)))
#write command log
# l <- paste(keepThat,",", collapse="")
# writeToCommandLogFile(
# paste("keepThat <- ",
# findSequences(keepThat),
# sep="")
# )
writeToCommandLogFile(
paste("keepThat <- mvFilterGetIndices(dataset[['",
input$datasets,
"']], '",
input$ChooseFilters, "', '",
input$seuilNA, "')", sep="")
)
writeToCommandLogFile(
"deleted.mv <- current.obj[-keepThat]")
writeToCommandLogFile(paste("txt <- '",
GetFilterText(input$ChooseFilters,
input$seuilNA),
"'",
sep ="")
)
writeToCommandLogFile(
paste("current.obj <- mvFilterFromIndices(",
"current.obj, keepThat, '",
GetFilterText(input$ChooseFilters,
input$seuilNA),
"')",
sep ="")
)
}
updateSelectInput(session, "ChooseFilters",
selected = input$ChooseFilters)
updateSelectInput(session, "seuilNA",
selected = input$seuilNA)
}
}
#, warning = function(w) {
# shinyjs::info(conditionMessage(w))
#}
, error = function(e) {
shinyjs::info(paste("Perform missing values filtering",":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
})
})
observeEvent(input$perform.filtering.Contaminants,{
if (is.null(input$perform.filtering.Contaminants) ){return()}
if (input$perform.filtering.Contaminants == 0){return()}
isolate({
result = tryCatch(
{
temp <- rv$current.obj
if (!is.null(input$idBoxContaminants)
|| (input$idBoxContaminants != "")) {
ind <- getIndicesOfLinesToRemove(temp,
input$idBoxContaminants,
input$prefixContaminants)
if (!is.null(ind)){
if (length(ind) > 0) {
rv$deleted.contaminants <- temp[ind]
temp <- deleteLinesFromIndices(temp, ind,
paste("\"",
length(ind),
" contaminants were removed from dataset.\"",
sep="")
)
#write command log
writeToCommandLogFile(
paste(
"indContaminants <- getIndicesOfLinesToRemove(current.obj,\"",
input$idBoxContaminants,
"\", \"",input$prefixContaminants,"\")",
sep="")
)
writeToCommandLogFile(
"deleted.contaminants <- current.obj[indContaminants]")
writeToCommandLogFile(
paste("txt <- \"",length(ind),
" contaminants were removed from dataset.\"",sep=""))
writeToCommandLogFile(
"current.obj <- deleteLinesFromIndices(current.obj, indContaminants, txt)")
}
}
}
if (!is.null(input$idBoxReverse)
|| (input$idBoxReverse != "")){
ind <- getIndicesOfLinesToRemove(temp,
input$idBoxReverse,
input$prefixReverse)
if (!is.null(ind)){
if(length(ind) >0) {
rv$deleted.reverse <- temp[ind]
temp <- deleteLinesFromIndices(
temp, ind,
paste(length(ind),
" reverse were removed from dataset",
sep="")
)
writeToCommandLogFile(
paste("indReverse <- getIndicesOfLinesToRemove(current.obj, \"",
input$idBoxReverse,
"\", \"",input$prefixReverse,"\")",sep="")
)
writeToCommandLogFile("deleted.reverse <- current.obj[indReverse]")
writeToCommandLogFile(
paste("txt <- \"",length(ind)," reverse were removed from dataset.\"",sep=""))
writeToCommandLogFile(
"current.obj <- deleteLinesFromIndices(current.obj, indReverse, txt)")
}
}
}
rv$current.obj <- temp
updateSelectInput(session,
"idBoxReverse",
selected = input$idBoxReverse)
updateSelectInput(session,
"idBoxContaminants",
selected = input$idBoxContaminants)
updateSelectInput(session,
"prefixContaminants",
selected = input$prefixContaminants)
updateSelectInput(session,
"prefixReverse",
selected = input$prefixReverse)
updateTabsetPanel(session,
"tabFilter",
selected = "FilterContaminants")
}
#, warning = function(w) {
# shinyjs::info(conditionMessage(w))
# }
, error = function(e) {
shinyjs::info(paste("Perform contaminants filtering",":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
})
})
#########################################################
##' Validation of the filters and modification on current object
##' @author Samuel Wieczorek
observeEvent(input$ValidateFilters,{
if(is.null(input$ChooseFilters) || (input$ValidateFilters == 0))
{return(NULL)}
if(is.null(rv$current.obj)) {return(NULL)}
isolate({
result = tryCatch(
{
if((input$ChooseFilters != gFilterNone)
|| !is.null(input$idBoxContaminants)
|| !is.null(input$idBoxReverse)){
rv$typeOfDataset <- rv$current.obj@experimentData@other$typeOfData
name <- paste ("Filtered", " - ", rv$typeOfDataset, sep="")
rv$dataset[[name]] <- rv$current.obj
###### write to commandLog File
writeToCommandLogFile(
paste("dataset[['",name, "']] <- current.obj", sep=""))
###### end write to command log file
updateSelectInput(session, "datasets",
paste("Dataset versions of",
rv$current.obj.name, sep=" "),
choices = names(rv$dataset),
selected = name)
txtFilterMV <- paste("Filtering :",
GetFilterText(input$ChooseFilters,
input$seuilNA),
sep="")
txt <- paste(txtFilterMV, "Contaminants deleted",
"Reverse deleted",
sep=" ")
UpdateLog(txt,name)
}
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste("Validate filters",":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
})
})
output$choosePrefixContaminants <- renderUI({
rv$current.obj
input$idBoxContaminants
if (is.null(rv$current.obj)) {return(NULL) }
if (is.null(input$idBoxContaminants)) {return(NULL) }
textInput("prefixContaminants", label = "Choose prefix",value = "")
})
output$choosePrefixReverse <- renderUI({
rv$current.obj
input$idBoxReverse
if (is.null(rv$current.obj)) {return(NULL) }
if (is.null(input$idBoxReverse)) {return(NULL) }
textInput("prefixReverse", label = "Choose prefix", value = "" )
})
output$id_Contaminants <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL) }
.choices <- c("",colnames(Biobase::fData(rv$current.obj)))
names(.choices) <- c("",colnames(Biobase::fData(rv$current.obj)))
selectInput("idBoxContaminants",
label = "Choose column",
choices = .choices ,
selected = NULL)
})
output$id_Reverse <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL) }
.choices <- c("",colnames(Biobase::fData(rv$current.obj)))
names(.choices) <- c("",colnames(Biobase::fData(rv$current.obj)))
selectInput("idBoxReverse",
label = "Choose column",
choices = .choices ,
selected = NULL)
})
#########################################################
##' Show the widget for filters
##' @author Samuel Wieczorek
output$choixFiltres <- renderUI({
input$file
if (is.null(input$file)) {return(NULL)}
rv$current.obj
radioButtons("ChooseFilters","Filtering options",choices = gFiltersList)
})
output$helpTextMV <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL)}
helpText("After checking the data, validate the filters.")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.