library(DAPAR)
library(DAPARdata)
library(shiny)
library(rhandsontable)
library(data.table)
library(shinyjs)
library(shinyAce)
library(highcharter)
library(rhandsontable)
library(data.table)
library(reshape2)
library(DT)
library(MSnbase)
library(openxlsx)
library(sm)
library(imp4p)
library(highcharter)
# Declaration of global variables
commandLogFile <- "cmdLog.R"
logfilename <- "log.txt"
gFileExtension <- list(txt = ".txt",
tsv = ".tsv",
msnset = ".MSnset",
excel = ".xlsx",
zip = ".zip")
gAgregateMethod <- list("none" = "none",
"sum overall" = "sum overall",
"mean" = "mean",
"sum on top n" = "sum on top n")
gFiltersList <- list()
gFiltersList[["None"]] <- "none"
gFiltersList[["Whole matrix"]] <- "wholeMatrix"
gFiltersList[["For every condition"]] <- "allCond"
gFiltersList[["At least one condition"]] <- "atLeastOneCond"
gDatasets <- list()
gDatasets[["NA"]] <- "none"
gFilterNone <- gFiltersList[["None"]]
gFilterWholeMat <- gFiltersList[["Whole matrix"]]
gFilterAllCond <- gFiltersList[["For every condition"]]
gFilterOneCond <- gFiltersList[["At least one condition"]]
# variables for filtering the data
gReplaceAllZeros <- "replaceAllZeros"
gLogTransform <- "Log2 tranformed data"
gFilterTextPrefix <- "Filtered with"
pData.complete.list <- list("Label" = "Label",
"Bio.Rep" = "Bio. rep.",
"Tech.Rep" = "Tech. rep.",
"Analyt.Rep" = "An. Rep.")
normMethods <- list("None" = "None",
"Global Alignment" = "Global Alignment",
"Quantile Centering" = "Quantile Centering",
"Mean Centering" = "Mean Centering"
)
imputationAlgorithms <- list("None" = "None",
"imp4p" = "imp4p",
"Basic methods" = "Basic methods")
basicMethodsImputationAlgos <- list(
#"dummy censored" = "dummy censored",
"KNN" = "KNN",
"MLE" = "MLE")
JSCSSTags <- function()
{
list(
tags$script(src="js/jquery.js",type="text/javascript"),
tags$script(src="js/jquery.dataTables.js",type="text/javascript"),
tags$link(href='css/jquery.dataTables.css', rel="stylesheet",
type="text/css"),
tags$link(href='css/dataTables.tableTools.css', rel="stylesheet",
type="text/css"),
tags$script(src='js/dataTables.tableTools.js'),
tags$link(rel="stylesheet", type="text/css",href="css/style.css"),
tags$script(type="text/javascript", src = "busy.js")
)
}
DT_pagelength <- 15
reactiveDataTable <- function(func, ...)
{
reactive(function()
{
classNames <-
getOption("shiny.table.class", "table table-striped table-bordered")
classID = getOption("shiny.table.id", "example")
data <- func()
if (is.null(data) || is.na(data))
return("")
return(paste(
capture.output(
print(xtable(data, ...),
type = "html",
html.table.attributes =
paste("class=\"", classNames, "\" id=\"", classID, "\"", sep = ""),
...)), collapse = "\n"))
})
}
# for layout
resizeComponents <- function(){
tags$head(
tags$style(type="text/css", "textarea { max-width: 400px; }"),
tags$style(type='text/css',
".well { max-width: 300px; max-height=300px;}"),
tags$style(type='text/css', ".span4 { max-width: 300px; }")
)
}
GetFilterText <- function(type, seuil){
return (
paste(gFilterTextPrefix," ",type , " (threshold = ", seuil, " ).", sep=""))
}
gGraphicsFilenames <- list(
histoMV_DS = "histoMV_DS.png",
histoMVPerLines_DS = "histoMissvaluesPerLines_DS.png",
histoMVPerLinesConditions_DS = "histoMVPerLinesPerConditions_DS.png",
histoMV = "histoMV_DS.png",
histoMVPerLines = "histoMissvaluesPerLines.png",
histoMVPerLinesConditions = "histoMVPerLinesPerConditions.png",
corrMatrix = "corrMatrix.png",
heatmap = "heatmap.png",
boxplot = "boxplot.png",
varDist = "varDist.png",
densityPlot = "densityPlot.png",
densityPlotNorm = "densityPlotNorm.png",
propContRev = "propContRev.png",
boxplotNorm = "boxplotNorm.png",
compareNorm = "compareNorm.png",
MVtypePlot = "MVtypePlot.png",
imageNA = "imageNA.png",
AgregMatUniquePeptides = "AgregMatUniquePeptides.png",
AgregMatSharedPeptides = "AgregMatSharedPeptides.png",
volcanoPlot_1 = "volcanoPlot_1.png",
volcanoPlot_3 = "volcanoPlot_3.png",
calibrationPlot = "calibrationPlot.png",
calibrationPlotAll = "calibrationPlotAll.png"
)
defaultGradientRate <- 5
# variables for different extensions files format
gFileFormatExport <- list(msnset = "MSnset",excel = "Excel")
# Not used yet
GetLogFilename <- function(){
return(paste("loG__",Sys.getpid(), ".txt", sep=""))
}
#---------------------------------------------------------
GetChoices <- function(){
choix <- list.dirs(path=dir, recursive=FALSE)
names <- c()
for (i in 1:length(choix)){
names[i] <-
unlist(strsplit(choix[i], '/'))[length(unlist(strsplit(choix[i], '/')))]
}
return(setNames(names, names))
}
#--------------------------------------------------------
DeleteFileExtension <- function(name){
return(strsplit(name,'.', fixed=T)[[1]][1])}
#--------------------------------------------------------
GetExtension <- function(name){
temp <- unlist(strsplit(name,'.', fixed=T))
return(last(temp))
}
#' busyIndicator
busyIndicator <- function(text = "Calculation in progress..",
img = "images/ajax-loader.gif", wait=1000) {
tagList(
singleton(tags$head(
tags$link(rel="stylesheet",
type="text/css",href="busyIndicator/busyIndicator.css")
))
,div(class="busy-indicator",p(text),img(src=img))
,tags$script(sprintf(
" setInterval(function(){
if ($('html').hasClass('shiny-busy')) {
setTimeout(function() {
if ($('html').hasClass('shiny-busy')) {
$('div.busy-indicator').show()
}
}, %d)
} else {
$('div.busy-indicator').hide()
}
},100)
",wait)
)
)
}
########################################################
# FROM :http://stackoverflow.com/questions/35271661/update-shiny-r-custom-progressbar/39265225#39265225
progressBar2 <- function(inputId=NULL, value=0, label=FALSE, color="info",
size=NULL,
striped=FALSE, active=FALSE, vertical=FALSE) {
stopifnot(is.numeric(value))
if (value < 0 || value > 100)
stop("'value' should be in the range from 0 to 100", call. = FALSE)
#if (!(color %in% shinydashboard:::validColors || color %in% shinydashboard:::validStatuses))
# stop("'color' should be a valid status or color.", call. = FALSE)
if (!is.null(size))
size <- match.arg(size, c("sm", "xs", "xxs"))
text_value <- paste0(value, "%")
if (vertical)
style <- htmltools::css(height = text_value, `min-height` = "2em")
else
style <- htmltools::css(width = text_value, `min-width` = "2em")
htmltools::tags$div(
class = "progress",
class = if (!is.null(size)) paste0("progress-", size),
class = if (vertical) "vertical",
class = if (active) "active",
htmltools::tags$div(
class = "progress-bar",
class = paste0("progress-bar-", color),
class = if (striped) "progress-bar-striped",
id = paste0(inputId),
role = "progressbar",
style = style,
`aria-valuemax` = 100,
`aria-valuemin` = 0,
`aria-valuenow` = value,
htmltools::tags$span(
id = "text_value",
class = if (!label) "sr-only",
text_value)
)
)
}
updatePB <- function(session,inputId=NULL,value=NULL,label=NULL,color=NULL,text_value = NULL,size=NULL,striped=NULL,active=NULL,vertical=NULL) {
data <- dropNulls(list(id=inputId,value=value,label=label,color=color,text_value=text_value,size=size,striped=striped,active=active,vertical=vertical))
session$sendCustomMessage("updateprogress",data)
}
dropNulls <-function(x) {
x[!vapply(x,is.null,FUN.VALUE=logical(1))]
}
########################################################
# Author: https://jackolney.github.io/2016/shiny/
progressGroup <- function(text, value, min = 0, max = value, color = "aqua") {
stopifnot(is.character(text))
stopifnot(is.numeric(value))
if (value < min || value > max)
stop(sprintf("'value' should be in the range from %d to %d.", min, max), call. = FALSE)
tags$div(
class = "progress-group",
tags$span(class = "progress-text", text),
tags$span(class = "progress-number", sprintf("%d / %d", value, max)),
prgoressBar(round(value / max * 100), color = color, size = "sm")
)
}
findSequences <- function(v){
diff <- v[2:length(v)] - v[1:(length(v)-1)]
if (!all(diff != 1)){
s <- rle(diff == 1)
begin <- c(0, cumsum(s$lengths))[which(s$values)] + 1
end <- cumsum(s$lengths)[which(s$values)] +1
seq <- "c("
temp <- NULL
i <- 1
while(i < begin[1] && i < length(v))
{
seq <- paste(seq, v[i], ",", sep="")
i <- i + 1
}
for (i in 1:length(begin)){
seq <- paste(seq, v[begin[i]], ":", v[end[i]], sep="")
if (i < length(begin)) {seq <- paste(seq, ",", sep="")}
if (i < length(begin) && ((begin[i+1] - end[i]) > 1)){
for(j in c((end[i]+1):(begin[i+1]-1))) {
seq <- paste(seq, v[j], ",", sep="")
}
}
}
i <- last(end) +1
if (i <= length(v)) {seq <- paste(seq, ",", sep="")}
while(i <= length(v))
{
seq <- paste(seq, v[i])
if (i < length(v)) {seq <- paste(seq, ",", sep="")}
i <- i +1
}
seq <- paste(seq, ")", sep="")
}
else
{
seq <- paste("c(", paste(diff, collapse=","),")", sep="")
}
return(seq)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.