Skip to content

Commit

Permalink
Merge pull request #223 from bigomics/inputData-pgx-convert
Browse files Browse the repository at this point in the history 
Input data pgx convert
  • Loading branch information
@ncullen93
ncullen93 authored Mar 14, 2023
2 parents 6fd984a + 0e0e71b commit b40633a
Show file tree
Hide file tree
Showing 10 changed files with 125 additions and 142 deletions.
56 changes: 28 additions & 28 deletions components/app/R/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -182,102 +182,102 @@ app_server <- function(input, output, session) {
})

shiny::withProgress(message="Preparing your dashboards...", value=0, {

if(ENABLED['dataview']) {
info("[server.R] calling module dataview")
DataViewBoard("dataview", pgx=PGX)
}

if(ENABLED['clustersamples']) {
info("[server.R] calling module clustersamples")
ClusteringBoard("clustersamples", pgx=PGX)
}

if(ENABLED['wordcloud']) {
info("[server.R] calling WordCloudBoard module")
WordCloudBoard("wordcloud", pgx=PGX)
}
shiny::incProgress(0.2)

if(ENABLED['diffexpr']) {
info("[server.R] calling ExpressionBoard module")
ExpressionBoard("diffexpr", inputData=inputData) -> env$diffexpr
ExpressionBoard("diffexpr", pgx=PGX) -> env$diffexpr
}

if(ENABLED['clusterfeatures']) {
info("[server.R] calling FeatureMapBoard module")
FeatureMapBoard("clusterfeatures", inputData=inputData)
}

if(ENABLED['enrich']) {
info("[server.R] calling EnrichmentBoard module")
info("[server.R] calling EnrichmentBoard module")
EnrichmentBoard("enrich", inputData = inputData,
selected_gxmethods = env$diffexpr$selected_gxmethods ) -> env$enrich
}
if(ENABLED['pathway']) {
info("[server.R] calling FunctionalBoard module")
info("[server.R] calling FunctionalBoard module")
FunctionalBoard("pathway", inputData = inputData,
selected_gsetmethods = env$enrich$selected_gsetmethods)
}

shiny::incProgress(0.4)

if(ENABLED['drug']) {
info("[server.R] calling DrugConnectivityBoard module")
info("[server.R] calling DrugConnectivityBoard module")
DrugConnectivityBoard("drug", inputData = inputData)
}

if(ENABLED['isect']) {
info("[server.R] calling IntersectionBoard module")
info("[server.R] calling IntersectionBoard module")
IntersectionBoard("isect", inputData = inputData,
selected_gxmethods = env$diffexpr$selected_gxmethods,
selected_gsetmethods = env$enrich$selected_gsetmethods)
}

if(ENABLED['sig']) {
info("[server.R] calling SignatureBoard module")
info("[server.R] calling SignatureBoard module")
SignatureBoard("sig", inputData = inputData,
selected_gxmethods = env$diffexpr$selected_gxmethods)
}

if(ENABLED['corr']) {
info("[server.R] calling CorrelationBoard module")
CorrelationBoard("corr", inputData = inputData)
}
shiny::incProgress(0.6)

if(ENABLED['bio']) {
info("[server.R] calling BiomarkerBoard module")
info("[server.R] calling BiomarkerBoard module")
BiomarkerBoard("bio", inputData = inputData)
}

if(ENABLED['cmap']) {
info("[server.R] calling ConnectivityBoard module")
info("[server.R] calling ConnectivityBoard module")
ConnectivityBoard("cmap", inputData = inputData)
}

if(ENABLED['cell']) {
info("[server.R] calling SingleCellBoard module")
info("[server.R] calling SingleCellBoard module")
SingleCellBoard("cell", inputData = inputData)
}

shiny::incProgress(0.8)
if(ENABLED['tcga']) {
info("[server.R] calling TcgaBoard module")
info("[server.R] calling TcgaBoard module")
TcgaBoard("tcga", inputData = inputData)
}

if(ENABLED['wgcna']) {
info("[server.R] calling WgcnaBoard module")
info("[server.R] calling WgcnaBoard module")
WgcnaBoard("wgcna", inputData = inputData)
}

if(ENABLED['comp']) {
info("[server.R] calling CompareBoard module")
info("[server.R] calling CompareBoard module")
CompareBoard("comp", inputData = inputData)
}

info("[server.R] calling modules done!")
info("[server.R] calling modules done!")
})

