R/fulldash.R
In Albluca/rRomaDash: A shiny dashboard to rROMA
Defines functions
Initialize
rRomaDash
Documented in
Initialize
rRomaDash
#' Title
#'
#' @param RomaData
#' @param ExpMat
#' @param Groups
#'
#' @return
#'
#' @examples
Initialize <- function(RomaData, ExpMat, Groups){
if(is.null(RomaData)){
return(list(FoundSamp = NULL, Groups = Groups, AddInfo = NULL,
SelList = list(), SelListAF = list(), GSList = list(),
PCAProj = NULL, ProcessedSamples = NULL))
}
ProcessedSamples <- colnames(RomaData$SampleMatrix)
if(!is.null(Groups)){
FoundSamp <- intersect(colnames(RomaData$SampleMatrix), names(Groups))
Groups <- Groups[FoundSamp]
if(length(FoundSamp) > 2){
if(!is.factor(Groups)){
Groups <- as.factor(Groups)
}
AddInfo <- data.frame(Groups = Groups)
} else {
AddInfo <- NULL
}
SelList <- list("By sample" = "sample", "By group" = "group")
SelListAF <- list("Mean" = "mean", "Median" = "median", "Std. dev." = "sd", "IQR" = "IQR", "mad" = "mad")
} else {
Groups <- rep("N/A", length(ProcessedSamples))
names(Groups) <- ProcessedSamples
FoundSamp = NULL
AddInfo <- NULL
SelList <- list("By sample" = "sample")
SelListAF <- list()
}
if(length(unique(Groups))<2){
SelList <- list("By sample" = "sample")
SelListAF <- list()
}
if(!is.null(RomaData)){
GSList <- as.list(1:nrow(RomaData$PVVectMat))
names(GSList) <- as.list(rownames(RomaData$SampleMatrix))
GSList <- GSList[order(names(GSList))]
PCAProj <- irlba::prcomp_irlba(t(ExpMat[,ProcessedSamples]), 2, retx = TRUE)$x
rownames(PCAProj) <- ProcessedSamples
colnames(PCAProj) <- c("PC1", "PC2")
} else {
GSList <- list()
PCAProj <- NULL
}
return(list(FoundSamp = FoundSamp, Groups = Groups, AddInfo = AddInfo,
SelList = SelList, SelListAF = SelListAF, GSList = GSList,
PCAProj = PCAProj, ProcessedSamples = ProcessedSamples))
}
#' Launch the rRoma dashboard
#'
#' @param RomaData
#' @param ExpMat
#' @param Groups
#' @param Interactive boolean, scalar. Should interactivity (via Plotly) be enabled?
#'
#' @return
#' @export
#'
#' @examples
rRomaDash <- function(RomaData = NULL,
ExpMat = NULL,
Groups = NULL,
Interactive = FALSE) {
# library(rRoma)
# library(shiny)
# library(shinyFiles)
# preprocess data ---------------------------------------------------------
if(R.utils::isPackageLoaded("plotly")){
print("Detaching plotly.")
detach("package:plotly", unload=TRUE)
}
if(Interactive){
library(plotly)
}
# if(Interactive){
# print("Using plotly. This can cause problems on some systems. Try setting 'Interactive = FALSE' if errors are encountered")
# } else {
#
# }
StartTime <- Sys.time()
print(paste("Interface starting", StartTime))
TimeVect <- rep(StartTime, 3)
names(TimeVect) <- c("Upload", "Local", "Analysis")
InitReturn <- Initialize(RomaData, ExpMat, Groups)
FoundSamp <- InitReturn$FoundSamp
Groups <- InitReturn$Groups
AddInfo <- InitReturn$AddInfo
SelList <- InitReturn$SelList
SelListAF <- InitReturn$SelListAF
GSList <- InitReturn$GSList
PCAProj <- InitReturn$PCAProj
ProcessedSamples <- InitReturn$ProcessedSamples
GeneList <- list()
tSNEProj <- PCAProj
InternalGMTList <- list(
"Molecular signature DB (v6.0)" = "MsigDB",
"ACSN Globlal Map (v1.1)" = "ACSN_Global",
"ACSN Apoptosis Map (v1.1)" = "ACSN_Apoptosis",
"ACSN Cell Cycle Map (v1.1)" = "ACSN_CellCycle",
"ACSN DNA Repair Map (v1.1)" = "ACSN_DNARepair",
"ACSN EMT Map (v1.1)" = "ACSN_EMT",
"ACSN Survival Map (v1.1)" = "ACSN_Survival",
"InfoSigMap Conseved" = "InfoSig_Conserved",
"InfoSigMap" = "InfoSig_Informative"
)
MapList <- list(
"Atlas of Cancer Signalling Network global map" = "https://acsn.curie.fr/navicell/maps/acsn/master/index.php",
"Apoptosis and mitochondria metabolism map" = "https://acsn.curie.fr/navicell/maps/apoptosis/master/index.php",
"Cell survival map" = "https://acsn.curie.fr/navicell/maps/survival/master/index.php",
"EMT and cell motility map" = "https://acsn.curie.fr/navicell/maps/emtcellmotility/master/index.php",
"Cell cycle map" = "https://acsn.curie.fr/navicell/maps/cellcycle/master/index.php",
"DNA repair map" = "https://acsn.curie.fr/navicell/maps/dnarepair/master/index.php",
"InfoSigMap" = "https://navicell.curie.fr/navicell/newtest/maps/infosigmap/master/index.php"
)
nProcList <- as.list(as.character(1:32))
names(nProcList) <- as.character(1:32)
InitialSave <- paste(getwd(), '/', 'rRoma-', Sys.Date(), '.rds', sep = "")
# define ui ---------------------------------------------------------
ui <- navbarPage("rRoma dashboard",
# Perform analysis (Top Tab 1) ---------------------------------------------------------
tabPanel("Analyze Data",
pageWithSidebar(
# Application title
headerPanel(""),
# Sidebar with a slider input
sidebarPanel(
actionButton("doROMA", "Execute rROMA"),
hr(),
htmlOutput("ROMAOut"),
htmlOutput("ROMAOut2")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
# Data input ---------------------------------------------------------
tabPanel("Input",
fluidPage(
fluidRow(
titlePanel("Expression matrix"),
column(8,
fileInput("expmatfile", "Choose an expression matrix (TSV file)", accept = c(".tsv", ".txt"))
)
),
fluidRow(
titlePanel("Sample groups"),
column(8,
fileInput("groupfile", "Choose a group matrix (TSV file)", accept = c(".tsv", ".txt"))
),
column(4,
checkboxInput("usegroups", "Use groups", TRUE)
)
),
fluidRow(
titlePanel("Geneset list"),
column(6,
selectInput("gmtsrc", "Geneset source:",
list("Local file" = "File",
"Internal DB" = "Internal")),
conditionalPanel(
condition="input.gmtsrc == 'File'",
fileInput("gmtfile", "Choose a GMT file", accept = c(".gmt", ".txt"))
),
conditionalPanel(
condition="input.gmtsrc == 'Internal'",
selectInput("gmtlist", "Available geneset list:", InternalGMTList)
),
textInput("msigkw", "Keywords", ""),
checkboxInput("msigkwall", "search all keywords", FALSE),
checkboxInput("loadwei", "load weights", FALSE)
),
column(6,
selectInput("sourceOrg", "Source organism:",
list("H. sapiens" = "hsapiens",
"M. musculus" = "mmusculus")),
selectInput("targetOrg", "Target organism:",
list("H. sapiens" = "hsapiens",
"M. musculus" = "mmusculus")),
selectInput("sourceName", "Source gene ID:",
list("Name" = "Names",
"Ensembl" = "Ensembl")),
selectInput("targetName", "Target gene ID:",
list("Name" = "Names",
"Ensembl" = "Ensembl")),
checkboxInput("convertGeneID", "Convert geneset genes IDs", FALSE)
),
column(12,
actionButton("searchDB", "Search genesets")
)
),
fluidRow(
titlePanel("Available Genesets:"),
column(12,
dataTableOutput("PrintGeneSets"))
)
)
),
# Parameters ---------------------------------------------------------
tabPanel("Parameters",
fluidPage(title = "Base parameters",
titlePanel("Base parameters"),
column(6, selectInput("par_FixedCenter", "FixedCenter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_PCSignMode", "PCSignMode",
list("none" = "none",
"PreferActivation" = "PreferActivation",
"UseAllWeights" = "UseAllWeights",
"UseKnownWeights" = "UseKnownWeights",
"CorrelateAllWeightsByGene" = "CorrelateAllWeightsByGene",
"CorrelateKnownWeightsByGene" = "CorrelateKnownWeightsByGene"),
selected = "CorrelateAllWeightsByGene"),
textInput("par_nSamples", "nSamples", "100"),
textInput("par_GeneOutThr", "GeneOutThr", "5")
),
column(6,
selectInput("par_UseParallel", "UseParallel",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
conditionalPanel(condition="input.par_UseParallel == 'TRUE'",
selectInput("par_nCores", "nCores", nProcList,
selected = as.character(parallel::detectCores() - 1)),
selectInput("par_ClusType", "ClusType",
list("PSOCK", "FORK"), selected = "PSOCK")
)
)
),
fluidPage(title = "Advanced parameters",
titlePanel("Advanced parameters"),
column(4, selectInput("par_UseWeigths", "UseWeigths",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_FullSampleInfo", "FullSampleInfo",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_centerData", "centerData",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
selectInput("par_GeneSelMode", "GeneSelMode",
list("All" = "All", "Others" = "Others"), selected = "TRUE"),
textInput("par_Ncomp", "Ncomp", "5"),
textInput("par_DefaultWeight", "DefaultWeight", "1")
),
column(4, selectInput("par_SampleFilter", "SampleFilter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
selectInput("par_ExpFilter", "ExpFilter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_MoreInfo", "MoreInfo",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_GeneOutDetection", "GeneOutDetection",
list("L1OutVarPerc" = "L1OutVarPerc",
"L1OutVarDC" = "L1OutVarDC",
"L1OutExpOut" = "L1OutExpOut",
"L1OutSdMean" = "L1OutSdMean"), selected = "L1OutExpOut"),
textInput("par_OutGeneNumber", "OutGeneNumber", "5"),
textInput("par_OutGeneSpace", "OutGeneSpace", "NULL")
),
column(4, textInput("par_MinGenes", "MinGenes", "10"),
textInput("par_MaxGenes", "MaxGenes", "500"),
textInput("par_ApproxSamples", "ApproxSamples", "5"),
textInput("par_PCSignThr", "PCSignThr", "NULL"),
selectInput("par_CorMethod", "CorMethod",
list("pearson" = "pearson",
"kendall" = "kendall",
"spearman" = "spearman"), selected = "pearson"),
selectInput("par_PCAType", "PCAType",
list("DimensionsAreGenes" = "DimensionsAreGenes",
"DimensionsAreSamples" = "DimensionsAreSamples"),
selected = "DimensionsAreGenes")
)
)
)
)
)
)
),
# Data summary (Top Tab 2) ---------------------------------------------------------
tabPanel("Summarize Info",
fluidPage(
titlePanel(""),
fluidRow(
tabsetPanel(
tabPanel("Parameters", dataTableOutput("PrintPar")),
tabPanel("Genesets", dataTableOutput("PrintGMT")),
tabPanel("Groups", dataTableOutput("PrintGroup"))
)
)
)
),
# Results (Top Tab 3) ---------------------------------------------------------
tabPanel("Visualize Results",
pageWithSidebar(
# Application title
headerPanel(NULL),
# sidebar ---------------------------------------------------------
sidebarPanel(
conditionalPanel(
condition="input.ResTabs == 'Modules'",
selectInput("prjt", "Projection type:",
list("PCA" = "PCA", "tSNE" = "tSNE"))
),
conditionalPanel(
condition="input.ResTabs == 'Modules' && input.prjt == 'tSNE'",
sliderInput("perp", "tSNE perplexity:",
min = 0, max = 100, value = 0, step = 1),
numericInput("initial_dims", "Initial dimensions:", min = 2, max = NA, step = 1, value = 50),
actionButton("dotSNE", "Compute tSNE"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Modules'",
selectInput("boxcomp", "Group comparison:",
c("Show all", "Show none", "Show significant")),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Modules' || input.ResTabs == 'Gene contribution'",
selectInput("gs", "Geneset:",
GSList),
htmlOutput("info"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation' || input.ResTabs == 'Correlation network'",
selectInput("htype", "Operation type:", SelList)
),
conditionalPanel(
condition="(input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation' || input.ResTabs == 'Correlation network') && input.htype == 'group'",
selectInput("aggfun", "Aggregating function:", SelListAF)
),
conditionalPanel(
condition="input.ResTabs == 'Correlation' || input.ResTabs == 'Gene contribution' || input.ResTabs == 'Correlation network'",
selectInput("cortype", "Correlation method:",
list("Pearson" = "pearson",
"Kendall" = "kendall",
"Spearman" = "spearman"))
),
conditionalPanel(
condition="input.ResTabs == 'Gene contribution'",
selectInput("corlelvel", "Confidence level:",
list(".95", ".99", ".999", ".9999")),
actionButton("doCorr", "Compute correlations"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Correlation network'",
sliderInput("corthr", "Threshold:",
min = 0, max = 1, value = .6, step = .01)
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap'",
checkboxInput("gscol", "Samples on columns", FALSE),
checkboxInput("saclus", "Cluster samples / groups", FALSE)
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation'",
checkboxInput("gsclus", "Cluster genesets", FALSE),
selectInput("GSOrdeMode", "Geneset information:",
choices = c("None", "Gene number",
"Overdispersion pv", "Underdispersion pv",
"Overcoordination pv", "Undercoordination pv",
"Overexpression pv", "Underexpression pv")),
hr()
),
selectInput("disp", "Dispersion filter:",
list("Overdispersed" = "Over",
"Underdispersed" = "Under",
"None" = "None")),
sliderInput("pdisp", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
selectInput("coord", "Coordination filter:",
list("Overcoordinated" = "Over",
"Undercoordinated" = "Under",
"None" = "None"), selected = "None"),
sliderInput("pcoord", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
selectInput("exp", "Expression filter:",
list("Overexpressed" = "Over",
"Underexpressed" = "Under",
"None" = "None"), selected = "None"),
sliderInput("pexp", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
conditionalPanel(
condition="input.ResTabs == 'Heatmap'",
sliderInput("llim", "Lower limit",
max = 0, min = -100, value = -100, step = .1),
sliderInput("ulim", "Upper limit",
max = 100, min = 0, value = 100, step = .1)
),
conditionalPanel(
condition="input.ResTabs == 'Correlation'",
selectInput("gs_x", "Geneset (x axis):",
GSList),
selectInput("gs_y", "Geneset (y axis):",
GSList),
sliderInput("lcor", "Lower limit",
max = 0, min = -1, value = -1, step = .1),
sliderInput("ucor", "Upper limit",
max = 1, min = 0, value = 1, step = .1)
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes'",
sliderInput("gperc", "Percentage of genes",
max = 100, min = 10, value = 10, step = 5),
selectInput("contrType", "Controbution type:",
list("Positive" = "Pos",
"Negative" = "Neg",
"Absolute" = "Abs"), selected = "Absolute"),
selectInput("contrMode", "Selection mode:",
list("Weights" = "Wei",
"Correlation" = "Cor"), selected = "Weights")
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes' && input.contrMode == 'Cor'",
selectInput("corrType", "Correlation type:",
list("Pearson" = "pearson",
"Kendall" = "kendall",
"Spearman" = "spearman"), selected = "Pearson")
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes'",
actionButton("doTop", "Compute contributing genes")
)
),
# main plots ---------------------------------------------------------
mainPanel(
tabsetPanel(id = "ResTabs",
# SubTab 1 (PCA/tSNE) ---------------------------------------------------------
tabPanel(title = "Modules",
if(Interactive){
tabPanel("Plot",
plotlyOutput("scatPlot", height = "900px"),
plotOutput("boxPlot", height = "500px"),
plotOutput("SamplesBoxPlot", height = "400px")
)
} else {
tabPanel("Plot",
plotOutput("scatPlot", height = "900px"),
plotOutput("boxPlot", height = "500px"),
plotOutput("SamplesBoxPlot", height = "400px")
)
}
),
# SubTab 2 (Module heatmap) ---------------------------------------------------------
tabPanel("Heatmap", id = "tab2",
plotOutput("hmPlot", height = "1600px")
),
# SubTab 3 ---------------------------------------------------------
tabPanel("Gene contribution", id = "tab3",
selectInput("contribType", "Contribution mode:",
list("Positive", "Negative")),
plotOutput("CorrCI", height = "1000px"),
# dataTableOutput("CorrTable"),
selectInput("availGenes", "", GeneList),
plotOutput("ExpProj", height = "1000px")
),
# SubTab 4 ---------------------------------------------------------
tabPanel("Correlation", id = "tab4",
if(Interactive){
tabPanel("Plot",
plotOutput("CorHmPlot", height = "1500px"),
plotlyOutput("CorScatPlot", height = "1000px")
)
} else {
tabPanel("Plot",
plotOutput("CorHmPlot", height = "1500px"),
plotOutput("CorScatPlot", height = "1000px")
)
}
),
# SubTab 5 ---------------------------------------------------------
tabPanel("ACSN (Selection)", id = "tab5",
fluidPage(
fluidRow(
headerPanel("Map to use:"),
column(12,
selectInput("mapurl", "", MapList, width = "75%")
),
headerPanel("Selected genesets:"),
column(12,
dataTableOutput("SelGSTable")
),
headerPanel("Sample(s) to use:"),
column(12,
checkboxGroupInput("selSamples", "", inline = TRUE,
choices = character(0))
)
),
fluidRow(
headerPanel("Group Selection:"),
column(6,
selectInput("selgroup", NULL, as.list(unique(Groups)))
),
column(6,
actionButton("selByGroup", "Select group"),
actionButton("selNone", "Clear selection")
)
),
fluidRow(
headerPanel("Projection options:"),
column(6,
selectInput("projtype", "Display mode:",
list("Module" = "Module", "Gene" = "Gene")),
textInput("ACSNWeiFil", "Filtering threshold:", "20")
),
column(6,
selectInput("scoreaggfun", "Score aggregation:",
list("mean" = "mean", "median" = "median",
"sd" = "sd", "IQR" = "IQR", "mad" = "mad")),
selectInput("geneaggfun", "Gene aggregation:",
list("mean" = "mean", "median" = "median",
"sd" = "sd", "IQR" = "IQR", "mad" = "mad"))
)
),
hr(),
fluidRow(
column(6,
actionButton("doACSN", "Plot on ACSN map")
),
column(6,
htmlOutput("ACSNStatus")
)
),
hr()
)
),
# SubTab 6 ---------------------------------------------------------
tabPanel("ACSN (Info)", id = "tab5",
fluidPage(
fluidRow(
column(6,
plotOutput("WeiVarBP")
),
column(6,
plotOutput("ScoreDist")
)
),
fluidRow(
column(6,
plotOutput("GeneMult")
),
column(6,
plotOutput("ScoreVar")
)
)
)
),
# SubTab 7 ---------------------------------------------------------
tabPanel("Top contributing genes", id = "tab6",
fluidRow(
column(12,
dataTableOutput("TopContributingGenes"))
)
),
# SubTab 8 ---------------------------------------------------------
tabPanel("Correlation network", id = "tab7",
fluidRow(
column(12,
visNetworkOutput("CorNet", height = "1500px"))
)
)
)
)
)
),
# Save / Load (Top Tab 4) ---------------------------------------------------------
tabPanel("Save/Load",
fluidPage(
titlePanel(""),
fluidRow(
column(6,
wellPanel(
helpText("Upload a previously performed rRoma analysis"),
fileInput("prev.rRoma", "Choose an rRoma file", accept = c(".rds"))
),
wellPanel(
helpText("Download the rRoma analysis"),
downloadButton("downloadData", "Download")
)
),
column(6,
wellPanel(
helpText("Load rRoma analysis locally"),
shinyFilesButton("load", "Load data", "Please select a file", FALSE)
),
wellPanel(
helpText("Save rRoma analysis locally"),
shinySaveButton("save", "Save data", "Save file as",
filetype=list(rds="rds"))
)
)
)
)
)
)
# define server ---------------------------------------------------------
server <- function(input, output, session) {
options(shiny.maxRequestSize=1000*1024^2)
Volumes = list("Working directory" = getwd(), "Volumes"= getVolumes())
shinyFileChoose(input, "load",
roots=Volumes,
session=session, filetypes=c('rds'))
shinyFileSave(input, "save",
roots=Volumes,
session=session)
# Load GMT file ---------------------------------------------------------
GetGMTFile <- reactive({
print("Reading the GMT file")
inFile <- input$gmtfile
if(is.null(inFile)){
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
if(trimws(input$msigkw) == ""){
KWStrings <- ""
} else {
KWStrings <- unlist(strsplit(trimws(input$msigkw), split = " ", fixed = TRUE))
}
LoadedData <- ReadGMTFile(FileLocation = inFile$datapath,
SearchString = KWStrings,
Mode = ifelse(input$msigkwall, "ALL", "ANY"))
if(!input$loadwei){
LoadedData <- lapply(LoadedData, function(GS) {
GS$Weigths[!is.na(GS$Weigths)] <- NA
return(GS)
})
}
return(LoadedData)
}
})
# Get GMT list ---------------------------------------------------------
GetModuleList <- eventReactive(input$searchDB, {
if(input$gmtsrc == "File"){
print("Loading GMT from file")
ModuleList <- GetGMTFile()
}
if(input$gmtsrc == "Internal"){
print("Loading from internal database")
if(trimws(input$msigkw) == ""){
KWStrings <- ""
} else {
KWStrings <- unlist(strsplit(trimws(input$msigkw), split = " ", fixed = TRUE))
}
ModuleList <- SelectFromInternalDB(SearchString = KWStrings,
Mode = ifelse(input$msigkwall, "ALL", "ANY"),
BDName = input$gmtlist, Version = NULL)
if(!input$loadwei){
ModuleList <- lapply(ModuleList, function(GS) {
GS$Weigths[!is.na(GS$Weigths)] <- NA
return(GS)
})
}
}
if(input$convertGeneID){
print("Performing coversion")
ModuleList <- ConvertModuleNames(
ModuleList,
SourceOrganism = input$sourceOrg,
TargetOrganism = input$targetOrg,
SourceTypes = input$sourceName,
TargetTypes = input$targetName,
HomologyLevel = 1,
HOST = NULL,
PATH = NULL)
}
print("Returning module list")
return(ModuleList)
}, ignoreInit = FALSE, ignoreNULL = FALSE)
# Print selected genesets ---------------------------------------------------------
output$PrintGeneSets <- renderDataTable({
ModuleList <- GetModuleList()
ModuleDF <- data.frame(Names = unlist(lapply(ModuleList, "[[", "Name")),
Genes = unlist(lapply(lapply(ModuleList, "[[", "Genes"), length)),
Weighted = unlist(lapply(lapply(ModuleList, "[[", "Weigths"), function(x){sum(!is.na(x))})))
ModuleDF
})
# Load expression matrix ---------------------------------------------------------
GetExpMat <- reactive({
inFile <- input$expmatfile
if(is.null(inFile)){
print("No input expression matrix specified")
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
print("Loading header")
PlainFile.Head <- readr::read_tsv(file = inFile$datapath, col_names = TRUE, n_max = 1)
ListSpec <- list('c', 'd')
names(ListSpec) <- c(colnames(PlainFile.Head)[1], '.default')
print("Loading data")
PlainFile <- readr::read_tsv(file = inFile$datapath,
col_types = do.call(what = readr::cols, args = ListSpec),
col_names = TRUE)
EmptyColumns <- colSums(is.na(PlainFile)) == nrow(PlainFile)
EmptyRows <- rowSums(is.na(PlainFile)) >= ncol(PlainFile) - 1
if(any(EmptyColumns) | any(EmptyRows)){
print("Filtering empty rows and columns")
PlainFile <- PlainFile[!EmptyRows, !EmptyColumns]
}
ExpMat <- data.matrix(PlainFile[,-1])
rownames(ExpMat) <- unlist(PlainFile[,1])
return(ExpMat)
}
})
# Load Group file ---------------------------------------------------------
GetGroups <- reactive({
if(!input$usegroups){
return(NULL)
}
inFile <- input$groupfile
if(is.null(inFile)){
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
PlainFile <- readr::read_tsv(file = inFile$datapath, col_names = FALSE)
GroupVect <- unlist(PlainFile[,2])
names(GroupVect) <- unlist(PlainFile[,1])
return(GroupVect)
}
})
# Load previos ROMA file link ---------------------------------------------------------
LoadPastRoma <- reactive({
print("Loading data")
FileName <- input$prev.rRoma
if(!is.null(FileName)){
print("Setting upload timestamp")
TimeVect["Upload"] <<- Sys.time()
return(FileName)
}
return(NULL)
})
# Do rROMA ---------------------------------------------------------
RunROMA <- eventReactive(input$doROMA, {
print("Running ROMA")
print("Reading expression matrix")
MatData <- GetExpMat()
if(is.null(MatData)){
print("No expression matrix loaded")
return(NULL)
} else {
print(paste("A", dim(ExpMat), "has been loaded"))
}
print("Reading group information")
GroupVect <- GetGroups()
print("Reading modules information")
ModuleList <- GetModuleList()
if(is.null(ModuleList)){
print("No modules loaded")
return(NULL)
}
Cleaned_OutGeneSpace <- NULL
if(input$par_OutGeneSpace != "NULL"){
Cleaned_OutGeneSpace <- as.numeric(input$par_OutGeneSpace)
}
Cleaned_PCSignThr <- NULL
if(input$par_PCSignThr != "NULL"){
Cleaned_PCSignThr <- as.numeric(input$par_PCSignThr)
}
TimeVect["Analysis"] <<- Sys.time()
RomaData <- rRoma.R(
ExpressionMatrix = MatData, ModuleList = ModuleList,
FixedCenter = eval(parse(text=input$par_FixedCenter)),
PCSignMode = input$par_PCSignMode,
nSamples = as.integer(input$par_nSamples),
GeneOutThr = as.integer(input$par_GeneOutThr),
UseParallel = eval(parse(text=input$par_UseParallel)),
nCores = as.integer(input$par_nCores),
ClusType = input$par_ClusType,
UseWeigths = eval(parse(text=input$par_UseWeigths)),
FullSampleInfo = eval(parse(text=input$par_FullSampleInfo)),
centerData = eval(parse(text=input$par_centerData)),
GeneSelMode = input$par_GeneSelMode,
Ncomp = as.integer(input$par_Ncomp),
DefaultWeight = as.numeric(input$par_DefaultWeight),
SampleFilter = eval(parse(text=input$par_SampleFilter)),
ExpFilter = eval(parse(text=input$par_ExpFilter)),
MoreInfo = eval(parse(text=input$par_MoreInfo)),
GeneOutDetection = input$par_GeneOutDetection,
OutGeneNumber = as.numeric(input$par_OutGeneNumber),
OutGeneSpace = Cleaned_OutGeneSpace,
MinGenes = as.integer(input$par_MinGenes),
MaxGenes = as.integer(input$par_MaxGenes),
ApproxSamples = as.numeric(input$par_ApproxSamples),
CorMethod = input$par_CorMethod,
PCSignThr = Cleaned_PCSignThr,
PlotData = FALSE, PCADims = 2, SamplingGeneWeights = NULL, FillNAMethod = list(),
Grouping = NULL, GroupPCSign = FALSE,
PCAType = input$par_PCAType
)
TimeVect["Analysis"] <<- Sys.time()
return(RomaData)
}, ignoreInit = FALSE, ignoreNULL = FALSE)
# Do print ROMA results ---------------------------------------------------------
output$ROMAOut <- renderUI({
ExpMat <- GetExpMat()
GroupMat <- GetGroups()
# Get expression matrix
if(!is.null(ExpMat)){
str1 <- "Expression matrix loaded"
} else {
str1 <- "Expression matrix missing"
}
if(!is.null(GroupMat)){
if(input$usegroups){
str2 <- "Group data loaded"
} else {
str2 <- "Group data loaded, but ignored"
}
} else {
str2 <- "Group information missing"
}
return(HTML(paste(str1, str2, sep = '<br/>')))
})
output$ROMAOut2 <- renderUI({
ModuleList <- GetModuleList()
# Get expression matrix
if(!is.null(ModuleList)){
return(HTML("Geneset list loaded"))
}
})
# data table for GMT ---------------------------------------------------------
output$PrintGMT <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
ModuleDF <- data.frame(Names = unlist(lapply(RomaData$ModuleSummary, "[[", "ModuleName")),
Genes = unlist(lapply(lapply(RomaData$ModuleSummary, "[[", "UsedGenes"), length)))
ModuleDF[order(ModuleDF$Names),]
})
# parameter list ---------------------------------------------------------
output$PrintPar <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
ToUse <- !(names(RomaData$InputPars) %in% c("ModuleList", "SamplingGeneWeights", "Grouping"))
ModuleDF <- data.frame(Parameter = names(RomaData$InputPars[ToUse]),
Value = as.character(RomaData$InputPars[ToUse])
)
ModuleDF[order(ModuleDF$Parameter),]
})
# Group information ---------------------------------------------------------
output$PrintGroup <- renderDataTable({
RomaData <- GetData()
if(is.null(RomaData$Groups)){
return(NULL)
}
ModuleDF <- data.frame(Sample = names(RomaData$Groups),
Group = RomaData$Groups)
rownames(ModuleDF) <- NULL
ModuleDF
})
# download data ---------------------------------------------------------
output$downloadData <- downloadHandler(
filename = function() {
paste('rRoma-', Sys.Date(), '.rds', sep='')
},
content = function(con) {
rRomaDashData <- list(RomaData = GetData()$RomaData,
ModuleList = GetModuleList(),
ExpMat = GetData()$ExpMat,
Groups = GetData()$Groups)
saveRDS(rRomaDashData, con)
}
)
# load data ---------------------------------------------------------
GetData <- reactive({
print("Trying to load past ROMA data")
LoadDataStatus <- LoadPastRoma()
print("Trying to run ROMA with input data")
LoadInputStatus <- RunROMA()
print("Trying to load previous ROMA data from the running computer")
LoadServerStatus <- LoadFromServer()
print(TimeVect)
print(StartTime)
print(all(TimeVect == StartTime))
if(all(TimeVect == StartTime)){
return(list(
RomaData = RomaData,
ExpMat = ExpMat,
FoundSamp = FoundSamp,
Groups = Groups,
AddInfo = AddInfo,
GSList = GSList,
PCAProj = PCAProj,
ProcessedSamples = ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Upload"]){
print(paste("Loading", LoadDataStatus$datapath))
LoadedData <- readRDS(LoadDataStatus$datapath)
InitReturn <- Initialize(LoadedData$RomaData, LoadedData$ExpMat, LoadedData$Groups)
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
print("Passing on the information from the uploaded rds")
return(list(
RomaData = LoadedData$RomaData,
ExpMat = LoadedData$ExpMat,
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Analysis"]){
print("Passing on the information from the analysis")
InitReturn <- Initialize(LoadInputStatus, GetExpMat(), GetGroups())
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
return(list(
RomaData = LoadInputStatus,
ExpMat = GetExpMat(),
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Local"]){
print(paste("Loading", LoadServerStatus))
LoadedData <- readRDS(LoadServerStatus)
InitReturn <- Initialize(LoadedData$RomaData, LoadedData$ExpMat, LoadedData$Groups)
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
print("Passing on the information from the local rds")
return(list(
RomaData = LoadedData$RomaData,
ExpMat = LoadedData$ExpMat,
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
})
# select module ---------------------------------------------------------
SelectedGS <- reactive({
as.integer(input$gs)
})
# Do tSNE ---------------------------------------------------------
GettSNEGS <- eventReactive(input$dotSNE, {
if(input$prjt == "tSNE"){
ExpMat <- GetData()$ExpMat
ProcessedSamples <- GetData()$ProcessedSamples
initial_dims <- as.integer(input$initial_dims)
if(initial_dims < 2){
initial_dims = 2
}
updateNumericInput(session, "initial_dims", value = initial_dims)
tSNEProj <- Rtsne::Rtsne(X = t(ExpMat[,ProcessedSamples]), perplexity = input$perp, initial_dims = initial_dims)$Y
rownames(tSNEProj) <- ProcessedSamples
colnames(tSNEProj) <- c("PC1", "PC2")
print("tSNE computed")
return(tSNEProj)
}
}, ignoreInit = TRUE)
# Select modules using conditions ---------------------------------------------------------
SelectedIdx <- reactive({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
SelectGeneSets(RomaData = RomaData,
VarThr = 10^input$pdisp, VarMode = "Wil", VarType = input$disp,
MedThr = 10^input$pexp, MedMode = "Wil", MedType = input$exp,
RatThr = 10^input$pcoord, RatMode = "Wil", RatType = input$coord)
})
# Update single module input ---------------------------------------------------------
observe({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
Idx <- SelectedIdx()
if(length(Idx)>0){
GSList <- Idx
names(GSList) <- as.list(rownames(RomaData$SampleMatrix)[Idx])
GSList <- GSList[order(names(GSList))]
} else {
GSList <- list(" " = "")
}
updateSelectInput(session, "gs", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "gs_x", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "gs_y", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "selgroup", choices = as.list(unique(Groups)))
})
# print module information ---------------------------------------------------------
output$info <- renderUI({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
str1 <- paste("Number of genes = ", length(RomaData$ModuleSummary[[SelectedGS()]]$UsedGenes))
str2 <- paste("Overdispersed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 1]))
str3 <- paste("Underdispersed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 2]))
str4 <- paste("Overcoordinated PV = ", signif(RomaData$PVVectMat[SelectedGS(), 3]))
str5 <- paste("Undercoordinated PV = ", signif(RomaData$PVVectMat[SelectedGS(), 4]))
str6 <- paste("Overexpressed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 5]))
str7 <- paste("Underexpressed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 6]))
HTML(paste(str1, str2, str3, str4, str5, str6, str7, sep = '<br/>'))
})
# sample diag boxplots ---------------------------------------------------------
output$SamplesBoxPlot <- renderPlot({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
SeID <- SelectedGS()
Sampled.DF <- t(rbind(sapply(RomaData$ModuleSummary[[SeID]]$SampledExp, "[[", "ExpVar")[1:2,],
sapply(RomaData$ModuleSummary[[SeID]]$SampledExp, "[[", "MedianExp")))
Sampled.DF <- cbind(Sampled.DF, Sampled.DF[,1]/Sampled.DF[,2])
colnames(Sampled.DF) <- c("L1", "L2", "Exp", "L1/L2")
Sampled.DF <- reshape::melt(Sampled.DF)
Sampled.DF <- cbind(Sampled.DF, rep("Samples", nrow(Sampled.DF)))
colnames(Sampled.DF)[4] <- "Org"
Sampled.DF$Org <- factor(as.character(Sampled.DF$Org), levels = c("Samples", "Data"))
Sampled.DF <- rbind(Sampled.DF,
c(max(Sampled.DF$X1)+1,
"L1",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[1],
"Data"),
c(max(Sampled.DF$X1)+2,
"L2",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[2],
"Data"),
c(max(Sampled.DF$X1)+3,
"L1/L2",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[1]/RomaData$ModuleSummary[[SeID]]$ExpVarBase[2],
"Data"),
c(max(Sampled.DF$X1)+4,
"Exp",
RomaData$ModuleMatrix[SeID,"Median Exp"],
"Data")
)
Sampled.DF <- data.frame(Sampled.DF)
Sampled.DF$X2 <- factor(as.character(Sampled.DF$X2), levels = c("L1", "L2", "L1/L2", "Exp"))
Sampled.DF$value <- as.numeric(as.character(Sampled.DF$value))
p1 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("L1", "L2"), ],
ggplot2::aes(y = value, x = X2, color = Org)) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free_x", ncol = 4) +
ggplot2::scale_color_manual(values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("L1", "L2"), ],
ggplot2::aes(y = value, x = X2, color = Org), inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Explained variance") +
ggplot2::guides(color=FALSE) +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
p2 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("L1/L2"), ],
ggplot2::aes(y = value, x = X2, color = Org)) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free", ncol = 4) +
ggplot2::scale_color_manual(values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("L1/L2"), ],
ggplot2::aes(y = value, x = X2, color = Org), inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Ratio") +
ggplot2::guides(color=FALSE) +
ggplot2::scale_y_log10() +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
p3 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("Exp"), ],
ggplot2::aes(y = value, x = X2, color = "Samples")) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free", ncol = 4) +
ggplot2::scale_color_manual("", values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("Exp"), ],
ggplot2::aes(y = value, x = X2, color = Org),
inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Median Expression") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
gridExtra::grid.arrange(p1, p2, p3, ncol = 3, widths=c(2,1,1.5))
})
# single sample boxplot ---------------------------------------------------------
output$boxPlot <- renderPlot({
if(is.na(SelectedGS())){
return(NULL)
}
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
DataToPlot <- data.frame(Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples])
p <- ggplot2::ggplot(data = DataToPlot, ggplot2::aes(x = Group, y = Score)) +
ggplot2::geom_boxplot()
if(length(unique(Groups[ProcessedSamples]))>1 & input$boxcomp != "Show none"){
if(input$boxcomp == "Show all"){
ToDisplay <- GetComb(unique(Groups[ProcessedSamples]))
}
if(input$boxcomp == "Show significant"){
PWComp <- pairwise.wilcox.test(DataToPlot$Score, DataToPlot$Group)$p.value
ExtPWComp <- matrix(rep(NA, length(unique(DataToPlot$Group))^2), nrow = length(unique(DataToPlot$Group)))
colnames(ExtPWComp) <- sort(unique(DataToPlot$Group))
rownames(ExtPWComp) <- colnames(ExtPWComp)
ExtPWComp[rownames(PWComp), colnames(PWComp)] <- PWComp
ToDisplay <- apply(which(ExtPWComp <= .05, arr.ind = TRUE), 1, list)
ToDisplay <- lapply(ToDisplay, function(x){as.integer(unlist(x))})
# names(ToDisplay) <- NULL
}
p <- p + ggsignif::geom_signif(comparisons = ToDisplay, map_signif_level=TRUE, test = "wilcox.test", step_increase = .1)
}
print(p)
})
# PCA / tSNE plot ---------------------------------------------------------
if(Interactive){
output$scatPlot <- renderPlotly({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
if(is.null(RomaData)){
return(NULL)
}
input$dotSNE
if(input$prjt == "PCA"){
print("using PCA")
Projs <- GetData()$PCAProj
}
if(input$prjt == "tSNE"){
print("using tSNE")
Projs <- GettSNEGS()
}
p <- ggplot2::ggplot(data = data.frame(Comp1 = Projs[,1],
Comp2 = Projs[,2],
Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = Comp1, y = Comp2, shape = Group, color = Score)) +
ggplot2::scale_color_gradient2(low = "blue", high = "red", mid = "white") +
ggplot2::labs(x = "Component 1", y = "Component 2", shape = "",
title = rownames(RomaData$SampleMatrix)[SelectedGS()]) +
ggplot2::geom_point(ggplot2::aes(text = rownames(Projs)))
print(ggplotly(p))
})
} else {
output$scatPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
if(is.null(RomaData)){
return(NULL)
}
input$dotSNE
if(input$prjt == "PCA"){
print("using PCA")
Projs <- GetData()$PCAProj
}
if(input$prjt == "tSNE"){
print("using tSNE")
Projs <- GettSNEGS()
}
p <- ggplot2::ggplot(data = data.frame(Comp1 = Projs[,1],
Comp2 = Projs[,2],
Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = Comp1, y = Comp2, shape = Group, color = Score)) +
ggplot2::scale_color_gradient2(low = "blue", high = "red", mid = "white") +
ggplot2::labs(x = "Component 1", y = "Component 2", shape = "",
title = rownames(RomaData$SampleMatrix)[SelectedGS()]) +
ggplot2::geom_point(size = 3)
print(p)
})
}
# heatmap (modules) plot ---------------------------------------------------------
output$hmPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
PlotMat <- RomaData$SampleMatrix[Idx,]
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(input$GSOrdeMode == "None"){
GSOrdering <- order(rownames(RomaData$SampleMatrix[Idx,]))
GSCat <- NA
}
if(input$GSOrdeMode == "Gene number"){
nGenes <- unlist(lapply(lapply(RomaData$ModuleSummary[Idx], "[[", "UsedGenes"), length))
GSOrdering <- order(nGenes)
GSCat[] = nGenes
GSCat <- data.frame(Genes = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat <- data.frame("OD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat <- data.frame("UD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overcoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat <- data.frame("OC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Undercoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat <- data.frame("UC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat <- data.frame("OE lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat <- data.frame("UE lpv" = signif(GSCat, 2))
}
if(input$htype == "sample"){
MinMax <- range(PlotMat)
# print(MinMax)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
SatLL <- input$llim
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1]+SatLL/28, seq(from = SatLL*(26/27), to = 0, by = -SatLL/27))
} else {
DoLow <- FALSE
}
SatUL <- input$ulim
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = SatUL/27, to = (26/27)*SatUL, by = SatUL/27), MinMax[2] + SatUL/28)
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(SatLL < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
} else {
MyBreaks <- 0
UseCol <- NULL
}
if(DoHigh){
if(SatUL > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, HighBrk[2])
UseCol <- c(UseCol, 54)
}
}
if(length(Idx)>1){
if(input$gscol){
pheatmap::pheatmap(PlotMat[GSOrdering,], color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$saclus,
annotation_col = AddInfo,
annotation_row = GSCat,
main = "Module scores across samples")
} else {
pheatmap::pheatmap(t(PlotMat[GSOrdering,]), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = input$gsclus,
annotation_row = AddInfo,
annotation_col = GSCat,
main = "Module scores across samples")
}
}
if(length(Idx) == 1){
PlotMat <- matrix(PlotMat, nrow = 1)
colnames(PlotMat) <- colnames(RomaData$SampleMatrix)
if(input$gscol){
pheatmap::pheatmap(PlotMat, color = BaseCol[UseCol], breaks = MyBreaks,
cluster_cols = input$saclus, cluster_rows = FALSE,
annotation_col = AddInfo,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
} else {
pheatmap::pheatmap(t(PlotMat), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = FALSE,
annotation_row = AddInfo,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
# pheatmap::pheatmap(PlotMat, BaseCol[UseCol], breaks = MyBreaks,
# cluster_rows = FALSE, cluster_cols = FALSE,
# main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(PlotMat[,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
MinMax <- range(Aggmat)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
SatLL <- input$llim
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1]+SatLL/28, seq(from = SatLL*(26/27), to = 0, by = -SatLL/27))
} else {
DoLow <- FALSE
}
SatUL <- input$ulim
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = SatUL/27, to = (26/27)*SatUL, by = SatUL/27), MinMax[2] + SatUL/28)
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(SatLL < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
} else {
MyBreaks <- 0
UseCol <- NULL
}
if(DoHigh){
if(input$ulim > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, HighBrk[2])
UseCol <- c(UseCol, 54)
}
}
if(input$gscol){
pheatmap::pheatmap(Aggmat[GSOrdering,], color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$saclus,
annotation_row = GSCat, main = "Module scores across groups")
} else {
pheatmap::pheatmap(t(Aggmat[GSOrdering,]), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = input$gsclus,
annotation_col = GSCat, main = "Module scores across groups")
}
}
if(length(Idx) == 1){
# names(PlotMat) <- colnames(RomaData$SampleMatrix)
SplitData <- split(data.frame(PlotMat[FoundSamp]), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
do.call(input$aggfun, list(unlist(x)))
})
MinMax <- range(Aggmat)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1], seq(from = input$llim*(26/27), to = 0, by = -input$llim/27))
if(LowBrk[1] != min(LowBrk)){
LowBrk[1] <- min(LowBrk) + input$llim/27
}
} else {
DoLow <- FALSE
}
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = input$ulim/27, to = (26/27)*input$ulim, by = input$ulim/27), MinMax[2])
if(HighBrk[length(HighBrk)] != max(HighBrk)){
HighBrk[length(HighBrk)] <- max(HighBrk) + input$ulim/27
}
if(HighBrk[1] == 0){
HighBrk <- HighBrk[-1]
}
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(input$llim < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1,27)
}
} else {
MyBreaks <- 0
UseCol <- 27
}
if(DoHigh){
MyBreaks <- c(MyBreaks, HighBrk)
if(input$ulim > 0){
UseCol <- c(UseCol, 28:54)
} else {
UseCol <- c(UseCol, 28, 54)
}
}
pheatmap::pheatmap(t(Aggmat), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = FALSE, cluster_cols = FALSE,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
}
})
# corr heatmap ---------------------------------------------------------
output$CorHmPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(input$GSOrdeMode == "None"){
GSOrdering <- order(rownames(RomaData$SampleMatrix[Idx,]))
GSCat <- NA
}
if(input$GSOrdeMode == "Gene number"){
nGenes <- unlist(lapply(lapply(RomaData$ModuleSummary[Idx], "[[", "UsedGenes"), length))
GSOrdering <- order(nGenes)
GSCat[] = nGenes
GSCat <- data.frame(Genes = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat <- data.frame("OD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat <- data.frame("UD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overcoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat <- data.frame("OC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Undercoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat <- data.frame("UC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat <- data.frame("OE lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat <- data.frame("UE lpv" = signif(GSCat, 2))
}
LowBrk <- c(-1.01, seq(from = input$lcor*(26/27), to = 0, by = -input$lcor/27))
HighBrk <- c(seq(from = input$ucor/27, to = (26/27)*input$ucor, by = input$ucor/27), 1.01)
MyBreaks <- LowBrk
if(input$lcor < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
if(input$ucor > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, 1.01)
UseCol <- c(UseCol, 54)
}
if(input$htype == "sample"){
if(length(Idx)>1){
pheatmap::pheatmap(cor(t(RomaData$SampleMatrix[Idx,]), method = input$cortype)[GSOrdering, GSOrdering],
color = BaseCol[UseCol], breaks = MyBreaks,
annotation_row = GSCat, annotation_col = GSCat,
cluster_rows = input$gsclus, cluster_cols = input$gsclus,
main = "Correlation across samples")
}
if(length(Idx) == 1){
NULL
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(RomaData$SampleMatrix[Idx,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
pheatmap::pheatmap(cor(t(Aggmat), method = input$cortype)[GSOrdering, GSOrdering],
color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$gsclus,
annotation_row = GSCat, annotation_col = GSCat,
main = "Correlation across groups")
}
if(length(Idx) == 1){
NULL
}
}
})
# corr scatplot ---------------------------------------------------------
if(Interactive){
output$CorScatPlot <- renderPlotly({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
XLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_x)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
YLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_y)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
CTitle <- cor(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
method = input$cortype)
if(input$htype == "sample"){
p <- ggplot2::ggplot(data = data.frame(XVal = RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
YVal = RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point(ggplot2::aes(text = ProcessedSamples))
}
if(input$htype == "group"){
AggX <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
AggY <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
p <- ggplot2::ggplot(data = data.frame(XVal = AggX[,2],
YVal = AggY[,2],
Group = AggX[,1]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point(ggplot2::aes(text = AggX[,1]))
}
print(ggplotly(p))
})
} else {
output$CorScatPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
XLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_x)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
YLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_y)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
CTitle <- cor(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
method = input$cortype)
if(input$htype == "sample"){
p <- ggplot2::ggplot(data = data.frame(XVal = RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
YVal = RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point()
}
if(input$htype == "group"){
AggX <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
AggY <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
p <- ggplot2::ggplot(data = data.frame(XVal = AggX[,2],
YVal = AggY[,2],
Group = AggX[,1]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point()
}
print(p)
})
}
# Selected GS datatable ---------------------------------------------------------
output$SelGSTable <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
} else {
SelIdxs <- SelectedIdx()
RetDF <- data.frame(Names = unlist(lapply(RomaData$ModuleSummary[SelIdxs], "[[", "ModuleName"), use.names = FALSE))
return(RetDF)
}
})
# Update available samples ---------------------------------------------------------
observe({
RomaData <- GetData()$RomaData
if(!is.null(RomaData)){
Samples <- colnames(RomaData$SampleMatrix)
updateCheckboxGroupInput(session, "selSamples", choices = Samples, inline = TRUE)
}
})
# Plot on ACSN ---------------------------------------------------------
GetACSN <- eventReactive(input$doACSN, {
print("Initiating ACSN plotting")
SelIdxs <- SelectedIdx()
RomaData <- GetData()$RomaData
if(!is.null(input$selSamples) & !is.null(RomaData) & !is.null(SelIdxs)){
RetData <- PlotOnACSN(
RomaData = RomaData, SampleName = input$selSamples, AggScoreFun = input$scoreaggfun,
MapURL = input$mapurl, Selected = SelIdxs, FilterByWei = as.numeric(input$ACSNWeiFil),
AggGeneFun = input$geneaggfun, DispMode = input$projtype, DefDispVal = 0,
PlotInfo = FALSE, ReturnInfo = TRUE, LocalRange = FALSE)
} else {
RetData <- NULL
}
return(RetData)
}, ignoreInit = TRUE, ignoreNULL = FALSE)
# Include Status (ACSN) ---------------------------------------------------------
output$ACSNStatus <- renderUI({
Test <- GetACSN()
if(is.null(Test)){
HTML("<i>Data not exported on ACSN</i>")
} else {
HTML("<b>Data exported to ACSN</b>")
}
})
# Plot weigth variation (ACSN) ---------------------------------------------------------
output$WeiVarBP <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
p <- ggplot2::ggplot(data = data.frame(y = Data$GenesVar,
x = rep(1, length(Data$GenesVar))),
mapping = ggplot2::aes(x = x, y = y)) +
ggplot2::geom_boxplot(mapping = ggplot2::aes(color = "Data")) +
ggplot2::labs(y = "Variance of gene weight") + ggplot2::scale_y_log10() +
ggplot2::scale_color_manual("", values = c(Data="black", Outliers="red")) +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
if(sum(Data$GeneOut) > 1){
p <- p + ggplot2::geom_point(data = data.frame(x = rep(1, length(which(Data$GeneOut))),
y = Data$GenesVar[names(which(Data$GeneOut))]),
mapping = ggplot2::aes(x = x, y = y, color="Outliers"), size = 3,
inherit.aes = FALSE)
}
print(p)
}
})
# Plot gene multiplicity (ACSN) ---------------------------------------------------------
output$GeneMult <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if(!is.null(Data$GeneMult)){
p <- ggplot2::ggplot(data = data.frame(Data$GeneMult),
mapping = ggplot2::aes(x = Freq)) +
ggplot2::geom_histogram(binwidth = 1) +
ggplot2::labs(y = "Frequency", x = "Gene multiplicity")
print(p)
}
}
})
# Plot score distribution (ACSN) ---------------------------------------------------------
output$ScoreDist <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if((input$projtype == "Module") & !is.null(Data$GeneMult)){
p <- ggplot2::ggplot(data = data.frame(Data$ScoreDist,
x = rep(1, length(Data$ScoreDist))),
mapping = ggplot2::aes(x = x, y = data)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score (Module)", x = "") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
if((input$projtype == "Gene") & !is.null(Data$WeiDist)){
p <- ggplot2::ggplot(data = data.frame(Data$WeiDist,
x = rep(1, length(Data$WeiDist))),
mapping = ggplot2::aes(x = x, y = data)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score (Weight)", x = "") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
}
})
# Plot score variance (ACSN) ---------------------------------------------------------
output$ScoreVar <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if((input$projtype == "Module") & !is.null(Data$ScoreVar)){
p <- ggplot2::ggplot(data = data.frame(y = Data$ScoreVar,
x = rep(1, length(Data$ScoreVar))),
mapping = ggplot2::aes(x = x, y = y)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score variance (per gene with multiplicity > 1)", x = "") +
ggplot2::scale_y_log10() +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
}
})
# Select samples by group (ACSN) ---------------------------------------------------------
observeEvent(input$selByGroup, {
Groups <- GetData()$Groups
updateCheckboxGroupInput(session, "selSamples", selected = unique(c(names(Groups[Groups == input$selgroup]),
input$selSamples)))
}, ignoreNULL = FALSE, ignoreInit = TRUE)
# Clear selection (ACSN) ---------------------------------------------------------
observeEvent(input$selNone, {
updateCheckboxGroupInput(session, "selSamples", selected = "")
}, ignoreNULL = FALSE, ignoreInit = TRUE)
# Compute Correlations (Gene contribution) ---------------------------------------------------------
GetCorrs <- eventReactive(input$doCorr, {
ExpMat <- GetData()$ExpMat
RomaData <- GetData()$RomaData
ModuleID <- SelectedGS()
CorInfo <- GetCorrelations(RomaData = RomaData, Selected = ModuleID, MatData = ExpMat,
Methods = input$cortype, ConfLevel = as.numeric(input$corlelvel))
return(list(CorInfo = CorInfo, Method = input$cortype, ModuleID = ModuleID))
}, ignoreInit = TRUE)
output$CorrCI <- renderPlot({
AllGenesCorr <- GetCorrs()$CorInfo$Genes
if(GetCorrs()$Method != input$cortype | GetCorrs()$ModuleID != SelectedGS()){
updateSelectInput(session, "availGenes", choices = list())
return(NULL)
}
# Filter genes
AllGenesCorr <- AllGenesCorr[as.numeric(AllGenesCorr[,"p.val"]) <= (1 - as.numeric(input$corlelvel)), ]
# Get direction
SelGenes <- NULL
if(input$contribType == "Positive"){
SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) > 0)
}
if(input$contribType == "Negative"){
SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) < 0)
}
if(length(SelGenes) == 0){
return(NULL)
updateSelectInput(session, "availGenes", choices = list())
}
GeneNames <- AllGenesCorr[SelGenes, "gene"]
GeneLabels <- paste(GeneNames, signif(as.numeric(AllGenesCorr[SelGenes, "cor"]), 4),
sep = ' | cor = ')
RetList <- as.list(GeneNames)
names(RetList) <- GeneLabels
updateSelectInput(session, "availGenes",
choices = RetList[order(as.numeric(AllGenesCorr[SelGenes, "cor"]))])
AllGenesCorr.DF <- data.frame(AllGenesCorr[SelGenes,])
AllGenesCorr.DF$cor <- as.numeric(as.character(AllGenesCorr.DF$cor))
AllGenesCorr.DF$p.val <- as.numeric(as.character(AllGenesCorr.DF$p.val))
AllGenesCorr.DF$gene <- factor(as.character(AllGenesCorr.DF$gene),
levels = as.character(AllGenesCorr.DF$gene)[order(AllGenesCorr.DF$cor)])
if(input$cortype == "pearson"){
AllGenesCorr.DF$ci.low <- as.numeric(as.character(AllGenesCorr.DF$ci.low))
AllGenesCorr.DF$ci.high <- as.numeric(as.character(AllGenesCorr.DF$ci.high))
p <- ggplot2::ggplot(data = AllGenesCorr.DF,
ggplot2::aes(x = gene, y = cor, ymin = ci.low, ymax = ci.high)) +
ggplot2::geom_pointrange() + ggplot2::geom_point() + ggplot2::coord_flip() +
ggplot2::labs(y = "Correlation")
} else {
p <- ggplot2::ggplot(data = AllGenesCorr.DF,
ggplot2::aes(x = gene, y = cor)) +
ggplot2::geom_point() + ggplot2::coord_flip() +
ggplot2::labs(y = "Correlation")
}
if(input$contribType == "Positive"){
p <- p + ggplot2::scale_y_continuous(limits = c(0, 1))
}
if(input$contribType == "Negative"){
p <- p + ggplot2::scale_y_continuous(limits = c(-1, 0))
}
print(p)
})
output$ExpProj <- renderPlot({
if(input$availGenes != ""){
GeneExp <- GetData()$ExpMat[input$availGenes, ]
ModScore <- GetData()$RomaData$SampleMatrix[SelectedGS(),]
SampleNames <- intersect(names(GeneExp), names(ModScore))
NewDF <- data.frame(Samples = SampleNames,
Expression = GeneExp[SampleNames],
Score = ModScore[SampleNames],
Groups = GetData()$Groups)
p <- ggplot2::ggplot(data = NewDF, ggplot2::aes(x = Score, y = Expression)) +
ggplot2::geom_smooth() +
ggplot2::geom_point(mapping = ggplot2::aes(color = Groups)) +
ggplot2::labs(x = "Module score", y = "Gene expression")
print(p)
}
})
# Compute Top contributing genes ---------------------------------------------------------
GetContrGenes <- eventReactive(input$doTop, {
ExpMat <- GetData()$ExpMat
RomaData <- GetData()$RomaData
ModuleIDs <- SelectedIdx()
print(ModuleIDs)
print(as.numeric(input$gperc)/100)
print(input$contrMode)
print(input$contrType)
print(input$corrType)
TopContrGenes <- GetTopContrib(RomaData = RomaData, Selected = ModuleIDs, ExpressionMatrix = ExpMat,
nGenes = as.numeric(input$gperc)/100, Mode = input$contrMode,
OrderType = input$contrType, CorMethod = input$corrType,
ColorGradient = colorRamps::blue2red(50),
Plot = FALSE, cluster_cols = FALSE, HMTite = "Top contributing genes")
# print(data.frame(TopContrGenes$Table))
# output$TopContributingGenes <- renderDataTable({data.frame(TopContrGenes$RetTable)})
return(list(RetTable = TopContrGenes$Table))
}, ignoreInit = TRUE)
output$TopContributingGenes <- renderDataTable({
return(data.frame(GetContrGenes()$RetTable))
})
# output$CorrCI <- renderPlot({
#
# AllGenesCorr <- GetCorrs()$CorInfo$Genes
#
# if(GetCorrs()$Method != input$cortype | GetCorrs()$ModuleID != SelectedGS()){
# updateSelectInput(session, "availGenes", choices = list())
# return(NULL)
# }
#
# # Filter genes
#
# AllGenesCorr <- AllGenesCorr[as.numeric(AllGenesCorr[,"p.val"]) <= (1 - as.numeric(input$corlelvel)), ]
#
# # Get direction
#
# SelGenes <- NULL
#
# if(input$contribType == "Positive"){
# SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) > 0)
# }
#
# if(input$contribType == "Negative"){
# SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) < 0)
# }
#
# if(length(SelGenes) == 0){
# return(NULL)
# updateSelectInput(session, "availGenes", choices = list())
# }
#
# GeneNames <- AllGenesCorr[SelGenes, "gene"]
# GeneLabels <- paste(GeneNames, signif(as.numeric(AllGenesCorr[SelGenes, "cor"]), 4),
# sep = ' | cor = ')
#
# RetList <- as.list(GeneNames)
# names(RetList) <- GeneLabels
#
# updateSelectInput(session, "availGenes",
# choices = RetList[order(as.numeric(AllGenesCorr[SelGenes, "cor"]))])
#
#
# AllGenesCorr.DF <- data.frame(AllGenesCorr[SelGenes,])
# AllGenesCorr.DF$cor <- as.numeric(as.character(AllGenesCorr.DF$cor))
# AllGenesCorr.DF$p.val <- as.numeric(as.character(AllGenesCorr.DF$p.val))
# AllGenesCorr.DF$gene <- factor(as.character(AllGenesCorr.DF$gene),
# levels = as.character(AllGenesCorr.DF$gene)[order(AllGenesCorr.DF$cor)])
#
# if(input$cortype == "pearson"){
# AllGenesCorr.DF$ci.low <- as.numeric(as.character(AllGenesCorr.DF$ci.low))
# AllGenesCorr.DF$ci.high <- as.numeric(as.character(AllGenesCorr.DF$ci.high))
#
# p <- ggplot2::ggplot(data = AllGenesCorr.DF,
# ggplot2::aes(x = gene, y = cor, ymin = ci.low, ymax = ci.high)) +
# ggplot2::geom_pointrange() + ggplot2::geom_point() + ggplot2::coord_flip() +
# ggplot2::labs(y = "Correlation")
#
# } else {
#
# p <- ggplot2::ggplot(data = AllGenesCorr.DF,
# ggplot2::aes(x = gene, y = cor)) +
# ggplot2::geom_point() + ggplot2::coord_flip() +
# ggplot2::labs(y = "Correlation")
#
# }
#
#
# if(input$contribType == "Positive"){
# p <- p + ggplot2::scale_y_continuous(limits = c(0, 1))
# }
#
# if(input$contribType == "Negative"){
# p <- p + ggplot2::scale_y_continuous(limits = c(-1, 0))
# }
#
# print(p)
#
# })
# Correlation network ---------------------------------------------------------
output$CorNet <- renderVisNetwork({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(length(Idx) == 0){
return(NULL)
}
if(input$htype == "sample"){
if(length(Idx)>1){
CorMat <- cor(t(RomaData$SampleMatrix[Idx,]), method = input$cortype)
}
if(length(Idx) == 1){
return(NULL)
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(RomaData$SampleMatrix[Idx,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
CorMat <- cor(t(Aggmat), method = input$cortype)
}
if(length(Idx) == 1){
return(NULL)
}
}
CorMat[abs(CorMat) < input$corthr] <- 0
# CorMat <- CorMat[any(rowSums(abs(CorMat)>0)>0),
# any(colSums(abs(CorMat)>0)>0)]
CorMat[upper.tri(CorMat, diag = TRUE)] <- 0
print(CorMat)
nodes <- data.frame(id = 1:nrow(CorMat),
label = rownames(CorMat))
tEgd <- which(abs(CorMat) > 0, arr.ind = TRUE)
CorValVect <- CorMat[which(abs(CorMat) > 0)]
ColVect <- rep("blue", length(CorValVect))
ColVect[CorValVect > 0] <- "red"
print(ColVect)
print(tEgd)
edges <- data.frame(from = tEgd[,1], to = tEgd[,2], color = ColVect, title = CorValVect, value = abs(CorValVect), physics = FALSE)
return(visNetwork(nodes, edges))
# minimal example
})
# Save data locally ---------------------------------------------------------
observe({
fileinfo <- parseSavePath(Volumes, input$save)
if (nrow(fileinfo) > 0) {
RomaData <- GetData()$RomaData
ModuleList <- GetModuleList()
ExpMat <- GetData()$ExpMat
Groups <- GetData()$Groups
print(is.null(RomaData))
print(is.null(ModuleList))
print(is.null(ExpMat))
print(is.null(Groups))
rRomaDashData <- list(RomaData = RomaData,
ModuleList = ModuleList,
ExpMat = ExpMat,
Groups = Groups)
print(paste("Saving to", as.character(fileinfo$datapath)))
saveRDS(rRomaDashData, as.character(fileinfo$datapath))
}
})
# Load data locally ---------------------------------------------------------
LoadFromServer <- reactive({
fileinfo <- parseFilePaths(Volumes, input$load)
if (nrow(fileinfo) > 0) {
print("Setting local timestamp")
TimeVect["Local"] <<- Sys.time()
return(as.character(fileinfo$datapath))
} else {
return(NULL)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
}
Albluca/rRomaDash documentation built on May 6, 2019, 5:58 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions Initialize rRomaDash
Documented in Initialize rRomaDash
#' Title
#'
#' @param RomaData
#' @param ExpMat
#' @param Groups
#'
#' @return
#'
#' @examples
Initialize <- function(RomaData, ExpMat, Groups){
if(is.null(RomaData)){
return(list(FoundSamp = NULL, Groups = Groups, AddInfo = NULL,
SelList = list(), SelListAF = list(), GSList = list(),
PCAProj = NULL, ProcessedSamples = NULL))
}
ProcessedSamples <- colnames(RomaData$SampleMatrix)
if(!is.null(Groups)){
FoundSamp <- intersect(colnames(RomaData$SampleMatrix), names(Groups))
Groups <- Groups[FoundSamp]
if(length(FoundSamp) > 2){
if(!is.factor(Groups)){
Groups <- as.factor(Groups)
}
AddInfo <- data.frame(Groups = Groups)
} else {
AddInfo <- NULL
}
SelList <- list("By sample" = "sample", "By group" = "group")
SelListAF <- list("Mean" = "mean", "Median" = "median", "Std. dev." = "sd", "IQR" = "IQR", "mad" = "mad")
} else {
Groups <- rep("N/A", length(ProcessedSamples))
names(Groups) <- ProcessedSamples
FoundSamp = NULL
AddInfo <- NULL
SelList <- list("By sample" = "sample")
SelListAF <- list()
}
if(length(unique(Groups))<2){
SelList <- list("By sample" = "sample")
SelListAF <- list()
}
if(!is.null(RomaData)){
GSList <- as.list(1:nrow(RomaData$PVVectMat))
names(GSList) <- as.list(rownames(RomaData$SampleMatrix))
GSList <- GSList[order(names(GSList))]
PCAProj <- irlba::prcomp_irlba(t(ExpMat[,ProcessedSamples]), 2, retx = TRUE)$x
rownames(PCAProj) <- ProcessedSamples
colnames(PCAProj) <- c("PC1", "PC2")
} else {
GSList <- list()
PCAProj <- NULL
}
return(list(FoundSamp = FoundSamp, Groups = Groups, AddInfo = AddInfo,
SelList = SelList, SelListAF = SelListAF, GSList = GSList,
PCAProj = PCAProj, ProcessedSamples = ProcessedSamples))
}
#' Launch the rRoma dashboard
#'
#' @param RomaData
#' @param ExpMat
#' @param Groups
#' @param Interactive boolean, scalar. Should interactivity (via Plotly) be enabled?
#'
#' @return
#' @export
#'
#' @examples
rRomaDash <- function(RomaData = NULL,
ExpMat = NULL,
Groups = NULL,
Interactive = FALSE) {
# library(rRoma)
# library(shiny)
# library(shinyFiles)
# preprocess data ---------------------------------------------------------
if(R.utils::isPackageLoaded("plotly")){
print("Detaching plotly.")
detach("package:plotly", unload=TRUE)
}
if(Interactive){
library(plotly)
}
# if(Interactive){
# print("Using plotly. This can cause problems on some systems. Try setting 'Interactive = FALSE' if errors are encountered")
# } else {
#
# }
StartTime <- Sys.time()
print(paste("Interface starting", StartTime))
TimeVect <- rep(StartTime, 3)
names(TimeVect) <- c("Upload", "Local", "Analysis")
InitReturn <- Initialize(RomaData, ExpMat, Groups)
FoundSamp <- InitReturn$FoundSamp
Groups <- InitReturn$Groups
AddInfo <- InitReturn$AddInfo
SelList <- InitReturn$SelList
SelListAF <- InitReturn$SelListAF
GSList <- InitReturn$GSList
PCAProj <- InitReturn$PCAProj
ProcessedSamples <- InitReturn$ProcessedSamples
GeneList <- list()
tSNEProj <- PCAProj
InternalGMTList <- list(
"Molecular signature DB (v6.0)" = "MsigDB",
"ACSN Globlal Map (v1.1)" = "ACSN_Global",
"ACSN Apoptosis Map (v1.1)" = "ACSN_Apoptosis",
"ACSN Cell Cycle Map (v1.1)" = "ACSN_CellCycle",
"ACSN DNA Repair Map (v1.1)" = "ACSN_DNARepair",
"ACSN EMT Map (v1.1)" = "ACSN_EMT",
"ACSN Survival Map (v1.1)" = "ACSN_Survival",
"InfoSigMap Conseved" = "InfoSig_Conserved",
"InfoSigMap" = "InfoSig_Informative"
)
MapList <- list(
"Atlas of Cancer Signalling Network global map" = "https://acsn.curie.fr/navicell/maps/acsn/master/index.php",
"Apoptosis and mitochondria metabolism map" = "https://acsn.curie.fr/navicell/maps/apoptosis/master/index.php",
"Cell survival map" = "https://acsn.curie.fr/navicell/maps/survival/master/index.php",
"EMT and cell motility map" = "https://acsn.curie.fr/navicell/maps/emtcellmotility/master/index.php",
"Cell cycle map" = "https://acsn.curie.fr/navicell/maps/cellcycle/master/index.php",
"DNA repair map" = "https://acsn.curie.fr/navicell/maps/dnarepair/master/index.php",
"InfoSigMap" = "https://navicell.curie.fr/navicell/newtest/maps/infosigmap/master/index.php"
)
nProcList <- as.list(as.character(1:32))
names(nProcList) <- as.character(1:32)
InitialSave <- paste(getwd(), '/', 'rRoma-', Sys.Date(), '.rds', sep = "")
# define ui ---------------------------------------------------------
ui <- navbarPage("rRoma dashboard",
# Perform analysis (Top Tab 1) ---------------------------------------------------------
tabPanel("Analyze Data",
pageWithSidebar(
# Application title
headerPanel(""),
# Sidebar with a slider input
sidebarPanel(
actionButton("doROMA", "Execute rROMA"),
hr(),
htmlOutput("ROMAOut"),
htmlOutput("ROMAOut2")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
# Data input ---------------------------------------------------------
tabPanel("Input",
fluidPage(
fluidRow(
titlePanel("Expression matrix"),
column(8,
fileInput("expmatfile", "Choose an expression matrix (TSV file)", accept = c(".tsv", ".txt"))
)
),
fluidRow(
titlePanel("Sample groups"),
column(8,
fileInput("groupfile", "Choose a group matrix (TSV file)", accept = c(".tsv", ".txt"))
),
column(4,
checkboxInput("usegroups", "Use groups", TRUE)
)
),
fluidRow(
titlePanel("Geneset list"),
column(6,
selectInput("gmtsrc", "Geneset source:",
list("Local file" = "File",
"Internal DB" = "Internal")),
conditionalPanel(
condition="input.gmtsrc == 'File'",
fileInput("gmtfile", "Choose a GMT file", accept = c(".gmt", ".txt"))
),
conditionalPanel(
condition="input.gmtsrc == 'Internal'",
selectInput("gmtlist", "Available geneset list:", InternalGMTList)
),
textInput("msigkw", "Keywords", ""),
checkboxInput("msigkwall", "search all keywords", FALSE),
checkboxInput("loadwei", "load weights", FALSE)
),
column(6,
selectInput("sourceOrg", "Source organism:",
list("H. sapiens" = "hsapiens",
"M. musculus" = "mmusculus")),
selectInput("targetOrg", "Target organism:",
list("H. sapiens" = "hsapiens",
"M. musculus" = "mmusculus")),
selectInput("sourceName", "Source gene ID:",
list("Name" = "Names",
"Ensembl" = "Ensembl")),
selectInput("targetName", "Target gene ID:",
list("Name" = "Names",
"Ensembl" = "Ensembl")),
checkboxInput("convertGeneID", "Convert geneset genes IDs", FALSE)
),
column(12,
actionButton("searchDB", "Search genesets")
)
),
fluidRow(
titlePanel("Available Genesets:"),
column(12,
dataTableOutput("PrintGeneSets"))
)
)
),
# Parameters ---------------------------------------------------------
tabPanel("Parameters",
fluidPage(title = "Base parameters",
titlePanel("Base parameters"),
column(6, selectInput("par_FixedCenter", "FixedCenter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_PCSignMode", "PCSignMode",
list("none" = "none",
"PreferActivation" = "PreferActivation",
"UseAllWeights" = "UseAllWeights",
"UseKnownWeights" = "UseKnownWeights",
"CorrelateAllWeightsByGene" = "CorrelateAllWeightsByGene",
"CorrelateKnownWeightsByGene" = "CorrelateKnownWeightsByGene"),
selected = "CorrelateAllWeightsByGene"),
textInput("par_nSamples", "nSamples", "100"),
textInput("par_GeneOutThr", "GeneOutThr", "5")
),
column(6,
selectInput("par_UseParallel", "UseParallel",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
conditionalPanel(condition="input.par_UseParallel == 'TRUE'",
selectInput("par_nCores", "nCores", nProcList,
selected = as.character(parallel::detectCores() - 1)),
selectInput("par_ClusType", "ClusType",
list("PSOCK", "FORK"), selected = "PSOCK")
)
)
),
fluidPage(title = "Advanced parameters",
titlePanel("Advanced parameters"),
column(4, selectInput("par_UseWeigths", "UseWeigths",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_FullSampleInfo", "FullSampleInfo",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_centerData", "centerData",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
selectInput("par_GeneSelMode", "GeneSelMode",
list("All" = "All", "Others" = "Others"), selected = "TRUE"),
textInput("par_Ncomp", "Ncomp", "5"),
textInput("par_DefaultWeight", "DefaultWeight", "1")
),
column(4, selectInput("par_SampleFilter", "SampleFilter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "TRUE"),
selectInput("par_ExpFilter", "ExpFilter",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_MoreInfo", "MoreInfo",
list("TRUE" = "TRUE", "FALSE" = "FALSE"), selected = "FALSE"),
selectInput("par_GeneOutDetection", "GeneOutDetection",
list("L1OutVarPerc" = "L1OutVarPerc",
"L1OutVarDC" = "L1OutVarDC",
"L1OutExpOut" = "L1OutExpOut",
"L1OutSdMean" = "L1OutSdMean"), selected = "L1OutExpOut"),
textInput("par_OutGeneNumber", "OutGeneNumber", "5"),
textInput("par_OutGeneSpace", "OutGeneSpace", "NULL")
),
column(4, textInput("par_MinGenes", "MinGenes", "10"),
textInput("par_MaxGenes", "MaxGenes", "500"),
textInput("par_ApproxSamples", "ApproxSamples", "5"),
textInput("par_PCSignThr", "PCSignThr", "NULL"),
selectInput("par_CorMethod", "CorMethod",
list("pearson" = "pearson",
"kendall" = "kendall",
"spearman" = "spearman"), selected = "pearson"),
selectInput("par_PCAType", "PCAType",
list("DimensionsAreGenes" = "DimensionsAreGenes",
"DimensionsAreSamples" = "DimensionsAreSamples"),
selected = "DimensionsAreGenes")
)
)
)
)
)
)
),
# Data summary (Top Tab 2) ---------------------------------------------------------
tabPanel("Summarize Info",
fluidPage(
titlePanel(""),
fluidRow(
tabsetPanel(
tabPanel("Parameters", dataTableOutput("PrintPar")),
tabPanel("Genesets", dataTableOutput("PrintGMT")),
tabPanel("Groups", dataTableOutput("PrintGroup"))
)
)
)
),
# Results (Top Tab 3) ---------------------------------------------------------
tabPanel("Visualize Results",
pageWithSidebar(
# Application title
headerPanel(NULL),
# sidebar ---------------------------------------------------------
sidebarPanel(
conditionalPanel(
condition="input.ResTabs == 'Modules'",
selectInput("prjt", "Projection type:",
list("PCA" = "PCA", "tSNE" = "tSNE"))
),
conditionalPanel(
condition="input.ResTabs == 'Modules' && input.prjt == 'tSNE'",
sliderInput("perp", "tSNE perplexity:",
min = 0, max = 100, value = 0, step = 1),
numericInput("initial_dims", "Initial dimensions:", min = 2, max = NA, step = 1, value = 50),
actionButton("dotSNE", "Compute tSNE"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Modules'",
selectInput("boxcomp", "Group comparison:",
c("Show all", "Show none", "Show significant")),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Modules' || input.ResTabs == 'Gene contribution'",
selectInput("gs", "Geneset:",
GSList),
htmlOutput("info"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation' || input.ResTabs == 'Correlation network'",
selectInput("htype", "Operation type:", SelList)
),
conditionalPanel(
condition="(input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation' || input.ResTabs == 'Correlation network') && input.htype == 'group'",
selectInput("aggfun", "Aggregating function:", SelListAF)
),
conditionalPanel(
condition="input.ResTabs == 'Correlation' || input.ResTabs == 'Gene contribution' || input.ResTabs == 'Correlation network'",
selectInput("cortype", "Correlation method:",
list("Pearson" = "pearson",
"Kendall" = "kendall",
"Spearman" = "spearman"))
),
conditionalPanel(
condition="input.ResTabs == 'Gene contribution'",
selectInput("corlelvel", "Confidence level:",
list(".95", ".99", ".999", ".9999")),
actionButton("doCorr", "Compute correlations"),
hr()
),
conditionalPanel(
condition="input.ResTabs == 'Correlation network'",
sliderInput("corthr", "Threshold:",
min = 0, max = 1, value = .6, step = .01)
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap'",
checkboxInput("gscol", "Samples on columns", FALSE),
checkboxInput("saclus", "Cluster samples / groups", FALSE)
),
conditionalPanel(
condition="input.ResTabs == 'Heatmap' || input.ResTabs == 'Correlation'",
checkboxInput("gsclus", "Cluster genesets", FALSE),
selectInput("GSOrdeMode", "Geneset information:",
choices = c("None", "Gene number",
"Overdispersion pv", "Underdispersion pv",
"Overcoordination pv", "Undercoordination pv",
"Overexpression pv", "Underexpression pv")),
hr()
),
selectInput("disp", "Dispersion filter:",
list("Overdispersed" = "Over",
"Underdispersed" = "Under",
"None" = "None")),
sliderInput("pdisp", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
selectInput("coord", "Coordination filter:",
list("Overcoordinated" = "Over",
"Undercoordinated" = "Under",
"None" = "None"), selected = "None"),
sliderInput("pcoord", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
selectInput("exp", "Expression filter:",
list("Overexpressed" = "Over",
"Underexpressed" = "Under",
"None" = "None"), selected = "None"),
sliderInput("pexp", "Log 10 p-value threshold:",
max = -1.3, min = -5, value = -1.3, step = .1),
hr(),
conditionalPanel(
condition="input.ResTabs == 'Heatmap'",
sliderInput("llim", "Lower limit",
max = 0, min = -100, value = -100, step = .1),
sliderInput("ulim", "Upper limit",
max = 100, min = 0, value = 100, step = .1)
),
conditionalPanel(
condition="input.ResTabs == 'Correlation'",
selectInput("gs_x", "Geneset (x axis):",
GSList),
selectInput("gs_y", "Geneset (y axis):",
GSList),
sliderInput("lcor", "Lower limit",
max = 0, min = -1, value = -1, step = .1),
sliderInput("ucor", "Upper limit",
max = 1, min = 0, value = 1, step = .1)
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes'",
sliderInput("gperc", "Percentage of genes",
max = 100, min = 10, value = 10, step = 5),
selectInput("contrType", "Controbution type:",
list("Positive" = "Pos",
"Negative" = "Neg",
"Absolute" = "Abs"), selected = "Absolute"),
selectInput("contrMode", "Selection mode:",
list("Weights" = "Wei",
"Correlation" = "Cor"), selected = "Weights")
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes' && input.contrMode == 'Cor'",
selectInput("corrType", "Correlation type:",
list("Pearson" = "pearson",
"Kendall" = "kendall",
"Spearman" = "spearman"), selected = "Pearson")
),
conditionalPanel(
condition="input.ResTabs == 'Top contributing genes'",
actionButton("doTop", "Compute contributing genes")
)
),
# main plots ---------------------------------------------------------
mainPanel(
tabsetPanel(id = "ResTabs",
# SubTab 1 (PCA/tSNE) ---------------------------------------------------------
tabPanel(title = "Modules",
if(Interactive){
tabPanel("Plot",
plotlyOutput("scatPlot", height = "900px"),
plotOutput("boxPlot", height = "500px"),
plotOutput("SamplesBoxPlot", height = "400px")
)
} else {
tabPanel("Plot",
plotOutput("scatPlot", height = "900px"),
plotOutput("boxPlot", height = "500px"),
plotOutput("SamplesBoxPlot", height = "400px")
)
}
),
# SubTab 2 (Module heatmap) ---------------------------------------------------------
tabPanel("Heatmap", id = "tab2",
plotOutput("hmPlot", height = "1600px")
),
# SubTab 3 ---------------------------------------------------------
tabPanel("Gene contribution", id = "tab3",
selectInput("contribType", "Contribution mode:",
list("Positive", "Negative")),
plotOutput("CorrCI", height = "1000px"),
# dataTableOutput("CorrTable"),
selectInput("availGenes", "", GeneList),
plotOutput("ExpProj", height = "1000px")
),
# SubTab 4 ---------------------------------------------------------
tabPanel("Correlation", id = "tab4",
if(Interactive){
tabPanel("Plot",
plotOutput("CorHmPlot", height = "1500px"),
plotlyOutput("CorScatPlot", height = "1000px")
)
} else {
tabPanel("Plot",
plotOutput("CorHmPlot", height = "1500px"),
plotOutput("CorScatPlot", height = "1000px")
)
}
),
# SubTab 5 ---------------------------------------------------------
tabPanel("ACSN (Selection)", id = "tab5",
fluidPage(
fluidRow(
headerPanel("Map to use:"),
column(12,
selectInput("mapurl", "", MapList, width = "75%")
),
headerPanel("Selected genesets:"),
column(12,
dataTableOutput("SelGSTable")
),
headerPanel("Sample(s) to use:"),
column(12,
checkboxGroupInput("selSamples", "", inline = TRUE,
choices = character(0))
)
),
fluidRow(
headerPanel("Group Selection:"),
column(6,
selectInput("selgroup", NULL, as.list(unique(Groups)))
),
column(6,
actionButton("selByGroup", "Select group"),
actionButton("selNone", "Clear selection")
)
),
fluidRow(
headerPanel("Projection options:"),
column(6,
selectInput("projtype", "Display mode:",
list("Module" = "Module", "Gene" = "Gene")),
textInput("ACSNWeiFil", "Filtering threshold:", "20")
),
column(6,
selectInput("scoreaggfun", "Score aggregation:",
list("mean" = "mean", "median" = "median",
"sd" = "sd", "IQR" = "IQR", "mad" = "mad")),
selectInput("geneaggfun", "Gene aggregation:",
list("mean" = "mean", "median" = "median",
"sd" = "sd", "IQR" = "IQR", "mad" = "mad"))
)
),
hr(),
fluidRow(
column(6,
actionButton("doACSN", "Plot on ACSN map")
),
column(6,
htmlOutput("ACSNStatus")
)
),
hr()
)
),
# SubTab 6 ---------------------------------------------------------
tabPanel("ACSN (Info)", id = "tab5",
fluidPage(
fluidRow(
column(6,
plotOutput("WeiVarBP")
),
column(6,
plotOutput("ScoreDist")
)
),
fluidRow(
column(6,
plotOutput("GeneMult")
),
column(6,
plotOutput("ScoreVar")
)
)
)
),
# SubTab 7 ---------------------------------------------------------
tabPanel("Top contributing genes", id = "tab6",
fluidRow(
column(12,
dataTableOutput("TopContributingGenes"))
)
),
# SubTab 8 ---------------------------------------------------------
tabPanel("Correlation network", id = "tab7",
fluidRow(
column(12,
visNetworkOutput("CorNet", height = "1500px"))
)
)
)
)
)
),
# Save / Load (Top Tab 4) ---------------------------------------------------------
tabPanel("Save/Load",
fluidPage(
titlePanel(""),
fluidRow(
column(6,
wellPanel(
helpText("Upload a previously performed rRoma analysis"),
fileInput("prev.rRoma", "Choose an rRoma file", accept = c(".rds"))
),
wellPanel(
helpText("Download the rRoma analysis"),
downloadButton("downloadData", "Download")
)
),
column(6,
wellPanel(
helpText("Load rRoma analysis locally"),
shinyFilesButton("load", "Load data", "Please select a file", FALSE)
),
wellPanel(
helpText("Save rRoma analysis locally"),
shinySaveButton("save", "Save data", "Save file as",
filetype=list(rds="rds"))
)
)
)
)
)
)
# define server ---------------------------------------------------------
server <- function(input, output, session) {
options(shiny.maxRequestSize=1000*1024^2)
Volumes = list("Working directory" = getwd(), "Volumes"= getVolumes())
shinyFileChoose(input, "load",
roots=Volumes,
session=session, filetypes=c('rds'))
shinyFileSave(input, "save",
roots=Volumes,
session=session)
# Load GMT file ---------------------------------------------------------
GetGMTFile <- reactive({
print("Reading the GMT file")
inFile <- input$gmtfile
if(is.null(inFile)){
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
if(trimws(input$msigkw) == ""){
KWStrings <- ""
} else {
KWStrings <- unlist(strsplit(trimws(input$msigkw), split = " ", fixed = TRUE))
}
LoadedData <- ReadGMTFile(FileLocation = inFile$datapath,
SearchString = KWStrings,
Mode = ifelse(input$msigkwall, "ALL", "ANY"))
if(!input$loadwei){
LoadedData <- lapply(LoadedData, function(GS) {
GS$Weigths[!is.na(GS$Weigths)] <- NA
return(GS)
})
}
return(LoadedData)
}
})
# Get GMT list ---------------------------------------------------------
GetModuleList <- eventReactive(input$searchDB, {
if(input$gmtsrc == "File"){
print("Loading GMT from file")
ModuleList <- GetGMTFile()
}
if(input$gmtsrc == "Internal"){
print("Loading from internal database")
if(trimws(input$msigkw) == ""){
KWStrings <- ""
} else {
KWStrings <- unlist(strsplit(trimws(input$msigkw), split = " ", fixed = TRUE))
}
ModuleList <- SelectFromInternalDB(SearchString = KWStrings,
Mode = ifelse(input$msigkwall, "ALL", "ANY"),
BDName = input$gmtlist, Version = NULL)
if(!input$loadwei){
ModuleList <- lapply(ModuleList, function(GS) {
GS$Weigths[!is.na(GS$Weigths)] <- NA
return(GS)
})
}
}
if(input$convertGeneID){
print("Performing coversion")
ModuleList <- ConvertModuleNames(
ModuleList,
SourceOrganism = input$sourceOrg,
TargetOrganism = input$targetOrg,
SourceTypes = input$sourceName,
TargetTypes = input$targetName,
HomologyLevel = 1,
HOST = NULL,
PATH = NULL)
}
print("Returning module list")
return(ModuleList)
}, ignoreInit = FALSE, ignoreNULL = FALSE)
# Print selected genesets ---------------------------------------------------------
output$PrintGeneSets <- renderDataTable({
ModuleList <- GetModuleList()
ModuleDF <- data.frame(Names = unlist(lapply(ModuleList, "[[", "Name")),
Genes = unlist(lapply(lapply(ModuleList, "[[", "Genes"), length)),
Weighted = unlist(lapply(lapply(ModuleList, "[[", "Weigths"), function(x){sum(!is.na(x))})))
ModuleDF
})
# Load expression matrix ---------------------------------------------------------
GetExpMat <- reactive({
inFile <- input$expmatfile
if(is.null(inFile)){
print("No input expression matrix specified")
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
print("Loading header")
PlainFile.Head <- readr::read_tsv(file = inFile$datapath, col_names = TRUE, n_max = 1)
ListSpec <- list('c', 'd')
names(ListSpec) <- c(colnames(PlainFile.Head)[1], '.default')
print("Loading data")
PlainFile <- readr::read_tsv(file = inFile$datapath,
col_types = do.call(what = readr::cols, args = ListSpec),
col_names = TRUE)
EmptyColumns <- colSums(is.na(PlainFile)) == nrow(PlainFile)
EmptyRows <- rowSums(is.na(PlainFile)) >= ncol(PlainFile) - 1
if(any(EmptyColumns) | any(EmptyRows)){
print("Filtering empty rows and columns")
PlainFile <- PlainFile[!EmptyRows, !EmptyColumns]
}
ExpMat <- data.matrix(PlainFile[,-1])
rownames(ExpMat) <- unlist(PlainFile[,1])
return(ExpMat)
}
})
# Load Group file ---------------------------------------------------------
GetGroups <- reactive({
if(!input$usegroups){
return(NULL)
}
inFile <- input$groupfile
if(is.null(inFile)){
return(NULL)
} else {
print(paste("Loading", inFile$datapath))
PlainFile <- readr::read_tsv(file = inFile$datapath, col_names = FALSE)
GroupVect <- unlist(PlainFile[,2])
names(GroupVect) <- unlist(PlainFile[,1])
return(GroupVect)
}
})
# Load previos ROMA file link ---------------------------------------------------------
LoadPastRoma <- reactive({
print("Loading data")
FileName <- input$prev.rRoma
if(!is.null(FileName)){
print("Setting upload timestamp")
TimeVect["Upload"] <<- Sys.time()
return(FileName)
}
return(NULL)
})
# Do rROMA ---------------------------------------------------------
RunROMA <- eventReactive(input$doROMA, {
print("Running ROMA")
print("Reading expression matrix")
MatData <- GetExpMat()
if(is.null(MatData)){
print("No expression matrix loaded")
return(NULL)
} else {
print(paste("A", dim(ExpMat), "has been loaded"))
}
print("Reading group information")
GroupVect <- GetGroups()
print("Reading modules information")
ModuleList <- GetModuleList()
if(is.null(ModuleList)){
print("No modules loaded")
return(NULL)
}
Cleaned_OutGeneSpace <- NULL
if(input$par_OutGeneSpace != "NULL"){
Cleaned_OutGeneSpace <- as.numeric(input$par_OutGeneSpace)
}
Cleaned_PCSignThr <- NULL
if(input$par_PCSignThr != "NULL"){
Cleaned_PCSignThr <- as.numeric(input$par_PCSignThr)
}
TimeVect["Analysis"] <<- Sys.time()
RomaData <- rRoma.R(
ExpressionMatrix = MatData, ModuleList = ModuleList,
FixedCenter = eval(parse(text=input$par_FixedCenter)),
PCSignMode = input$par_PCSignMode,
nSamples = as.integer(input$par_nSamples),
GeneOutThr = as.integer(input$par_GeneOutThr),
UseParallel = eval(parse(text=input$par_UseParallel)),
nCores = as.integer(input$par_nCores),
ClusType = input$par_ClusType,
UseWeigths = eval(parse(text=input$par_UseWeigths)),
FullSampleInfo = eval(parse(text=input$par_FullSampleInfo)),
centerData = eval(parse(text=input$par_centerData)),
GeneSelMode = input$par_GeneSelMode,
Ncomp = as.integer(input$par_Ncomp),
DefaultWeight = as.numeric(input$par_DefaultWeight),
SampleFilter = eval(parse(text=input$par_SampleFilter)),
ExpFilter = eval(parse(text=input$par_ExpFilter)),
MoreInfo = eval(parse(text=input$par_MoreInfo)),
GeneOutDetection = input$par_GeneOutDetection,
OutGeneNumber = as.numeric(input$par_OutGeneNumber),
OutGeneSpace = Cleaned_OutGeneSpace,
MinGenes = as.integer(input$par_MinGenes),
MaxGenes = as.integer(input$par_MaxGenes),
ApproxSamples = as.numeric(input$par_ApproxSamples),
CorMethod = input$par_CorMethod,
PCSignThr = Cleaned_PCSignThr,
PlotData = FALSE, PCADims = 2, SamplingGeneWeights = NULL, FillNAMethod = list(),
Grouping = NULL, GroupPCSign = FALSE,
PCAType = input$par_PCAType
)
TimeVect["Analysis"] <<- Sys.time()
return(RomaData)
}, ignoreInit = FALSE, ignoreNULL = FALSE)
# Do print ROMA results ---------------------------------------------------------
output$ROMAOut <- renderUI({
ExpMat <- GetExpMat()
GroupMat <- GetGroups()
# Get expression matrix
if(!is.null(ExpMat)){
str1 <- "Expression matrix loaded"
} else {
str1 <- "Expression matrix missing"
}
if(!is.null(GroupMat)){
if(input$usegroups){
str2 <- "Group data loaded"
} else {
str2 <- "Group data loaded, but ignored"
}
} else {
str2 <- "Group information missing"
}
return(HTML(paste(str1, str2, sep = '<br/>')))
})
output$ROMAOut2 <- renderUI({
ModuleList <- GetModuleList()
# Get expression matrix
if(!is.null(ModuleList)){
return(HTML("Geneset list loaded"))
}
})
# data table for GMT ---------------------------------------------------------
output$PrintGMT <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
ModuleDF <- data.frame(Names = unlist(lapply(RomaData$ModuleSummary, "[[", "ModuleName")),
Genes = unlist(lapply(lapply(RomaData$ModuleSummary, "[[", "UsedGenes"), length)))
ModuleDF[order(ModuleDF$Names),]
})
# parameter list ---------------------------------------------------------
output$PrintPar <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
ToUse <- !(names(RomaData$InputPars) %in% c("ModuleList", "SamplingGeneWeights", "Grouping"))
ModuleDF <- data.frame(Parameter = names(RomaData$InputPars[ToUse]),
Value = as.character(RomaData$InputPars[ToUse])
)
ModuleDF[order(ModuleDF$Parameter),]
})
# Group information ---------------------------------------------------------
output$PrintGroup <- renderDataTable({
RomaData <- GetData()
if(is.null(RomaData$Groups)){
return(NULL)
}
ModuleDF <- data.frame(Sample = names(RomaData$Groups),
Group = RomaData$Groups)
rownames(ModuleDF) <- NULL
ModuleDF
})
# download data ---------------------------------------------------------
output$downloadData <- downloadHandler(
filename = function() {
paste('rRoma-', Sys.Date(), '.rds', sep='')
},
content = function(con) {
rRomaDashData <- list(RomaData = GetData()$RomaData,
ModuleList = GetModuleList(),
ExpMat = GetData()$ExpMat,
Groups = GetData()$Groups)
saveRDS(rRomaDashData, con)
}
)
# load data ---------------------------------------------------------
GetData <- reactive({
print("Trying to load past ROMA data")
LoadDataStatus <- LoadPastRoma()
print("Trying to run ROMA with input data")
LoadInputStatus <- RunROMA()
print("Trying to load previous ROMA data from the running computer")
LoadServerStatus <- LoadFromServer()
print(TimeVect)
print(StartTime)
print(all(TimeVect == StartTime))
if(all(TimeVect == StartTime)){
return(list(
RomaData = RomaData,
ExpMat = ExpMat,
FoundSamp = FoundSamp,
Groups = Groups,
AddInfo = AddInfo,
GSList = GSList,
PCAProj = PCAProj,
ProcessedSamples = ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Upload"]){
print(paste("Loading", LoadDataStatus$datapath))
LoadedData <- readRDS(LoadDataStatus$datapath)
InitReturn <- Initialize(LoadedData$RomaData, LoadedData$ExpMat, LoadedData$Groups)
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
print("Passing on the information from the uploaded rds")
return(list(
RomaData = LoadedData$RomaData,
ExpMat = LoadedData$ExpMat,
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Analysis"]){
print("Passing on the information from the analysis")
InitReturn <- Initialize(LoadInputStatus, GetExpMat(), GetGroups())
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
return(list(
RomaData = LoadInputStatus,
ExpMat = GetExpMat(),
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
if(max(TimeVect) == TimeVect["Local"]){
print(paste("Loading", LoadServerStatus))
LoadedData <- readRDS(LoadServerStatus)
InitReturn <- Initialize(LoadedData$RomaData, LoadedData$ExpMat, LoadedData$Groups)
SelList <<- InitReturn$SelList
SelListAF <<- InitReturn$SelListAF
updateSelectInput(session, inputId = "htype", choices = SelList)
updateSelectInput(session, inputId = "aggfun", choices = SelListAF)
print("Passing on the information from the local rds")
return(list(
RomaData = LoadedData$RomaData,
ExpMat = LoadedData$ExpMat,
FoundSamp = InitReturn$FoundSamp,
Groups = InitReturn$Groups,
AddInfo = InitReturn$AddInfo,
GSList = InitReturn$GSList,
PCAProj = InitReturn$PCAProj,
ProcessedSamples = InitReturn$ProcessedSamples
))
}
})
# select module ---------------------------------------------------------
SelectedGS <- reactive({
as.integer(input$gs)
})
# Do tSNE ---------------------------------------------------------
GettSNEGS <- eventReactive(input$dotSNE, {
if(input$prjt == "tSNE"){
ExpMat <- GetData()$ExpMat
ProcessedSamples <- GetData()$ProcessedSamples
initial_dims <- as.integer(input$initial_dims)
if(initial_dims < 2){
initial_dims = 2
}
updateNumericInput(session, "initial_dims", value = initial_dims)
tSNEProj <- Rtsne::Rtsne(X = t(ExpMat[,ProcessedSamples]), perplexity = input$perp, initial_dims = initial_dims)$Y
rownames(tSNEProj) <- ProcessedSamples
colnames(tSNEProj) <- c("PC1", "PC2")
print("tSNE computed")
return(tSNEProj)
}
}, ignoreInit = TRUE)
# Select modules using conditions ---------------------------------------------------------
SelectedIdx <- reactive({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
SelectGeneSets(RomaData = RomaData,
VarThr = 10^input$pdisp, VarMode = "Wil", VarType = input$disp,
MedThr = 10^input$pexp, MedMode = "Wil", MedType = input$exp,
RatThr = 10^input$pcoord, RatMode = "Wil", RatType = input$coord)
})
# Update single module input ---------------------------------------------------------
observe({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
Idx <- SelectedIdx()
if(length(Idx)>0){
GSList <- Idx
names(GSList) <- as.list(rownames(RomaData$SampleMatrix)[Idx])
GSList <- GSList[order(names(GSList))]
} else {
GSList <- list(" " = "")
}
updateSelectInput(session, "gs", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "gs_x", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "gs_y", choices = GSList, selected = GSList[[1]])
updateSelectInput(session, "selgroup", choices = as.list(unique(Groups)))
})
# print module information ---------------------------------------------------------
output$info <- renderUI({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
str1 <- paste("Number of genes = ", length(RomaData$ModuleSummary[[SelectedGS()]]$UsedGenes))
str2 <- paste("Overdispersed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 1]))
str3 <- paste("Underdispersed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 2]))
str4 <- paste("Overcoordinated PV = ", signif(RomaData$PVVectMat[SelectedGS(), 3]))
str5 <- paste("Undercoordinated PV = ", signif(RomaData$PVVectMat[SelectedGS(), 4]))
str6 <- paste("Overexpressed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 5]))
str7 <- paste("Underexpressed PV = ", signif(RomaData$PVVectMat[SelectedGS(), 6]))
HTML(paste(str1, str2, str3, str4, str5, str6, str7, sep = '<br/>'))
})
# sample diag boxplots ---------------------------------------------------------
output$SamplesBoxPlot <- renderPlot({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
}
SeID <- SelectedGS()
Sampled.DF <- t(rbind(sapply(RomaData$ModuleSummary[[SeID]]$SampledExp, "[[", "ExpVar")[1:2,],
sapply(RomaData$ModuleSummary[[SeID]]$SampledExp, "[[", "MedianExp")))
Sampled.DF <- cbind(Sampled.DF, Sampled.DF[,1]/Sampled.DF[,2])
colnames(Sampled.DF) <- c("L1", "L2", "Exp", "L1/L2")
Sampled.DF <- reshape::melt(Sampled.DF)
Sampled.DF <- cbind(Sampled.DF, rep("Samples", nrow(Sampled.DF)))
colnames(Sampled.DF)[4] <- "Org"
Sampled.DF$Org <- factor(as.character(Sampled.DF$Org), levels = c("Samples", "Data"))
Sampled.DF <- rbind(Sampled.DF,
c(max(Sampled.DF$X1)+1,
"L1",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[1],
"Data"),
c(max(Sampled.DF$X1)+2,
"L2",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[2],
"Data"),
c(max(Sampled.DF$X1)+3,
"L1/L2",
RomaData$ModuleSummary[[SeID]]$ExpVarBase[1]/RomaData$ModuleSummary[[SeID]]$ExpVarBase[2],
"Data"),
c(max(Sampled.DF$X1)+4,
"Exp",
RomaData$ModuleMatrix[SeID,"Median Exp"],
"Data")
)
Sampled.DF <- data.frame(Sampled.DF)
Sampled.DF$X2 <- factor(as.character(Sampled.DF$X2), levels = c("L1", "L2", "L1/L2", "Exp"))
Sampled.DF$value <- as.numeric(as.character(Sampled.DF$value))
p1 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("L1", "L2"), ],
ggplot2::aes(y = value, x = X2, color = Org)) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free_x", ncol = 4) +
ggplot2::scale_color_manual(values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("L1", "L2"), ],
ggplot2::aes(y = value, x = X2, color = Org), inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Explained variance") +
ggplot2::guides(color=FALSE) +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
p2 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("L1/L2"), ],
ggplot2::aes(y = value, x = X2, color = Org)) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free", ncol = 4) +
ggplot2::scale_color_manual(values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("L1/L2"), ],
ggplot2::aes(y = value, x = X2, color = Org), inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Ratio") +
ggplot2::guides(color=FALSE) +
ggplot2::scale_y_log10() +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
p3 <- ggplot2::ggplot(data = Sampled.DF[Sampled.DF$Org == "Samples" &
Sampled.DF$X2 %in% c("Exp"), ],
ggplot2::aes(y = value, x = X2, color = "Samples")) +
ggplot2::geom_boxplot() + ggplot2::facet_wrap(~X2, scales = "free", ncol = 4) +
ggplot2::scale_color_manual("", values = c(Data="red", Samples="black")) +
ggplot2::geom_point(data = Sampled.DF[Sampled.DF$Org == "Data" &
Sampled.DF$X2 %in% c("Exp"), ],
ggplot2::aes(y = value, x = X2, color = Org),
inherit.aes = FALSE, size = 3) +
ggplot2::labs(x="", y="Median Expression") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
gridExtra::grid.arrange(p1, p2, p3, ncol = 3, widths=c(2,1,1.5))
})
# single sample boxplot ---------------------------------------------------------
output$boxPlot <- renderPlot({
if(is.na(SelectedGS())){
return(NULL)
}
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
DataToPlot <- data.frame(Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples])
p <- ggplot2::ggplot(data = DataToPlot, ggplot2::aes(x = Group, y = Score)) +
ggplot2::geom_boxplot()
if(length(unique(Groups[ProcessedSamples]))>1 & input$boxcomp != "Show none"){
if(input$boxcomp == "Show all"){
ToDisplay <- GetComb(unique(Groups[ProcessedSamples]))
}
if(input$boxcomp == "Show significant"){
PWComp <- pairwise.wilcox.test(DataToPlot$Score, DataToPlot$Group)$p.value
ExtPWComp <- matrix(rep(NA, length(unique(DataToPlot$Group))^2), nrow = length(unique(DataToPlot$Group)))
colnames(ExtPWComp) <- sort(unique(DataToPlot$Group))
rownames(ExtPWComp) <- colnames(ExtPWComp)
ExtPWComp[rownames(PWComp), colnames(PWComp)] <- PWComp
ToDisplay <- apply(which(ExtPWComp <= .05, arr.ind = TRUE), 1, list)
ToDisplay <- lapply(ToDisplay, function(x){as.integer(unlist(x))})
# names(ToDisplay) <- NULL
}
p <- p + ggsignif::geom_signif(comparisons = ToDisplay, map_signif_level=TRUE, test = "wilcox.test", step_increase = .1)
}
print(p)
})
# PCA / tSNE plot ---------------------------------------------------------
if(Interactive){
output$scatPlot <- renderPlotly({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
if(is.null(RomaData)){
return(NULL)
}
input$dotSNE
if(input$prjt == "PCA"){
print("using PCA")
Projs <- GetData()$PCAProj
}
if(input$prjt == "tSNE"){
print("using tSNE")
Projs <- GettSNEGS()
}
p <- ggplot2::ggplot(data = data.frame(Comp1 = Projs[,1],
Comp2 = Projs[,2],
Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = Comp1, y = Comp2, shape = Group, color = Score)) +
ggplot2::scale_color_gradient2(low = "blue", high = "red", mid = "white") +
ggplot2::labs(x = "Component 1", y = "Component 2", shape = "",
title = rownames(RomaData$SampleMatrix)[SelectedGS()]) +
ggplot2::geom_point(ggplot2::aes(text = rownames(Projs)))
print(ggplotly(p))
})
} else {
output$scatPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
if(is.null(RomaData)){
return(NULL)
}
input$dotSNE
if(input$prjt == "PCA"){
print("using PCA")
Projs <- GetData()$PCAProj
}
if(input$prjt == "tSNE"){
print("using tSNE")
Projs <- GettSNEGS()
}
p <- ggplot2::ggplot(data = data.frame(Comp1 = Projs[,1],
Comp2 = Projs[,2],
Score = RomaData$SampleMatrix[SelectedGS(), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = Comp1, y = Comp2, shape = Group, color = Score)) +
ggplot2::scale_color_gradient2(low = "blue", high = "red", mid = "white") +
ggplot2::labs(x = "Component 1", y = "Component 2", shape = "",
title = rownames(RomaData$SampleMatrix)[SelectedGS()]) +
ggplot2::geom_point(size = 3)
print(p)
})
}
# heatmap (modules) plot ---------------------------------------------------------
output$hmPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
PlotMat <- RomaData$SampleMatrix[Idx,]
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(input$GSOrdeMode == "None"){
GSOrdering <- order(rownames(RomaData$SampleMatrix[Idx,]))
GSCat <- NA
}
if(input$GSOrdeMode == "Gene number"){
nGenes <- unlist(lapply(lapply(RomaData$ModuleSummary[Idx], "[[", "UsedGenes"), length))
GSOrdering <- order(nGenes)
GSCat[] = nGenes
GSCat <- data.frame(Genes = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat <- data.frame("OD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat <- data.frame("UD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overcoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat <- data.frame("OC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Undercoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat <- data.frame("UC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat <- data.frame("OE lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat <- data.frame("UE lpv" = signif(GSCat, 2))
}
if(input$htype == "sample"){
MinMax <- range(PlotMat)
# print(MinMax)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
SatLL <- input$llim
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1]+SatLL/28, seq(from = SatLL*(26/27), to = 0, by = -SatLL/27))
} else {
DoLow <- FALSE
}
SatUL <- input$ulim
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = SatUL/27, to = (26/27)*SatUL, by = SatUL/27), MinMax[2] + SatUL/28)
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(SatLL < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
} else {
MyBreaks <- 0
UseCol <- NULL
}
if(DoHigh){
if(SatUL > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, HighBrk[2])
UseCol <- c(UseCol, 54)
}
}
if(length(Idx)>1){
if(input$gscol){
pheatmap::pheatmap(PlotMat[GSOrdering,], color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$saclus,
annotation_col = AddInfo,
annotation_row = GSCat,
main = "Module scores across samples")
} else {
pheatmap::pheatmap(t(PlotMat[GSOrdering,]), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = input$gsclus,
annotation_row = AddInfo,
annotation_col = GSCat,
main = "Module scores across samples")
}
}
if(length(Idx) == 1){
PlotMat <- matrix(PlotMat, nrow = 1)
colnames(PlotMat) <- colnames(RomaData$SampleMatrix)
if(input$gscol){
pheatmap::pheatmap(PlotMat, color = BaseCol[UseCol], breaks = MyBreaks,
cluster_cols = input$saclus, cluster_rows = FALSE,
annotation_col = AddInfo,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
} else {
pheatmap::pheatmap(t(PlotMat), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = FALSE,
annotation_row = AddInfo,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
# pheatmap::pheatmap(PlotMat, BaseCol[UseCol], breaks = MyBreaks,
# cluster_rows = FALSE, cluster_cols = FALSE,
# main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(PlotMat[,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
MinMax <- range(Aggmat)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
SatLL <- input$llim
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1]+SatLL/28, seq(from = SatLL*(26/27), to = 0, by = -SatLL/27))
} else {
DoLow <- FALSE
}
SatUL <- input$ulim
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = SatUL/27, to = (26/27)*SatUL, by = SatUL/27), MinMax[2] + SatUL/28)
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(SatLL < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
} else {
MyBreaks <- 0
UseCol <- NULL
}
if(DoHigh){
if(input$ulim > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, HighBrk[2])
UseCol <- c(UseCol, 54)
}
}
if(input$gscol){
pheatmap::pheatmap(Aggmat[GSOrdering,], color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$saclus,
annotation_row = GSCat, main = "Module scores across groups")
} else {
pheatmap::pheatmap(t(Aggmat[GSOrdering,]), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$saclus, cluster_cols = input$gsclus,
annotation_col = GSCat, main = "Module scores across groups")
}
}
if(length(Idx) == 1){
# names(PlotMat) <- colnames(RomaData$SampleMatrix)
SplitData <- split(data.frame(PlotMat[FoundSamp]), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
do.call(input$aggfun, list(unlist(x)))
})
MinMax <- range(Aggmat)
if(input$llim < MinMax[1]){
updateSliderInput(session, "llim", value = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
}
updateSliderInput(session, "llim", min = ifelse(MinMax[1] < 0, floor(10*MinMax[1])/10, 0))
if(input$ulim > MinMax[2]){
updateSliderInput(session, "ulim", value = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
}
updateSliderInput(session, "ulim", max = ifelse(MinMax[2] > 0, ceiling(10*MinMax[2])/10, 0))
if(MinMax[1] < 0){
DoLow <- TRUE
LowBrk <- c(MinMax[1], seq(from = input$llim*(26/27), to = 0, by = -input$llim/27))
if(LowBrk[1] != min(LowBrk)){
LowBrk[1] <- min(LowBrk) + input$llim/27
}
} else {
DoLow <- FALSE
}
if(MinMax[2] > 0){
DoHigh <- TRUE
HighBrk <- c(seq(from = input$ulim/27, to = (26/27)*input$ulim, by = input$ulim/27), MinMax[2])
if(HighBrk[length(HighBrk)] != max(HighBrk)){
HighBrk[length(HighBrk)] <- max(HighBrk) + input$ulim/27
}
if(HighBrk[1] == 0){
HighBrk <- HighBrk[-1]
}
} else {
DoHigh <- FALSE
}
if(DoLow){
MyBreaks <- LowBrk
if(input$llim < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1,27)
}
} else {
MyBreaks <- 0
UseCol <- 27
}
if(DoHigh){
MyBreaks <- c(MyBreaks, HighBrk)
if(input$ulim > 0){
UseCol <- c(UseCol, 28:54)
} else {
UseCol <- c(UseCol, 28, 54)
}
}
pheatmap::pheatmap(t(Aggmat), color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = FALSE, cluster_cols = FALSE,
main = paste("Score of", rownames(RomaData$SampleMatrix)[Idx]))
}
}
})
# corr heatmap ---------------------------------------------------------
output$CorHmPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(input$GSOrdeMode == "None"){
GSOrdering <- order(rownames(RomaData$SampleMatrix[Idx,]))
GSCat <- NA
}
if(input$GSOrdeMode == "Gene number"){
nGenes <- unlist(lapply(lapply(RomaData$ModuleSummary[Idx], "[[", "UsedGenes"), length))
GSOrdering <- order(nGenes)
GSCat[] = nGenes
GSCat <- data.frame(Genes = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT less pv"])
GSCat <- data.frame("OD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underdispersion pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1 WT greater pv"])
GSCat <- data.frame("UD lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overcoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/L2 WT less pv"])
GSCat <- data.frame("OC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Undercoordination pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "L1/2 WT greater pv"])
GSCat <- data.frame("UC lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Overexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT less pv"])
GSCat <- data.frame("OE lpv" = signif(GSCat, 2))
}
if(input$GSOrdeMode == "Underexpression pv"){
GSOrdering <- order(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat[] = log10(RomaData$PVVectMat[Idx, "Median Exp WT greater pv"])
GSCat <- data.frame("UE lpv" = signif(GSCat, 2))
}
LowBrk <- c(-1.01, seq(from = input$lcor*(26/27), to = 0, by = -input$lcor/27))
HighBrk <- c(seq(from = input$ucor/27, to = (26/27)*input$ucor, by = input$ucor/27), 1.01)
MyBreaks <- LowBrk
if(input$lcor < 0){
UseCol <- c(1:27)
} else {
UseCol <- c(1)
}
if(input$ucor > 0){
MyBreaks <- c(MyBreaks, HighBrk)
UseCol <- c(UseCol, 28:54)
} else {
MyBreaks <- c(MyBreaks, 1.01)
UseCol <- c(UseCol, 54)
}
if(input$htype == "sample"){
if(length(Idx)>1){
pheatmap::pheatmap(cor(t(RomaData$SampleMatrix[Idx,]), method = input$cortype)[GSOrdering, GSOrdering],
color = BaseCol[UseCol], breaks = MyBreaks,
annotation_row = GSCat, annotation_col = GSCat,
cluster_rows = input$gsclus, cluster_cols = input$gsclus,
main = "Correlation across samples")
}
if(length(Idx) == 1){
NULL
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(RomaData$SampleMatrix[Idx,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
pheatmap::pheatmap(cor(t(Aggmat), method = input$cortype)[GSOrdering, GSOrdering],
color = BaseCol[UseCol], breaks = MyBreaks,
cluster_rows = input$gsclus, cluster_cols = input$gsclus,
annotation_row = GSCat, annotation_col = GSCat,
main = "Correlation across groups")
}
if(length(Idx) == 1){
NULL
}
}
})
# corr scatplot ---------------------------------------------------------
if(Interactive){
output$CorScatPlot <- renderPlotly({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
XLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_x)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
YLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_y)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
CTitle <- cor(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
method = input$cortype)
if(input$htype == "sample"){
p <- ggplot2::ggplot(data = data.frame(XVal = RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
YVal = RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point(ggplot2::aes(text = ProcessedSamples))
}
if(input$htype == "group"){
AggX <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
AggY <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
p <- ggplot2::ggplot(data = data.frame(XVal = AggX[,2],
YVal = AggY[,2],
Group = AggX[,1]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point(ggplot2::aes(text = AggX[,1]))
}
print(ggplotly(p))
})
} else {
output$CorScatPlot <- renderPlot({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
XLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_x)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
YLab <- paste("Scores - ", RomaData$ModuleSummary[[as.integer(input$gs_y)]]$ModuleName, " - ",
length(RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes), " genes (",
length(intersect(RomaData$ModuleSummary[[as.integer(input$gs_x)]]$UsedGenes,
RomaData$ModuleSummary[[as.integer(input$gs_y)]]$UsedGenes)), " shared)",
sep = "")
CTitle <- cor(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
method = input$cortype)
if(input$htype == "sample"){
p <- ggplot2::ggplot(data = data.frame(XVal = RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples],
YVal = RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples],
Group = Groups[ProcessedSamples]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point()
}
if(input$htype == "group"){
AggX <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_x), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
AggY <- aggregate(RomaData$SampleMatrix[as.integer(input$gs_y), ProcessedSamples], list(AddInfo$Groups), get(input$aggfun))
p <- ggplot2::ggplot(data = data.frame(XVal = AggX[,2],
YVal = AggY[,2],
Group = AggX[,1]),
ggplot2::aes(x = XVal, y = YVal, color = Group)) +
ggplot2::labs(x = XLab, y = YLab, shape = "", title = paste("Corr =", signif(CTitle, 5))) +
ggplot2::geom_point()
}
print(p)
})
}
# Selected GS datatable ---------------------------------------------------------
output$SelGSTable <- renderDataTable({
RomaData <- GetData()$RomaData
if(is.null(RomaData)){
return(NULL)
} else {
SelIdxs <- SelectedIdx()
RetDF <- data.frame(Names = unlist(lapply(RomaData$ModuleSummary[SelIdxs], "[[", "ModuleName"), use.names = FALSE))
return(RetDF)
}
})
# Update available samples ---------------------------------------------------------
observe({
RomaData <- GetData()$RomaData
if(!is.null(RomaData)){
Samples <- colnames(RomaData$SampleMatrix)
updateCheckboxGroupInput(session, "selSamples", choices = Samples, inline = TRUE)
}
})
# Plot on ACSN ---------------------------------------------------------
GetACSN <- eventReactive(input$doACSN, {
print("Initiating ACSN plotting")
SelIdxs <- SelectedIdx()
RomaData <- GetData()$RomaData
if(!is.null(input$selSamples) & !is.null(RomaData) & !is.null(SelIdxs)){
RetData <- PlotOnACSN(
RomaData = RomaData, SampleName = input$selSamples, AggScoreFun = input$scoreaggfun,
MapURL = input$mapurl, Selected = SelIdxs, FilterByWei = as.numeric(input$ACSNWeiFil),
AggGeneFun = input$geneaggfun, DispMode = input$projtype, DefDispVal = 0,
PlotInfo = FALSE, ReturnInfo = TRUE, LocalRange = FALSE)
} else {
RetData <- NULL
}
return(RetData)
}, ignoreInit = TRUE, ignoreNULL = FALSE)
# Include Status (ACSN) ---------------------------------------------------------
output$ACSNStatus <- renderUI({
Test <- GetACSN()
if(is.null(Test)){
HTML("<i>Data not exported on ACSN</i>")
} else {
HTML("<b>Data exported to ACSN</b>")
}
})
# Plot weigth variation (ACSN) ---------------------------------------------------------
output$WeiVarBP <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
p <- ggplot2::ggplot(data = data.frame(y = Data$GenesVar,
x = rep(1, length(Data$GenesVar))),
mapping = ggplot2::aes(x = x, y = y)) +
ggplot2::geom_boxplot(mapping = ggplot2::aes(color = "Data")) +
ggplot2::labs(y = "Variance of gene weight") + ggplot2::scale_y_log10() +
ggplot2::scale_color_manual("", values = c(Data="black", Outliers="red")) +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
if(sum(Data$GeneOut) > 1){
p <- p + ggplot2::geom_point(data = data.frame(x = rep(1, length(which(Data$GeneOut))),
y = Data$GenesVar[names(which(Data$GeneOut))]),
mapping = ggplot2::aes(x = x, y = y, color="Outliers"), size = 3,
inherit.aes = FALSE)
}
print(p)
}
})
# Plot gene multiplicity (ACSN) ---------------------------------------------------------
output$GeneMult <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if(!is.null(Data$GeneMult)){
p <- ggplot2::ggplot(data = data.frame(Data$GeneMult),
mapping = ggplot2::aes(x = Freq)) +
ggplot2::geom_histogram(binwidth = 1) +
ggplot2::labs(y = "Frequency", x = "Gene multiplicity")
print(p)
}
}
})
# Plot score distribution (ACSN) ---------------------------------------------------------
output$ScoreDist <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if((input$projtype == "Module") & !is.null(Data$GeneMult)){
p <- ggplot2::ggplot(data = data.frame(Data$ScoreDist,
x = rep(1, length(Data$ScoreDist))),
mapping = ggplot2::aes(x = x, y = data)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score (Module)", x = "") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
if((input$projtype == "Gene") & !is.null(Data$WeiDist)){
p <- ggplot2::ggplot(data = data.frame(Data$WeiDist,
x = rep(1, length(Data$WeiDist))),
mapping = ggplot2::aes(x = x, y = data)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score (Weight)", x = "") +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
}
})
# Plot score variance (ACSN) ---------------------------------------------------------
output$ScoreVar <- renderPlot({
Data <- GetACSN()
if(!is.null(Data)){
if((input$projtype == "Module") & !is.null(Data$ScoreVar)){
p <- ggplot2::ggplot(data = data.frame(y = Data$ScoreVar,
x = rep(1, length(Data$ScoreVar))),
mapping = ggplot2::aes(x = x, y = y)) +
ggplot2::geom_boxplot() +
ggplot2::labs(y = "Gene score variance (per gene with multiplicity > 1)", x = "") +
ggplot2::scale_y_log10() +
ggplot2::theme(axis.title.x=ggplot2::element_blank(),
axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank())
print(p)
}
}
})
# Select samples by group (ACSN) ---------------------------------------------------------
observeEvent(input$selByGroup, {
Groups <- GetData()$Groups
updateCheckboxGroupInput(session, "selSamples", selected = unique(c(names(Groups[Groups == input$selgroup]),
input$selSamples)))
}, ignoreNULL = FALSE, ignoreInit = TRUE)
# Clear selection (ACSN) ---------------------------------------------------------
observeEvent(input$selNone, {
updateCheckboxGroupInput(session, "selSamples", selected = "")
}, ignoreNULL = FALSE, ignoreInit = TRUE)
# Compute Correlations (Gene contribution) ---------------------------------------------------------
GetCorrs <- eventReactive(input$doCorr, {
ExpMat <- GetData()$ExpMat
RomaData <- GetData()$RomaData
ModuleID <- SelectedGS()
CorInfo <- GetCorrelations(RomaData = RomaData, Selected = ModuleID, MatData = ExpMat,
Methods = input$cortype, ConfLevel = as.numeric(input$corlelvel))
return(list(CorInfo = CorInfo, Method = input$cortype, ModuleID = ModuleID))
}, ignoreInit = TRUE)
output$CorrCI <- renderPlot({
AllGenesCorr <- GetCorrs()$CorInfo$Genes
if(GetCorrs()$Method != input$cortype | GetCorrs()$ModuleID != SelectedGS()){
updateSelectInput(session, "availGenes", choices = list())
return(NULL)
}
# Filter genes
AllGenesCorr <- AllGenesCorr[as.numeric(AllGenesCorr[,"p.val"]) <= (1 - as.numeric(input$corlelvel)), ]
# Get direction
SelGenes <- NULL
if(input$contribType == "Positive"){
SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) > 0)
}
if(input$contribType == "Negative"){
SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) < 0)
}
if(length(SelGenes) == 0){
return(NULL)
updateSelectInput(session, "availGenes", choices = list())
}
GeneNames <- AllGenesCorr[SelGenes, "gene"]
GeneLabels <- paste(GeneNames, signif(as.numeric(AllGenesCorr[SelGenes, "cor"]), 4),
sep = ' | cor = ')
RetList <- as.list(GeneNames)
names(RetList) <- GeneLabels
updateSelectInput(session, "availGenes",
choices = RetList[order(as.numeric(AllGenesCorr[SelGenes, "cor"]))])
AllGenesCorr.DF <- data.frame(AllGenesCorr[SelGenes,])
AllGenesCorr.DF$cor <- as.numeric(as.character(AllGenesCorr.DF$cor))
AllGenesCorr.DF$p.val <- as.numeric(as.character(AllGenesCorr.DF$p.val))
AllGenesCorr.DF$gene <- factor(as.character(AllGenesCorr.DF$gene),
levels = as.character(AllGenesCorr.DF$gene)[order(AllGenesCorr.DF$cor)])
if(input$cortype == "pearson"){
AllGenesCorr.DF$ci.low <- as.numeric(as.character(AllGenesCorr.DF$ci.low))
AllGenesCorr.DF$ci.high <- as.numeric(as.character(AllGenesCorr.DF$ci.high))
p <- ggplot2::ggplot(data = AllGenesCorr.DF,
ggplot2::aes(x = gene, y = cor, ymin = ci.low, ymax = ci.high)) +
ggplot2::geom_pointrange() + ggplot2::geom_point() + ggplot2::coord_flip() +
ggplot2::labs(y = "Correlation")
} else {
p <- ggplot2::ggplot(data = AllGenesCorr.DF,
ggplot2::aes(x = gene, y = cor)) +
ggplot2::geom_point() + ggplot2::coord_flip() +
ggplot2::labs(y = "Correlation")
}
if(input$contribType == "Positive"){
p <- p + ggplot2::scale_y_continuous(limits = c(0, 1))
}
if(input$contribType == "Negative"){
p <- p + ggplot2::scale_y_continuous(limits = c(-1, 0))
}
print(p)
})
output$ExpProj <- renderPlot({
if(input$availGenes != ""){
GeneExp <- GetData()$ExpMat[input$availGenes, ]
ModScore <- GetData()$RomaData$SampleMatrix[SelectedGS(),]
SampleNames <- intersect(names(GeneExp), names(ModScore))
NewDF <- data.frame(Samples = SampleNames,
Expression = GeneExp[SampleNames],
Score = ModScore[SampleNames],
Groups = GetData()$Groups)
p <- ggplot2::ggplot(data = NewDF, ggplot2::aes(x = Score, y = Expression)) +
ggplot2::geom_smooth() +
ggplot2::geom_point(mapping = ggplot2::aes(color = Groups)) +
ggplot2::labs(x = "Module score", y = "Gene expression")
print(p)
}
})
# Compute Top contributing genes ---------------------------------------------------------
GetContrGenes <- eventReactive(input$doTop, {
ExpMat <- GetData()$ExpMat
RomaData <- GetData()$RomaData
ModuleIDs <- SelectedIdx()
print(ModuleIDs)
print(as.numeric(input$gperc)/100)
print(input$contrMode)
print(input$contrType)
print(input$corrType)
TopContrGenes <- GetTopContrib(RomaData = RomaData, Selected = ModuleIDs, ExpressionMatrix = ExpMat,
nGenes = as.numeric(input$gperc)/100, Mode = input$contrMode,
OrderType = input$contrType, CorMethod = input$corrType,
ColorGradient = colorRamps::blue2red(50),
Plot = FALSE, cluster_cols = FALSE, HMTite = "Top contributing genes")
# print(data.frame(TopContrGenes$Table))
# output$TopContributingGenes <- renderDataTable({data.frame(TopContrGenes$RetTable)})
return(list(RetTable = TopContrGenes$Table))
}, ignoreInit = TRUE)
output$TopContributingGenes <- renderDataTable({
return(data.frame(GetContrGenes()$RetTable))
})
# output$CorrCI <- renderPlot({
#
# AllGenesCorr <- GetCorrs()$CorInfo$Genes
#
# if(GetCorrs()$Method != input$cortype | GetCorrs()$ModuleID != SelectedGS()){
# updateSelectInput(session, "availGenes", choices = list())
# return(NULL)
# }
#
# # Filter genes
#
# AllGenesCorr <- AllGenesCorr[as.numeric(AllGenesCorr[,"p.val"]) <= (1 - as.numeric(input$corlelvel)), ]
#
# # Get direction
#
# SelGenes <- NULL
#
# if(input$contribType == "Positive"){
# SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) > 0)
# }
#
# if(input$contribType == "Negative"){
# SelGenes <- which(as.numeric(AllGenesCorr[,"cor"]) < 0)
# }
#
# if(length(SelGenes) == 0){
# return(NULL)
# updateSelectInput(session, "availGenes", choices = list())
# }
#
# GeneNames <- AllGenesCorr[SelGenes, "gene"]
# GeneLabels <- paste(GeneNames, signif(as.numeric(AllGenesCorr[SelGenes, "cor"]), 4),
# sep = ' | cor = ')
#
# RetList <- as.list(GeneNames)
# names(RetList) <- GeneLabels
#
# updateSelectInput(session, "availGenes",
# choices = RetList[order(as.numeric(AllGenesCorr[SelGenes, "cor"]))])
#
#
# AllGenesCorr.DF <- data.frame(AllGenesCorr[SelGenes,])
# AllGenesCorr.DF$cor <- as.numeric(as.character(AllGenesCorr.DF$cor))
# AllGenesCorr.DF$p.val <- as.numeric(as.character(AllGenesCorr.DF$p.val))
# AllGenesCorr.DF$gene <- factor(as.character(AllGenesCorr.DF$gene),
# levels = as.character(AllGenesCorr.DF$gene)[order(AllGenesCorr.DF$cor)])
#
# if(input$cortype == "pearson"){
# AllGenesCorr.DF$ci.low <- as.numeric(as.character(AllGenesCorr.DF$ci.low))
# AllGenesCorr.DF$ci.high <- as.numeric(as.character(AllGenesCorr.DF$ci.high))
#
# p <- ggplot2::ggplot(data = AllGenesCorr.DF,
# ggplot2::aes(x = gene, y = cor, ymin = ci.low, ymax = ci.high)) +
# ggplot2::geom_pointrange() + ggplot2::geom_point() + ggplot2::coord_flip() +
# ggplot2::labs(y = "Correlation")
#
# } else {
#
# p <- ggplot2::ggplot(data = AllGenesCorr.DF,
# ggplot2::aes(x = gene, y = cor)) +
# ggplot2::geom_point() + ggplot2::coord_flip() +
# ggplot2::labs(y = "Correlation")
#
# }
#
#
# if(input$contribType == "Positive"){
# p <- p + ggplot2::scale_y_continuous(limits = c(0, 1))
# }
#
# if(input$contribType == "Negative"){
# p <- p + ggplot2::scale_y_continuous(limits = c(-1, 0))
# }
#
# print(p)
#
# })
# Correlation network ---------------------------------------------------------
output$CorNet <- renderVisNetwork({
RomaData <- GetData()$RomaData
Groups <- GetData()$Groups
ProcessedSamples <- GetData()$ProcessedSamples
AddInfo <- GetData()$AddInfo
FoundSamp <- GetData()$FoundSamp
if(is.null(RomaData)){
return(NULL)
}
BaseCol <- colorRamps::blue2red(54)
Idx <- SelectedIdx()
GSCat <- rep(NA, nrow(RomaData$SampleMatrix))
names(GSCat) <- rownames(RomaData$SampleMatrix)
if(length(Idx) == 0){
return(NULL)
}
if(input$htype == "sample"){
if(length(Idx)>1){
CorMat <- cor(t(RomaData$SampleMatrix[Idx,]), method = input$cortype)
}
if(length(Idx) == 1){
return(NULL)
}
}
if(input$htype == "group"){
if(length(Idx) > 1){
SplitData <- split(data.frame(t(RomaData$SampleMatrix[Idx,FoundSamp])), f=AddInfo$Groups)
Aggmat <- sapply(SplitData, function(x) {
apply(x, 2, get(input$aggfun))
})
CorMat <- cor(t(Aggmat), method = input$cortype)
}
if(length(Idx) == 1){
return(NULL)
}
}
CorMat[abs(CorMat) < input$corthr] <- 0
# CorMat <- CorMat[any(rowSums(abs(CorMat)>0)>0),
# any(colSums(abs(CorMat)>0)>0)]
CorMat[upper.tri(CorMat, diag = TRUE)] <- 0
print(CorMat)
nodes <- data.frame(id = 1:nrow(CorMat),
label = rownames(CorMat))
tEgd <- which(abs(CorMat) > 0, arr.ind = TRUE)
CorValVect <- CorMat[which(abs(CorMat) > 0)]
ColVect <- rep("blue", length(CorValVect))
ColVect[CorValVect > 0] <- "red"
print(ColVect)
print(tEgd)
edges <- data.frame(from = tEgd[,1], to = tEgd[,2], color = ColVect, title = CorValVect, value = abs(CorValVect), physics = FALSE)
return(visNetwork(nodes, edges))
# minimal example
})
# Save data locally ---------------------------------------------------------
observe({
fileinfo <- parseSavePath(Volumes, input$save)
if (nrow(fileinfo) > 0) {
RomaData <- GetData()$RomaData
ModuleList <- GetModuleList()
ExpMat <- GetData()$ExpMat
Groups <- GetData()$Groups
print(is.null(RomaData))
print(is.null(ModuleList))
print(is.null(ExpMat))
print(is.null(Groups))
rRomaDashData <- list(RomaData = RomaData,
ModuleList = ModuleList,
ExpMat = ExpMat,
Groups = Groups)
print(paste("Saving to", as.character(fileinfo$datapath)))
saveRDS(rRomaDashData, as.character(fileinfo$datapath))
}
})
# Load data locally ---------------------------------------------------------
LoadFromServer <- reactive({
fileinfo <- parseFilePaths(Volumes, input$load)
if (nrow(fileinfo) > 0) {
print("Setting local timestamp")
TimeVect["Local"] <<- Sys.time()
return(as.character(fileinfo$datapath))
} else {
return(NULL)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.