options(shiny.maxRequestSize=100*1024^2)
options(shiny.trace=FALSE)
options(shiny.reactlog=TRUE)
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)
#if (!interactive()) sink(stderr(), type = "output")
#source(file.path("server", "anaDiff.R"), local = TRUE)$value
shinyServer(function(input, output, session) {
load("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/matSharedPeptides.RData")
load("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/matUniquePeptides.RData")
rv <- reactiveValues(
dataset = list(original = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Original.MSnset"),
filtered = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Filtered.MSnset"),
normalized = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Normalized.MSnset"),
imputed = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Imputed.MSnset"),
aggregated = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_Aggregated.MSnset"),
anaDiff = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_AnaDiff.MSnset")),
current.obj = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_AnaDiff.MSnset"),
matSharedPeptides = matSharedPeptides,
matUniquePeptides = matUniquePeptides
)
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
getDataInfosVolcano <- reactive({
input$eventPointClicked
rv$current.obj
if (is.null(rv$current.obj)){ return()}
test.table <- data.frame(lapply(
Biobase::exprs(rv$current.obj)[(input$eventPointClicked+1),],
function(x) t(data.frame(x))))
rownames(test.table) <- rownames(rv$current.obj)[input$eventPointClicked +1]
test.table <- round(test.table, digits=3)
test.table
})
getUniquePeptidesInfos <- reactive({
input$eventPointClicked
#rv$current.obj
#if (is.null(rv$current.obj)){ return()}
indiceUniquePeptides <- indicePeptides <- NULL
print(input$eventPointClicked +1)
indicePeptides <- which(rv$matSharedPeptides[,input$eventPointClicked +1] ==1)
for (i in indicePeptides){
if (sum(rv$matSharedPeptides[i,]) == 1)
{
indiceUniquePeptides <- i
}
}
print(indicePeptides)
print(indiceUniquePeptides)
#print(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
test.table <- NULL
test.table <- data.frame(lapply(
Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,],
function(x) t(data.frame(x))))
#test.table <- data.frame(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
if (dim(test.table) != c(0,0)){
colnames(test.table) <- colnames(Biobase::exprs(rv$dataset[['original']]))
rownames(test.table) <- rownames(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
}
#rownames(test.table) <- 1:length(indiceUniquePeptides)
test.table <- round(test.table, digits=3)
test.table
})
getSharedPeptidesInfos <- reactive({
input$eventPointClicked
#rv$current.obj
#if (is.null(rv$current.obj)){ return()}
indiceSharedePeptides <- indicePeptides <- NULL
print(input$eventPointClicked +1)
indicePeptides <- which(rv$matSharedPeptides[,input$eventPointClicked +1] ==1)
for (i in indicePeptides){
if (sum(rv$matSharedPeptides[i,]) > 1)
{
indiceSharedePeptides <- i
}
}
print(indicePeptides)
print(indiceSharedePeptides)
#print(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
test.table <- NULL
test.table <- data.frame(lapply(
Biobase::exprs(rv$dataset[['original']])[indiceSharedePeptides,],
function(x) t(data.frame(x))))
print(dim(test.table))
#test.table <- data.frame(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
if (dim(test.table) != c(0,0)){
colnames(test.table) <- colnames(Biobase::exprs(rv$dataset[['original']]))
rownames(test.table) <- rownames(Biobase::exprs(rv$dataset[['original']])[indiceSharedePeptides,])
}
#rownames(test.table) <- 1:length(indiceUniquePeptides)
test.table <- round(test.table, digits=3)
test.table
})
output$volcanoplot_rCharts <- renderHighchart({
#input$eventPointClicked
#rv$current.obj
#if (is.null(rv$current.obj)){ return()}
if (length(which(is.na(Biobase::exprs(rv$current.obj)))) > 0) {
return()}
result = tryCatch(
{
if ("logFC" %in% names(fData(rv$current.obj) )){
df <- data.frame(x=fData(rv$current.obj)$logFC,
y = -log10(fData(rv$current.obj)$P_Value),
index = as.character(rownames(rv$current.obj)),
stringsAsFactors = FALSE)
#if (!is.null(input$tooltipInfo)){
# df <- cbind(df,fData(rv$current.obj)[input$tooltipInfo])
#}
rownames(df) <- rownames(rv$current.obj)
colnames(df) <- gsub(".", "_", colnames(df), fixed=TRUE)
names(rv$current.obj@experimentData@other) <- gsub(".", "_", names(rv$current.obj@experimentData@other), fixed=TRUE)
if (ncol(df) > 3){
colnames(df)[4:ncol(df)] <-
paste("tooltip_", colnames(df)[4:ncol(df)], sep="")
}
hc_clickFunction <-
JS("function(event) {Shiny.onInputChange('eventPointClicked', [this.index]);}")
# print("avant 5")
cond <- c(rv$current.obj@experimentData@other$condition1,
rv$current.obj@experimentData@other$condition2)
diffAnaVolcanoplot_rCharts(df,
threshold_logFC = rv$current.obj@experimentData@other$threshold_logFC,
conditions = cond,
clickFunction=hc_clickFunction)
} else {
}
}
, warning = function(w) {
shinyjs::info(conditionMessage(w))
}, error = function(e) {
shinyjs::info(paste("titi",match.call()[[1]],":",
conditionMessage(e),
sep=" "))
}, finally = {
#cleanup-code
})
})
output$infosUniquePeptidesTable <- DT::renderDataTable({
rv$current.obj
input$eventPointClicked
if (is.null(input$eventPointClicked)){return()}
if (is.null(rv$current.obj)){return()}
data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
print(input$eventPointClicked)
id <- which(data==1)
if (length(id) == 0){
dat <- DT::datatable(getUniquePeptidesInfos(),
options=list(dom='t',ordering=F))
} else {
dat <- DT::datatable(getUniquePeptidesInfos(),
options=list(dom='t',
ordering=F
,drawCallback=JS(
paste("function(row, data) {",
paste(sapply(1:ncol(getUniquePeptidesInfos()),function(i)
paste( "$(this.api().cell(",
id %% nrow(getUniquePeptidesInfos()),",",
id / nrow(getUniquePeptidesInfos()),
").node()).css({'background-color': 'lightblue'});")
),collapse = "\n"),"}" ))
,server = FALSE))
}
dat
})
output$infosSharedPeptidesTable <- DT::renderDataTable({
rv$current.obj
input$eventPointClicked
if (is.null(input$eventPointClicked)){return()}
if (is.null(rv$current.obj)){return()}
data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
print(input$eventPointClicked)
id <- which(data==1)
if (length(id) == 0){
dat <- DT::datatable(getSharedPeptidesInfos(),
options=list(dom='t',ordering=F))
} else {
dat <- DT::datatable(getSharedPeptidesInfos(),
options=list(dom='t',
ordering=F
,drawCallback=JS(
paste("function(row, data) {",
paste(sapply(1:ncol(getSharedPeptidesInfos()),function(i)
paste( "$(this.api().cell(",
id %% nrow(getSharedPeptidesInfos()),",",
id / nrow(getSharedPeptidesInfos()),
").node()).css({'background-color': 'lightblue'});")
),collapse = "\n"),"}" ))
,server = FALSE))
}
dat
})
output$infosVolcanoTable <- DT::renderDataTable({
rv$current.obj
input$eventPointClicked
if (is.null(input$eventPointClicked)){return()}
if (is.null(rv$current.obj)){return()}
data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
#print(data)
id <- which(data==1)
if (length(id) == 0){
dat <- DT::datatable(getDataInfosVolcano(),
options=list(dom='t',ordering=F))
} else {
dat <- DT::datatable(getDataInfosVolcano(),
options=list(dom='t',
ordering=F
,drawCallback=JS(
paste("function(row, data) {",
paste(sapply(1:ncol(getDataInfosVolcano()),function(i)
paste( "$(this.api().cell(",
id %% nrow(getDataInfosVolcano()),",",
id / nrow(getDataInfosVolcano()),
").node()).css({'background-color': 'lightblue'});")
),collapse = "\n"),"}" ))
,server = FALSE))
}
dat
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.