output$MVI_options <- renderUI({
rv$current.obj
if (is.null(rv$current.obj) ) {return (NULL)}
if (is.null(input$missing.value.algorithm)){return (NULL)}
if (input$missing.value.algorithm == "imp4p"){
tagList(
h4("imp4p options"),
numericInput("imp4p_nbiter", "Number of iterations", value = 10, step=1, min=1),
checkboxInput("imp4p_withLapala", "with Lapala", value = FALSE)
)
}
})
output$imp4pLAPALA_distribution_option <- renderUI({
rv$current.obj
input$missing.value.algorithm
input$imp4p_withLapala
if (is.null(input$imp4p_withLapala) ) {return (NULL)}
if (is.null(rv$current.obj) ) {return (NULL)}
if (is.null(input$missing.value.algorithm)){return (NULL)}
if ((input$missing.value.algorithm == "imp4p") && (input$imp4p_withLapala == TRUE)){
radioButtons("imp4pLAPALA_distrib", "Distribution type", choices = c("uniform" = "unif", "beta" = "beta"))
}
})
#
# output$OnlyLAPALA_distribution_option <- renderUI({
# rv$current.obj
# input$missing.value.basic.algorithm
# input$missing.value.algorithm
# if (is.null(rv$current.obj) ) {return (NULL)}
# if (is.null(input$missing.value.algorithm) || is.null(input$missing.value.basic.algorithm)){return (NULL)}
#
# if ((input$missing.value.algorithm == "Basic methods") && (input$missing.value.basic.algorithm == "dummy censored")){
# radioButtons("OnlyLAPALA_distrib", "Distribution type", choices = c("unif" = "unif", "beta" = "beta"))
# }
#
# })
#
# output$OnlyLAPALA_qmin_option <- renderUI({
# rv$current.obj
# input$missing.value.basic.algorithm
# input$missing.value.algorithm
# if (is.null(rv$current.obj) ) {return (NULL)}
# if (is.null(input$missing.value.algorithm) || is.null(input$missing.value.basic.algorithm)){return (NULL)}
#
# if ((input$missing.value.algorithm == "Basic methods") && (input$missing.value.basic.algorithm == "dummy censored")){
# numericInput("OnlyLAPALA_qmin", "Upper LAPALA bound", value = 2.5, step=0.1, min=0, max=100)
# }
#
# })
output$MVI_qmin_option <- renderUI({
rv$current.obj
if (is.null(rv$current.obj) ) {return (NULL)}
if (is.null(input$missing.value.algorithm)){return (NULL)}
if (is.null(input$imp4p_withLapala)){return(NULL)}
if ((input$missing.value.algorithm == "imp4p") && (input$imp4p_withLapala==TRUE)){
numericInput("imp4p_qmin", "Upper lapala bound", value = 2.5, step=0.1, min=0, max=100)
}
})
#
#------------------------------------------
##' Missing values imputation - reactivity behavior
##' @author Samuel Wieczorek
observeEvent(input$perform.imputation.button,{
input$missing.value.algorithm
input$missing.value.basic.algorithm
input$imp4p_withLapala
input$OnlyLAPALA_qmin
input$OnlyLAPALA_distrib
input$imp4pLAPALA_distrib
isolate({
result = tryCatch(
{
if (input$missing.value.algorithm == "None"){
rv$current.obj <- rv$dataset[[input$datasets]]
} else if (input$missing.value.algorithm == "imp4p")
{
if (input$imp4p_withLapala) {
rv$current.obj <- wrapper.dapar.impute.mi(rv$dataset[[input$datasets]],
#eps = input$imp4p_eps,
nb.iter = input$imp4p_nbiter,
lapala = input$imp4p_withLapala,
q.min = input$imp4p_qmin / 100,
distribution = input$imp4pLAPALA_distrib)
#write log command file
writeToCommandLogFile(
paste("current.obj <- wrapper.dapar.impute.mi(",
"dataset[['",input$datasets,"']] nb.iter=",input$imp4p_nbiter,
", lapala = ", input$imp4p_withLapala, ", q.min = ", input$imp4p_qmin / 100, ")",sep=""))
updateSelectInput(session,
"imp4p_withLapala",
selected = input$imp4p_withLapala)
updateSelectInput(session,
"imp4pLAPALA_distrib",
selected = input$imp4pLAPALA_distrib)
updateSelectInput(session,
"imp4p_qmin",
selected = input$imp4p_qmin)
} else {
rv$current.obj <- wrapper.dapar.impute.mi(rv$dataset[[input$datasets]],
#eps = input$imp4p_eps,
nb.iter = input$imp4p_nbiter,
lapala = input$imp4p_withLapala)
#write log command file
writeToCommandLogFile(
paste("current.obj <- wrapper.dapar.impute.mi(",
"dataset[['",input$datasets,"']] nb.iter=",input$imp4p_nbiter,
", lapala = ", input$imp4p_withLapala, ")",sep=""))
}
updateSelectInput(session,
"missing.value.algorithm",
selected = input$missing.value.algorithm)
updateSelectInput(session,
"imp4p_nbiter",
selected = input$imp4p_nbiter)
} else if (input$missing.value.algorithm == "Basic methods"){
if (input$missing.value.basic.algorithm %in% c("KNN", "MLE"))
{
busyIndicator("Calculation in progress",wait = 0)
rv$current.obj <- wrapper.mvImputation(rv$dataset[[input$datasets]],
input$missing.value.basic.algorithm)
#write log command file
writeToCommandLogFile(
paste("current.obj <- wrapper.mvImputation(",
"dataset[['",input$datasets, "']],'",input$missing.value.basic.algorithm,"')", sep="")
)
updateSelectInput(session, "missing.value.algorithm",
selected = input$missing.value.algorithm)
updateSelectInput(session,"missing.value.basic.algorithm",
selected = input$missing.value.basic.algorithm)
}
# else if (input$missing.value.basic.algorithm == "dummy censored")
# {
#
#
# rv$current.obj <- wrapper.impute.pa2(rv$dataset[[input$datasets]],
# q.min = (input$OnlyLAPALA_qmin/100),
# distribution = input$OnlyLAPALA_distrib)
# #write log command file
# writeToCommandLogFile(
# paste("current.obj <- wrapper.impute.pa2(",
# "dataset[['", input$datasets,"']])",sep="")
# )
#
# updateSelectInput(session,
# "missing.value.algorithm",
# selected = input$missing.value.algorithm)
# updateSelectInput(session,"missing.value.basic.algorithm",
# selected = input$missing.value.basic.algorithm)
# updateSelectInput(session,"OnlyLAPALA_distrib",
# selected = input$OnlyLAPALA_distrib)
#
# }
}
}
, warning = function(w) {
print(w)
}, error = function(e) {
shinyjs::info(paste("Perform missing values imputation",":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
}
)
})
})
##' -- Validate the imputation ---------------------------------------
##' @author Samuel Wieczorek
observeEvent(input$ValidImputation,{
input$missing.value.algorithm
if (is.null(input$ValidImputation) || (input$ValidImputation == 0))
{return(NULL)}
isolate({
result = tryCatch(
{
name <- paste ("Imputed", " - ", rv$typeOfDataset, sep="")
rv$dataset[[name]] <- rv$current.obj
#write command log file
writeToCommandLogFile(
paste("dataset[['",name,"']] <- current.obj", sep="")
)
updateSelectInput(session, "datasets",
paste("Dataset versions of",rv$current.obj.name, sep=" "),
choices = names(rv$dataset),
selected = name)
UpdateLog(paste("Imputation with" ,
input$missing.value.algorithm,sep=" "),
name)
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste("Validate the imputation",":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
})
})
})
output$chooseImputationMethod <- renderUI({
if (is.null(rv$current.obj)) {return(NULL)}
m <- NULL
tag <- rv$current.obj@experimentData@other$imputation.method
if (!is.null(tag)){ m <- tag}
selectInput("missing.value.algorithm",
"Choose algorithm",
choices = names(imputationAlgorithms),
selected = names(which(imputationAlgorithms == tag))
)
})
output$chooseBasicImputationMethod <- renderUI({
input$missing.value.algorithm
if (is.null(rv$current.obj)) {return(NULL)}
if ((input$missing.value.algorithm != "Basic methods") || is.null(input$missing.value.algorithm)) {return(NULL)}
selectInput("missing.value.basic.algorithm",
"Choose algorithm",
choices = names(basicMethodsImputationAlgos)
#, selected = names(which(basicMethodsImputationAlgos == tag))
)
})
output$histoMV_Image_DS <- renderPlot({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL)}
result = tryCatch(
{
wrapper.mvHisto(rv$current.obj)
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
})
})
output$histoMV_Image <- renderPlot({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL)}
result = tryCatch(
{
if (!is.null(rv$current.obj)){wrapper.mvHisto(rv$current.obj)}
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
})
})
##' xxxxxxxxxxxxxxxxxxxxxxxx
##' @author Samuel Wieczorek
output$showImageNA <- renderPlot({
rv$current.obj
#input$toto
isolate({
if (is.null(rv$current.obj)) {return(NULL)}
result = tryCatch(
{
wrapper.mvImage(rv$current.obj)
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
})
})
})
output$warningImputationMethod <- renderText({
input$missing.value.algorithm
input$imp4p_withLapala
if (is.null(input$missing.value.algorithm)) {return (NULL)}
if (is.null(input$imp4p_withLapala) || (input$imp4p_withLapala == FALSE)){return(NULL)}
var <- ((input$missing.value.algorithm == "imp4p") && (input$imp4p_withLapala == TRUE)) ||
(input$missing.value.basic.algorithm == "dummy censored")
if (var){
t <- "<br> <strong>Lapala</strong> (from French \"là/pas-là\", meaning \"here/not-here\") refers
to analytes (peptides or proteins) <br>that are entirely missing in some
conditions while they are (partially or totally) <br>visible in others. There
specific accounting in a conservative way is a real issue as the imputation <br>
cannot rely on any observed value in a given condition.
<br> The parameter \"Upper LAPALA bound\" defines the maximum imputed
value as a centile of the observed <br>
distribution (a tuning between 0% and 10% is advised). <br>
<font color=\"red\"><strong>Warning:</strong> Imputed lapala values must be very cautiously interpreted.</font color=\"red\">"
HTML(t)}
# if (input$missing.value.algorithm == "imp4p with LAPALA")
# {
# text <- "<font color=\"red\"> Warning ! <br> You are about to impute the <br> LAPALA with small
# arbitrary values. <br> This is not an optimal way <br>
# to impute such values. <br>
# You do it at your own risk."
# HTML(text)
# } else if (input$missing.value.algorithm == "dummy censored") {
# text <- "<font color=\"red\"> Warning ! <br> You are about to impute the LAPALA with small
# arbitrary values. This is not an optimal way to impute such values.
# You do it at your own risk."
# HTML(text)
# }
})
observe({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL)}
nbEmptyLines <- getNumberOfEmptyLines(Biobase::exprs(rv$current.obj))
if (nbEmptyLines > 0) {
shinyjs::disable("perform.imputation.button")
shinyjs::disable("ValidImputation")
} else {
shinyjs::enable("perform.imputation.button")
shinyjs::enable("ValidImputation")
}
})
output$showImputationPanel <- renderUI({
rv$current.obj
if (is.null(rv$current.obj)) {return (NULL)}
nbEmptyLines <- getNumberOfEmptyLines(exprs(rv$current.obj))
if (nbEmptyLines == 0)
{
tagList(
htmlOutput("helpForImputation"),
htmlOutput("warningImputationMethod")
)
}
else{
text <- "<br> <br> <font color=\"red\">
Warning ! Your dataset contains empty lines so that the imputation cannot be proceed.
<br> <br> Please filter your data first."
HTML(text)
}
})
###################
#
# output$warningLapala <- renderUI({
# input$imp4p_withLapala
# if (is.null(input$imp4p_withLapala) || (input$imp4p_withLapala == FALSE)){return(NULL)}
#
#
# t <- "<br> <strong>Lapala</strong> (from French \"là/pas-là\", meaning \"here/not-here\") refers
# to analytes (peptides or proteins) <br>that are entirely missing in some
# conditions while they are (partially or totally) <br>visible in others. There
# specific accounting in a conservative way is a real issue as the imputation <br>
# cannot rely on any observed value in a given condition.
# <br> The parameter \"Upper LAPALA bound\" defines the maximum imputed
# value as a centile of the observed
# distribution (a tuning between 0% and 10% is advised). <br>
# Warning: imputed lapala values must be very cautiously interpreted"
# HTML(t)
# })
output$helpForImputation <- renderText({
input$missing.value.algorithm
input$missing.value.basic.algorithm
rv$typeOfDataset
if (is.null(input$missing.value.algorithm) || (input$missing.value.algorithm == "None")) {return(NULL)}
if ((input$missing.value.algorithm == "Basic methods") && is.null(input$missing.value.basic.algorithm == "None")) {return(NULL)}
name <- NULL
helpTextImputation <- list("imp4p" = "<strong>imp4p [5]</strong> is a proteomic-specific multiple imputation
method that operates on peptide-level datasets and which proposes <br>
to impute each missing value according to its nature (censored
or random). <br> The more iterations, the more accurate the results,
yet the more time-consuming.",
"dummy censored" = "Dummy censored: each missing value is supposed to be a censored value and
is replaced by the XXX quantile <br> of the corresponding sample
abundance distribution",
"KNN" = "<strong>K- nearest neighbors</strong>, see [7]",
"MLE" = "<strong>Maximum likelihood estimation</strong>, see [8]")
if (input$missing.value.algorithm == "Basic methods") {
name <- input$missing.value.basic.algorithm}
else {name <- input$missing.value.algorithm}
if (!is.null(name)) {
HTML(helpTextImputation[[name]])
}
})
output$progressOne <- renderUI({
input$missing.value.algorithm
rv$current.obj
if (is.null(input$missing.value.algorithm)){return(NULL)}
if (!grepl( "imp4p",input$missing.value.algorithm)) {return(NULL)}
if (is.null(rv$current.obj)) { return(NULL)}
tagList(
h5("This may take a while,"),
h5("please be patient ..."),
progressBar2("pb1",value=0, size="sm", color="aqua", striped=TRUE, active=TRUE, label=TRUE)
)
})
##' boxplot of intensities in current.obj
##' @author Samuel Wieczorek
output$viewNAbyMean <- renderPlot({
rv$current.obj
if (is.null(rv$current.obj)) {return(NULL)}
isolate({
result = tryCatch(
{
wrapper.mvTypePlot(rv$current.obj)
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), sep=" "))
}, finally = {
#cleanup-code
})
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.