## remove modal from LoadingBoard
Expand Down Expand Up @@ -326,7 +326,7 @@ app_server <- function(input, output, session) {

## trigger on change dataset
dbg("[server.R] trigger on change dataset")

## show beta feauture
show.beta <- env$user$enable_beta()
if(is.null(show.beta) || length(show.beta)==0) show.beta=FALSE
Expand Down Expand Up @@ -492,7 +492,7 @@ Upgrade today and experience advanced analysis features without the time limit.<
## trigger on change of USER
logged <- auth$logged()
info("[server.R] change in user log status : logged = ",logged)

##--------- force logout callback??? --------------
if(opt$AUTHENTICATION!='firebase' && !logged) {
## Forcing logout ensures "clean" sessions. For firebase
Expand Down
13 changes: 6 additions & 7 deletions components/board.expression/R/expression_plot_barplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ expression_plot_barplot_ui <- function(id,
#'
#' @param id
#' @param comp
#' @param ngs
#' @param pgx
#' @param sel
#' @param res
#' @param watermark
Expand All @@ -64,7 +64,7 @@ expression_plot_barplot_ui <- function(id,
#' @export
expression_plot_barplot_server <- function(id,
comp,
ngs,
pgx,
sel,
res,
watermark = FALSE) {
Expand All @@ -76,18 +76,17 @@ expression_plot_barplot_server <- function(id,
grouped <- input$barplot_grouped
logscale <- input$barplot_logscale
showothers <- input$barplot_showothers
ngs <- ngs()
sel <- sel()
res <- res()

psel <- rownames(res)[sel]
gene <- ngs$genes[1, "gene_name"]
gene <- pgx$genes[1, "gene_name"]

gene <- ngs$genes[psel, "gene_name"]
gene <- pgx$genes[psel, "gene_name"]
srt <- ifelse(grouped, 0, 35)

return(list(
ngs = ngs,
pgx = pgx,
gene = gene,
comp = comp,
sel = sel,
Expand All @@ -113,7 +112,7 @@ expression_plot_barplot_server <- function(id,
}

fig <- pgx.plotExpression(
pd[["ngs"]],
pd[["pgx"]],
pd[["gene"]],
comp = pd[["comp"]],
grouped = pd[["grouped"]],
Expand Down
12 changes: 5 additions & 7 deletions components/board.expression/R/expression_plot_maplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ expression_plot_maplot_ui <- function(id,
#' @description A shiny Module for plotting (server code).
#'
#' @param id
#' @param inputData
#' @param pgx
#' @param gx_fdr
#' @param gx_contrast
#' @param gx_lfc
Expand All @@ -55,7 +55,7 @@ expression_plot_maplot_ui <- function(id,
#'
#' @export
expression_plot_maplot_server <- function(id,
inputData,
pgx,
gx_fdr,
gx_contrast,
gx_lfc,
Expand All @@ -75,9 +75,7 @@ expression_plot_maplot_server <- function(id,
if (length(comp1) == 0) {
return(NULL)
}

ngs <- inputData()
shiny::req(ngs)
shiny::req(pgx)

fdr <- as.numeric(gx_fdr())
lfc <- as.numeric(gx_lfc())
Expand All @@ -89,7 +87,7 @@ expression_plot_maplot_server <- function(id,
fc.genes <- as.character(res[, grep("^gene$|gene_name", colnames(res))])

## filter genes by gene family or gene set
fam.genes <- unique(unlist(ngs$families[10]))
fam.genes <- unique(unlist(pgx$families[10]))
fam.genes <- res$gene_name
if (gx_features() != "<all>") {
gset <- getGSETS(gx_features())
Expand Down Expand Up @@ -147,7 +145,7 @@ expression_plot_maplot_server <- function(id,
}

ylim <- c(-1, 1) * max(abs(y), na.rm = TRUE)
x <- rowMeans(ngs$X[rownames(res), ], na.rm = TRUE)
x <- rowMeans(pgx$X[rownames(res), ], na.rm = TRUE)

impt <- function(g) {
j <- match(g, fc.genes)
Expand Down
9 changes: 4 additions & 5 deletions components/board.expression/R/expression_plot_topfoldchange.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ expression_plot_topfoldchange_ui <- function(id,
#'
#' @param id
#' @param comp
#' @param ngs
#' @param pgx
#' @param sel
#' @param res
#' @param watermark
Expand All @@ -47,7 +47,7 @@ expression_plot_topfoldchange_ui <- function(id,
#' @export
expression_plot_topfoldchange_server <- function(id,
comp,
ngs,
pgx,
sel,
res,
watermark = FALSE) {
Expand All @@ -56,12 +56,11 @@ expression_plot_topfoldchange_server <- function(id,

plot_data <- shiny::reactive({
comp <- comp() # input$gx_contrast
ngs <- ngs()
sel <- sel()
res <- res()

psel <- rownames(res)[sel]
gene <- ngs$genes[psel, "gene_name"]
gene <- pgx$genes[psel, "gene_name"]

if (is.null(sel) || length(sel) == 0) { # Ugly
return(list(sel = sel))
Expand All @@ -70,7 +69,7 @@ expression_plot_topfoldchange_server <- function(id,
if (is.null(comp) || length(comp) == 0) {
return(NULL)
}
fc <- sapply(ngs$gx.meta$meta, function(x) x[psel, "meta.fx"])
fc <- sapply(pgx$gx.meta$meta, function(x) x[psel, "meta.fx"])
top.up <- head(names(sort(fc[which(fc > 0)], decreasing = TRUE)), 10)
top.dn <- head(names(sort(fc[which(fc < 0)], decreasing = FALSE)), 10)
fc.top <- c(fc[top.up], fc[top.dn])
Expand Down
15 changes: 7 additions & 8 deletions components/board.expression/R/expression_plot_topgenes.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ expression_plot_topgenes_ui <- function(id,
#'
#' @param id
#' @param comp
#' @param inputData
#' @param pgx
#' @param res
#' @param ii
#' @param watermark
Expand All @@ -64,7 +64,7 @@ expression_plot_topgenes_ui <- function(id,
#' @export
expression_plot_topgenes_server <- function(id,
comp,
inputData,
pgx,
res,
ii,
watermark = FALSE) {
Expand All @@ -73,8 +73,7 @@ expression_plot_topgenes_server <- function(id,

plot_data <- shiny::reactive({
comp <- comp() # input$gx_contrast
ngs <- inputData()
shiny::req(ngs)
shiny::req(pgx)

res <- res()
if (is.null(res) || nrow(res) == 0) {
Expand All @@ -98,7 +97,7 @@ expression_plot_topgenes_server <- function(id,
mar1 <- 3.5
ylab <- ifelse(logscale, "log2CPM", "CPM")

ny <- nrow(ngs$samples) ## ???!!
ny <- nrow(pgx$samples) ## ???!!
show.names <- ifelse(!grouped & ny > 25, FALSE, TRUE)
nx <- ifelse(grouped, 3, ny)
nc <- 4
Expand All @@ -112,7 +111,7 @@ expression_plot_topgenes_server <- function(id,

return(list(
res = res,
ngs = ngs,
pgx = pgx,
comp = comp,
grouped = grouped,
showothers = showothers,
Expand Down Expand Up @@ -141,7 +140,7 @@ expression_plot_topgenes_server <- function(id,
plts <- lapply(1:plots2show, function(x){
gene <- rownames(pd[["res"]])[x]
pgx.plotExpression(
pd[["ngs"]],
pd[["pgx"]],
# pd[["gene"]],
gene,
pd[["comp"]],
Expand Down Expand Up @@ -178,7 +177,7 @@ expression_plot_topgenes_server <- function(id,
## gene = sub(".*:","",top.up[i])
# gene <- rownames(pd[["res"]])[i]
# plt <- pgx.plotExpression(
# pd[["ngs"]],
# pd[["pgx"]],
# # pd[["gene"]],
# gene,
# pd[["comp"]],
Expand Down
9 changes: 4 additions & 5 deletions components/board.expression/R/expression_plot_volcanoAll.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ expression_plot_volcanoAll_ui <- function(id,
#' @return
#' @export
expression_plot_volcanoAll_server <- function(id,
inputData,
pgx,
getAllContrasts,
features,
fdr,
Expand All @@ -50,18 +50,17 @@ expression_plot_volcanoAll_server <- function(id,
moduleServer(id, function(input, output, session) {
# reactive function listening for changes in input
plot_data <- shiny::reactive({
ngs <- inputData()
features <- features()


if (is.null(ngs)) {
if (is.null(pgx)) {
return(NULL)
}
ct <- getAllContrasts()
F <- ct$F
Q <- ct$Q

## comp = names(ngs$gx.meta$meta)
## comp = names(pgx$gx.meta$meta)
comp <- names(F)
if (length(comp) == 0) {
return(NULL)
Expand All @@ -75,7 +74,7 @@ expression_plot_volcanoAll_server <- function(id,
fdr <- as.numeric(fdr())
lfc <- as.numeric(lfc())

sel.genes <- rownames(ngs$X)
sel.genes <- rownames(pgx$X)
if (features != "<all>") {
gset <- getGSETS(features)
sel.genes <- unique(unlist(gset))
Expand Down
Loading

0 comments on commit b40633a

Please sign in to comment.