f2b69b61 |
function(input, output, session) {
|
ce727bdf |
|
f2b69b61 |
# CREATE REACTIVE FOR CONSOLE TEXT PROGRESS BAR
rout <- tempfile("consoleText", fileext = ".txt")
file.create(rout)
console.text <- reactiveFileReader(200, session, rout, readLines, warn=F)
# ERRORS MESSAGES
output$errorsGsva <- renderText({
req(argInp$varMinsz(), argInp$varMaxsz(), argInp$selectedTau())
rv$errors.gsva
})
|
ce727bdf |
|
f2b69b61 |
# ENABLING 'RUN' BTN
observe({
if(!is.null(matrix()) && !is.null(genesets())){
enable("button")
} else {
disable("button")
|
ce727bdf |
}
|
f2b69b61 |
})
### INPUTS ###
# DATA MATRIX
matrix <- matrixServer("matrix1")
# GENES
genesets <- geneSetsServer("genes1")
# ARGUMENTS
argInp <- argumentsDataServer("argumentsInput")
|
ce727bdf |
|
f2b69b61 |
#### GSVA RESULTS ####
rv <- reactiveValues(gs=NULL, dat.t=NULL, n=NULL, dd.col=NULL, p=NULL,
errors.gsva = NULL, matrix=NULL, genesets=NULL)
gsva.cancel <- reactiveVal(FALSE)
observeEvent( input$button, {
rv$gs <- NULL
rv$dat.t <- NULL
rv$p <- NULL
|
464936e4 |
rv$p2 <- NULL
rv$p3 <- NULL
|
f2b69b61 |
rv$errors.gsva = NULL
rv$matrix <- isolate(matrix())
rv$genesets <- isolate(genesets())
gsva.cancel(FALSE)
modalGSVAUI("modal.text")
# future() cannot take reactive values, so we must isolate() them
future({
sink(rout)
result <- gsva(isolate(matrix()),
isolate(genesets()),
method=isolate(argInp$method()),
kcdf=isolate(argInp$kcdf()),
abs.ranking=isolate(argInp$absRanking()),
min.sz= isolate(argInp$varMinsz()),
max.sz=isolate(argInp$varMaxsz()),
parallel.sz=1L, ## by now, disable parallelism
mx.diff=isolate(argInp$mxDiff()),
tau=isolate(argInp$selectedTau()),
ssgsea.norm=isolate(argInp$ssgseaNorm()),
verbose=TRUE)
sink()
write("", file=rout)
return(result)
}, seed = TRUE) %...>%
(function(result){
rv$gs <- result
rv$dat.t <- melt(as.data.table(rv$gs, keep.rownames = "gene.sets"),
variable.name = "Sample", id.vars="gene.sets")
rv$n <- length(levels(rv$dat.t$Sample))
rv$dd.col <- hcl(h = seq(15, 375, length=rv$n), l = 65, c = 100)[1:rv$n]
names(rv$dd.col) <- levels(rv$dat.t$Sample)
write("", file=rout)
removeModal()
}) %...!%
(function(error){
removeModal()
write("", file=rout)
if(gsva.cancel()){
rv$errors.gsva <- NULL
} else {
rv$errors.gsva <- as.character(error)
}
})
NULL
|
ce727bdf |
})
|
f2b69b61 |
# PRINTING CONSOLE.TEXT
|
0c6ecf40 |
modalGSVAServer("modal.text", console.text, gsva.cancel, rout)
|
f2b69b61 |
# PLOT1 RENDER
plot1_Server("plot1", rv)
|
630c31e3 |
|
ce727bdf |
|
f2b69b61 |
# PLOT2 RENDER
eventData1 <- reactive({
req(rv$dat.t)
ind <- event_data("plotly_click", source = "click1")
ind <- ind$curveNumber+1
})
plot2_Server("plot2", eventData1, rv)
# PLOT3 RENDER
eventData2 <- reactive({
req(rv$p2)
ind <- event_data("plotly_click", source = "click2")
ind <- ind$pointNumber+1
})
plot3_Server("plot3", eventData2, rv, rv$matrix, rv$genesets)
# DWN BTN
|
0c6ecf40 |
downloadServer("download", reactive(rv$gs))
|
98c1bac6 |
# CLOSE BTN
closeBtnServer("close", reactive(rv$gs))
|
10197c62 |
|
f2b69b61 |
# TEXT1
|
10197c62 |
output$text1 <- renderUI({
|
f2b69b61 |
req(rv$gs)
|
10197c62 |
HTML(paste("<br/>", "\t To see the Empirical Cumulative Distribution Function
of a Sample, click on its line in this plot and go
to the 'Gene.Set' Panel", "<br/>", sep="<br/>"))
})
|
f2b69b61 |
# TABLE
output$result <- renderTable({
req(rv$gs)
resultInformation <- data.frame("Nr of gene sets" = nrow(rv$gs),
"Nr of samples" = ncol(rv$gs))
resultInformation
|
10197c62 |
})
|
630c31e3 |
|
f2b69b61 |
# TEXT2
|
d6d54be4 |
output$text2 <- renderUI({
|
f2b69b61 |
title1 <- rv$sample.c
|
5cee189f |
h2(tags$b(title1), align ="center")
})
|
f2b69b61 |
# TEXT3
|
5cee189f |
output$text3 <- renderUI({
|
d6d54be4 |
HTML(paste("<br/>", "\t To see the Kernel Density Estimation of genes of
any given Gene Set in this Sample, click on any point in this plot and a
second plot will appear bellow it", "<br/>", sep="<br/>"))
})
|
f2b69b61 |
# SESSION INFO
|
630c31e3 |
output$sessionInfo <- renderPrint({
sessionInfo()
})
|
ce727bdf |
|
fd21ac54 |
}
|