diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index 6802b89..0000000 Binary files a/.DS_Store and /dev/null differ diff --git a/.gitignore b/.gitignore index c6e668b..56d1bbf 100644 --- a/.gitignore +++ b/.gitignore @@ -2,5 +2,6 @@ .Rhistory .RData .Ruserdata +.DS_Store src/*.o src/*.so diff --git a/DESCRIPTION b/DESCRIPTION index 30748e8..71b6bbe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,17 +15,27 @@ Imports: Matrix, ggplot2, reshape2, - patchwork, NMF, akima, gganimate, metap, circlize, ggalluvial, - networkD3, survival, survminer, parallel, - ComplexHeatmap + ComplexHeatmap, + RANN +Suggests: + shiny, + shinyWidgets, + bslib, + DT, + SeuratObject, + SeuratDisk, + png, + base64enc, + shinyjs, + shinyFeedback biocViews: ComplexHeatmap diff --git a/NAMESPACE b/NAMESPACE index a425d92..d829f0e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,10 @@ # Generated by roxygen2: do not edit by hand +import(ggplot2) +importFrom(ggalluvial,geom_alluvium) +importFrom(ggalluvial,geom_stratum) +importFrom(ggalluvial,to_lodes_form) + export(SecAct.CCC.circle) export(SecAct.CCC.dot) export(SecAct.CCC.heatmap) @@ -20,4 +25,5 @@ export(SecAct.signaling.pattern.gene) export(SecAct.signaling.velocity.scST) export(SecAct.signaling.velocity.spotST) export(SecAct.survival.plot) +export(runSecActApp) useDynLib(SecAct, .registration=TRUE) diff --git a/R/.DS_Store b/R/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/R/.DS_Store and /dev/null differ diff --git a/R/SecAct-package.R b/R/SecAct-package.R index c76bc81..cf8e06b 100644 --- a/R/SecAct-package.R +++ b/R/SecAct-package.R @@ -4,6 +4,8 @@ ## usethis namespace: start ## usethis namespace: end +#' @import ggplot2 +#' @importFrom ggalluvial geom_alluvium geom_stratum to_lodes_form #' @useDynLib SecAct, .registration=TRUE NULL diff --git a/R/activity.R b/R/activity.R index 8b0267d..11f819d 100644 --- a/R/activity.R +++ b/R/activity.R @@ -17,15 +17,10 @@ #' SecAct.inference.gsl <- function(Y, SigMat="SecAct", lambda=5e+05, nrand=1000) { - if(SigMat=="SecAct") - { - Xfile<- file.path(system.file(package = "SecAct"), "extdata/SecAct.tsv.gz") - X <- read.table(Xfile,sep="\t",check.names=F) - }else{ - X <- read.table(SigMat,sep="\t",check.names=F) - } + sig <- load_sig_matrix(SigMat, lambda) + X <- sig$X - olp <- intersect(row.names(Y),row.names(X)) + olp <- intersect(rownames(Y),rownames(X)) X <- as.matrix(X[olp,,drop=F]) Y <- as.matrix(Y[olp,,drop=F]) @@ -50,14 +45,7 @@ SecAct.inference.gsl <- function(Y, SigMat="SecAct", lambda=5e+05, nrand=1000) pvalue=double(p*m) ) - beta <- matrix(res$beta,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - se <- matrix(res$se,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - zscore <- matrix(res$zscore,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - pvalue <- matrix(res$pvalue,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - - res <- list(beta=beta, se=se, zscore=zscore, pvalue=pvalue) - - res + unpack_ridge_results(res, m, colnames(X), colnames(Y)) } #' @title Secreted protein activity inference @@ -79,15 +67,10 @@ SecAct.inference.gsl <- function(Y, SigMat="SecAct", lambda=5e+05, nrand=1000) #' SecAct.inference.r <- function(Y, SigMat="SecAct", lambda=5e+05, nrand=1000) { - if(SigMat=="SecAct") - { - Xfile<- file.path(system.file(package = "SecAct"), "extdata/SecAct.tsv.gz") - X <- read.table(Xfile,sep="\t",check.names=F) - }else{ - X <- read.table(SigMat,sep="\t",check.names=F) - } + sig <- load_sig_matrix(SigMat, lambda) + X <- sig$X - olp <- intersect(row.names(Y),row.names(X)) + olp <- intersect(rownames(Y),rownames(X)) X <- as.matrix(X[olp,,drop=F]) Y <- as.matrix(Y[olp,,drop=F]) @@ -193,11 +176,11 @@ SecAct.activity.inference <- function( nrand=1000 ) { - if(class(inputProfile)[1]=="SpaCET") + if(inherits(inputProfile, "SpaCET")) { stop("Please use 'SecAct.activity.inference.ST'.") } - if(class(inputProfile)[1]=="Seurat") + if(inherits(inputProfile, "Seurat")) { stop("Please use 'SecAct.activity.inference.scRNAseq'.") } @@ -229,29 +212,13 @@ SecAct.activity.inference <- function( } } - if(sigMatrix=="SecAct") - { - Xfile <- file.path(system.file(package = "SecAct"), "extdata/SecAct.tsv.gz") - X <- read.table(Xfile,sep="\t",check.names=F) - if(is.null(lambda)) lambda <- 5e+05 - - }else if(grepl("SecAct-",sigMatrix,fixed=TRUE)){ - Xfile <- paste0("https://hpc.nih.gov/~Jiang_Lab/SecAct_Package/",sigMatrix,"_filterByPan_ds3_vst.tsv") - X <- read.table(Xfile,sep="\t",check.names=F) - if(is.null(lambda)) lambda <- 5e+05 - - }else if(sigMatrix=="CytoSig"){ - Xfile <- "https://raw.githubusercontent.com/data2intelligence/CytoSig/refs/heads/master/CytoSig/signature.centroid" - X <- read.table(Xfile,sep="\t",check.names=F) - if(is.null(lambda)) lambda <- 10000 - - }else{ - X <- read.table(sigMatrix,sep="\t",check.names=F) - } + sig <- load_sig_matrix(sigMatrix, lambda) + X <- sig$X + lambda <- sig$lambda if(is.filter.sig==TRUE) { - X <- X[,colnames(X)%in%row.names(Y)] + X <- X[,colnames(X)%in%rownames(Y)] } if(is.group.sig==TRUE) @@ -272,7 +239,7 @@ SecAct.activity.inference <- function( X <- newsig } - olp <- intersect(row.names(Y),row.names(X)) + olp <- intersect(rownames(Y),rownames(X)) if(length(olp)<2) stop("The overlapped genes between your expression matrix and our signature matrix are too few!") @@ -300,26 +267,15 @@ SecAct.activity.inference <- function( pvalue=double(p*m) ) - beta <- matrix(res$beta,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - se <- matrix(res$se,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - zscore <- matrix(res$zscore,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) - pvalue <- matrix(res$pvalue,byrow=T,ncol=m,dimnames=list(colnames(X),colnames(Y))) + res <- unpack_ridge_results(res, m, colnames(X), colnames(Y)) if(is.group.sig==TRUE) { - beta <- expand_rows(beta) - se <- expand_rows(se) - zscore <- expand_rows(zscore) - pvalue <- expand_rows(pvalue) - - beta <- beta[sort(rownames(beta)),,drop=F] - se <- se[sort(rownames(beta)),,drop=F] - zscore <- zscore[sort(rownames(beta)),,drop=F] - pvalue <- pvalue[sort(rownames(beta)),,drop=F] + for(nm in names(res)) res[[nm]] <- expand_rows(res[[nm]]) + idx <- sort(rownames(res$beta)) + for(nm in names(res)) res[[nm]] <- res[[nm]][idx,,drop=F] } - res <- list(beta=beta, se=se, zscore=zscore, pvalue=pvalue) - res } @@ -351,7 +307,7 @@ SecAct.activity.inference.ST <- function( nrand=1000 ) { - if(!class(inputProfile)[1]=="SpaCET") + if(!inherits(inputProfile, "SpaCET")) { stop("Please input a SpaCET object.") } @@ -362,33 +318,19 @@ SecAct.activity.inference.ST <- function( rownames(expr) <- transferSymbol(rownames(expr)) expr <- rm_duplicates(expr) - # normalize to TPM - stats <- Matrix::colSums(expr) - expr <- sweep_sparse(expr,2,stats,"/") - expr@x <- expr@x * scale.factor - - # transform to log space - expr@x <- log2(expr@x + 1) + expr <- normalize_log_sparse(expr, scale.factor) if(is.null(inputProfile_control)) { - # normalized with the control samples expr.diff <- expr - Matrix::rowMeans(expr) }else{ - # extract count matrix expr_control <- inputProfile_control@input$counts expr_control <- expr_control[Matrix::rowSums(expr_control)>0,] rownames(expr_control) <- transferSymbol(rownames(expr_control)) expr_control <- rm_duplicates(expr_control) - # normalize to TPM - stats <- Matrix::colSums(expr_control) - expr_control <- sweep_sparse(expr_control,2,stats,"/") - expr_control@x <- expr_control@x * scale.factor - - # transform to log space - expr_control@x <- log2(expr_control@x + 1) + expr_control <- normalize_log_sparse(expr_control, scale.factor) olp <- intersect(rownames(expr), rownames(expr_control)) expr.diff <- expr[olp,] - Matrix::rowMeans(expr_control[olp,]) @@ -438,19 +380,12 @@ SecAct.activity.inference.scRNAseq <- function( nrand=1000 ) { - if(!class(inputProfile)[1]=="Seurat") + if(!inherits(inputProfile, "Seurat")) { stop("Please input a Seurat object.") } - if(class(inputProfile@assays$RNA)=="Assay5") - { - counts <- inputProfile@assays$RNA@layers$counts - colnames(counts) <- rownames(inputProfile@assays$RNA@cells) - rownames(counts) <- rownames(inputProfile@assays$RNA@features) - }else{ - counts <- inputProfile@assays$RNA@counts - } + counts <- extract_seurat_counts(inputProfile) rownames(counts) <- transferSymbol(rownames(counts)) counts <- rm_duplicates(counts) diff --git a/R/downstream.R b/R/downstream.R index a0c819f..87e934f 100644 --- a/R/downstream.R +++ b/R/downstream.R @@ -13,7 +13,7 @@ #' SecAct.signaling.pattern <- function(SpaCET_obj, scale.factor = 1e+05, radius=200, k) { - if(class(SpaCET_obj)!="SpaCET") + if(!inherits(SpaCET_obj, "SpaCET")) { stop("SpaCET object is requried.") } @@ -31,44 +31,18 @@ SecAct.signaling.pattern <- function(SpaCET_obj, scale.factor = 1e+05, radius=20 rownames(exp) <- transferSymbol(rownames(exp)) exp <- rm_duplicates(exp) - # normalize to TPM - stats <- Matrix::colSums(exp) - exp <- sweep_sparse(exp,2,stats,"/") - exp@x <- exp@x * scale.factor + exp <- normalize_log_sparse(exp, scale.factor) - # transform to log space - exp@x <- log2(exp@x + 1) - - ## only need SPs weights <- calWeights( SpaCET_obj@input$spotCoordinates[,c("coordinate_x_um","coordinate_y_um")], radius=radius, sigma=100, diagAsZero=TRUE) - act_new <- act[,colnames(weights)] # remove spot island - exp_new <- exp[,colnames(weights)] # remove spot island + act_new <- act[,colnames(weights)] + exp_new <- exp[,colnames(weights)] exp_new_aggr <- exp_new %*% weights - corr <- data.frame() - for(gene in rownames(act_new)) - { - act_gene <- act_new[gene,] - - if(gene%in%rownames(exp_new)) - { - exp_gene <- exp_new_aggr[gene,] - - cor_res <- cor.test(act_gene, exp_gene, method="spearman") - - corr[gene,"r"] <- cor_res$estimate - corr[gene,"p"] <- cor_res$p.value - }else{ - corr[gene,"r"] <- NA - corr[gene,"p"] <- NA - } - } - - corr <- cbind(corr, padj=p.adjust(corr[,"p"], method="BH") ) + corr <- compute_spatial_correlation(act_new, exp_new, exp_new_aggr) corr_genes <- rownames(corr[!is.na(corr[,"r"])&corr[,"r"]>0.05&corr[,"padj"]<0.01,]) print(paste0(length(corr_genes),"/",nrow(act_new)," secreted proteins are kept to infer signaling patterns.")) @@ -77,16 +51,13 @@ SecAct.signaling.pattern <- function(SpaCET_obj, scale.factor = 1e+05, radius=20 print("Step 2. NMF") - suppressPackageStartupMessages({ - library(NMF) - }) - act_nneg <- nneg(act[corr_genes,]) + act_nneg <- NMF::nneg(act[corr_genes,]) if(length(k)==1) { - NMF_res <- nmf(act_nneg, k, seed=123456) + NMF_res <- NMF::nmf(act_nneg, k, seed=123456) }else{ - estim.r <- nmf(act_nneg, k, nrun=10, seed=123456) + estim.r <- NMF::nmf(act_nneg, k, nrun=10, seed=123456) v <- estim.r$measures$silhouette.coef v_diff <- v[1:(length(v)-1)]-v[2:length(v)] @@ -95,7 +66,7 @@ SecAct.signaling.pattern <- function(SpaCET_obj, scale.factor = 1e+05, radius=20 print(paste0("The optimal number of factors k = ", k)) - NMF_res <- nmf(act_nneg, k, seed=123456) + NMF_res <- NMF::nmf(act_nneg, k, seed=123456) } weight.W <- NMF_res@fit@W @@ -134,8 +105,8 @@ SecAct.signaling.pattern.gene <- function(SpaCET_obj, n) temp[,-n] <- 2*temp[,-n] # in case one column # identify secreted proteins with pattern n - res <- weight.W[apply(temp,1,function(x) x[n]==max(x)),] - res[order(res[,3],decreasing = TRUE),] + res <- weight.W[apply(temp,1,function(x) x[n]==max(x)),,drop=FALSE] + res[order(res[,n],decreasing = TRUE),,drop=FALSE] } @@ -166,11 +137,11 @@ SecAct.signaling.velocity.spotST <- function( signalMode="receiving", radius=200, contourMap=FALSE, - coutourBins=11, + contourBins=11, animated=FALSE ) { - if(class(SpaCET_obj)!="SpaCET") + if(!inherits(SpaCET_obj, "SpaCET")) { stop("SpaCET object is requried.") } @@ -183,9 +154,6 @@ SecAct.signaling.velocity.spotST <- function( stop("contourMap and animated can not be TRUE simultaneously.") } - library(ggplot2) - library(patchwork) - act <- SpaCET_obj@results$SecAct_output$SecretedProteinActivity$zscore act[act<0] <- 0 @@ -193,13 +161,7 @@ SecAct.signaling.velocity.spotST <- function( rownames(exp) <- transferSymbol(rownames(exp)) exp <- rm_duplicates(exp) - # normalize to TPM - stats <- Matrix::colSums(exp) - exp <- sweep_sparse(exp,2,stats,"/") - exp@x <- exp@x * scale.factor - - # transform to log space - exp@x <- log2(exp@x + 1) + exp <- normalize_log_sparse(exp, scale.factor) weights <- calWeights( SpaCET_obj@input$spotCoordinates[,c("coordinate_x_um","coordinate_y_um")], @@ -360,9 +322,7 @@ SecAct.signaling.velocity.spotST <- function( if(contourMap==TRUE) { - library(akima) - # Interpolate onto grid - interp_res <- interp( + interp_res <- akima::interp( x = fig.df$x, y = fig.df$y, z = fig.df$value, @@ -387,10 +347,8 @@ SecAct.signaling.velocity.spotST <- function( ,] p <- ggplot(grid_df,aes(x=x,y=y))+ - geom_contour_filled(aes(z=z),bins = coutourBins) + + geom_contour_filled(aes(z=z),bins = contourBins) + scale_fill_brewer(palette = "RdYlGn",direction = -1)+ - #scale_fill_manual(values=c("#b8e186","#de77ae","#c51b7d"))+ - #scale_fill_manual(values=c("#000004FF","#1C1044FF","#4F127BFF","#812581FF","#B5367AFF","#E55064FF","#FB8761FF","#FEC287FF","#FCFDBFFF"))+ scale_x_continuous(limits = c(0, xDiml), expand = c(0, 0)) + scale_y_continuous(limits = c(0, yDiml), expand = c(0, 0)) + ggtitle(paste0(gene," (",signalMode,")"))+ @@ -402,10 +360,7 @@ SecAct.signaling.velocity.spotST <- function( }else{ p <- ggplot(fig.df,aes(x=x,y=y))+ - #annotation_custom(image$grob)+ geom_point(aes(colour=value))+ - #scale_color_brewer(palette = "RdYlGn",direction = -1)+ - #scale_color_gradientn(colors=c("#a5a6ff","#ff72a1","brown"))+ scale_color_gradientn(colors=c("#b8e186","#de77ae","#c51b7d"))+ scale_x_continuous(limits = c(0, xDiml), expand = c(0, 0)) + scale_y_continuous(limits = c(0, yDiml), expand = c(0, 0)) + @@ -419,8 +374,7 @@ SecAct.signaling.velocity.spotST <- function( if(animated==TRUE) { - library(gganimate) - p <- animate(p+transition_time(tim),nframes=15) + p <- gganimate::animate(p+gganimate::transition_time(tim),nframes=15) } p @@ -476,7 +430,7 @@ SecAct.signaling.velocity.scST <- function( arrow.size = 0.3 ) { - if(class(SpaCET_obj)!="SpaCET") + if(!inherits(SpaCET_obj, "SpaCET")) { stop("SpaCET object is requried.") } @@ -493,32 +447,16 @@ SecAct.signaling.velocity.scST <- function( cellType2_cells <- which(cellType_vec==receiver) - nn_result <- RANN::nn2(coordinate_mat[,c("coordinate_x_um","coordinate_y_um")], k=100, searchtype="radius", radius=radius) - - neighbor_indices <- nn_result$nn.idx - neighbor_distances <- nn_result$nn.dists - - i <- rep(1:nrow(neighbor_indices), each=ncol(neighbor_indices)) # row indices (cell index) - j <- as.vector(t(neighbor_indices)) - x <- as.vector(t(neighbor_distances)) - - valid <- x<=radius & x>0 - i <- i[valid] # Keep only valid indices - j <- j[valid] # Valid neighbor indices - x <- x[valid] # Valid distances - + nb <- find_neighbors(coordinate_mat, radius) exp <- SpaCET_obj@input$counts rownames(exp) <- transferSymbol(rownames(exp)) exp <- rm_duplicates(exp) - - act <- SpaCET_obj @results $SecAct_output $SecretedProteinActivity$zscore + act <- SpaCET_obj@results$SecAct_output$SecretedProteinActivity$zscore act[act<0] <- 0 - - - Tmat <- data.frame(i,j) + Tmat <- data.frame(i=nb$i, j=nb$j) # all cell pair Tmat_cellTypePair <- Tmat[Tmat[,"i"]%in%cellType1_cells & Tmat[,"j"]%in%cellType2_cells, ,drop=F] @@ -635,7 +573,7 @@ SecAct.CCC.scST <- function( coreNo=6 ) { - if(class(SpaCET_obj)!="SpaCET") + if(!inherits(SpaCET_obj, "SpaCET")) { stop("SpaCET object is requried.") } @@ -660,72 +598,30 @@ SecAct.CCC.scST <- function( rownames(exp) <- transferSymbol(rownames(exp)) exp <- rm_duplicates(exp) - # normalize to TPM - stats <- Matrix::colSums(exp) - exp <- sweep_sparse(exp,2,stats,"/") - exp@x <- exp@x * scale.factor - - # transform to log space - exp@x <- log2(exp@x + 1) - - - nn_result <- RANN::nn2(coordinate_mat[,c("coordinate_x_um","coordinate_y_um")], k=100, searchtype="radius", radius=radius) - - neighbor_indices <- nn_result$nn.idx - neighbor_distances <- nn_result$nn.dists - - i <- rep(1:nrow(neighbor_indices), each=ncol(neighbor_indices)) # row indices (cell index) - j <- as.vector(t(neighbor_indices)) - x <- as.vector(t(neighbor_distances)) + exp <- normalize_log_sparse(exp, scale.factor) - valid <- x<=radius & x>0 - i <- i[valid] # Keep only valid indices - j <- j[valid] # Valid neighbor indices - x <- x[valid] # Valid distances + nb <- find_neighbors(coordinate_mat, radius) - # Create the sparse matrix using the 'i', 'j', and 'x' vectors - library(Matrix) - distance_mat <- sparseMatrix(i=i, j=j, x=x, dims=c(nrow(neighbor_indices), nrow(neighbor_indices)), repr="T") + distance_mat <- Matrix::sparseMatrix(i=nb$i, j=nb$j, x=nb$x, dims=c(nb$n, nb$n), repr="T") rownames(distance_mat) <- rownames(coordinate_mat) colnames(distance_mat) <- rownames(coordinate_mat) - weights <- distance_mat weights@x <- as.numeric(weights@x>0) - - act <- SpaCET_obj @results $SecAct_output $SecretedProteinActivity$zscore + act <- SpaCET_obj@results$SecAct_output$SecretedProteinActivity$zscore act[act<0] <- 0 - act_new <- act[,colnames(weights)] # remove spot island - exp_new <- exp[,colnames(weights)] # remove spot island - + act_new <- act[,colnames(weights)] + exp_new <- exp[,colnames(weights)] exp_new_aggr <- exp_new %*% weights - if(is.null(SpaCET_obj @results $SecAct_output $ccc.SP)) + if(is.null(SpaCET_obj@results$SecAct_output$ccc.SP)) { - corr <- data.frame() - for(gene in rownames(act_new)) - { - act_gene <- act_new[gene,] - - if(gene%in%rownames(exp_new)) - { - exp_gene <- exp_new_aggr[gene,] - - cor_res <- cor.test(act_gene, exp_gene, method="spearman") - - corr[gene,"r"] <- cor_res$estimate - corr[gene,"p"] <- cor_res$p.value - }else{ - corr[gene,"r"] <- NA - corr[gene,"p"] <- NA - } - } - corr <- cbind(corr, padj=p.adjust(corr[,"p"], method="BH") ) + corr <- compute_spatial_correlation(act_new, exp_new, exp_new_aggr) }else{ - SpaCET_obj @results $SecAct_output $ccc.SP -> corr + corr <- SpaCET_obj@results$SecAct_output$ccc.SP } corr_genes <- rownames(corr[!is.na(corr[,"r"])&corr[,"r"]>0.05&corr[,"padj"]<0.01,]) @@ -747,7 +643,7 @@ SecAct.CCC.scST <- function( olp <- corr_genes - Tmat <- data.frame(i,j) + Tmat <- data.frame(i=nb$i, j=nb$j) compute_pair <- function(m) { @@ -803,7 +699,6 @@ SecAct.CCC.scST <- function( neighboringCellPairs = n_neighbor, communicatingCellPairs = n_communication, ratio = posRatio, - #score = CCC_raw/mean(CCC1000), pv = (sum(CCC1000 >= CCC_raw) + 1) / 1001 ) } @@ -831,7 +726,6 @@ SecAct.CCC.scST <- function( neighboringCellPairs = n_neighbor, communicatingCellPairs = n_communication, ratio = posRatio, - #score = CCC_raw/mean(CCC1000), pv = (sum(CCC1000 >= CCC_raw) + 1) / 1001 ) } @@ -899,19 +793,12 @@ SecAct.CCC.scRNAseq <- function( nrand=1000 ) { - if(!class(Seurat_obj)[1]=="Seurat") + if(!inherits(Seurat_obj, "Seurat")) { stop("Please input a Seurat object.") } - if(class(Seurat_obj@assays$RNA)=="Assay5") - { - counts <- Seurat_obj@assays$RNA@layers$counts - colnames(counts) <- rownames(Seurat_obj@assays$RNA@cells) - rownames(counts) <- rownames(Seurat_obj@assays$RNA@features) - }else{ - counts <- Seurat_obj@assays$RNA@counts - } + counts <- extract_seurat_counts(Seurat_obj) rownames(counts) <- transferSymbol(rownames(counts)) counts <- rm_duplicates(counts) @@ -950,16 +837,7 @@ SecAct.CCC.scRNAseq <- function( } if(ncol(expr)<30) next - # normalize to TPM - stats <- Matrix::colSums(expr) - expr <- sweep_sparse(expr,2,stats,"/") - expr@x <- expr@x * scale.factor - - # transform to log space - expr@x <- log2(expr@x + 1) - - expr_case <- expr - + expr_case <- normalize_log_sparse(expr, scale.factor) # control if(is.null(condition_meta)) @@ -969,15 +847,7 @@ SecAct.CCC.scRNAseq <- function( expr <- counts[,meta[,condition_meta]==conditionControl&meta[,cellType_meta]==cellType,drop=FALSE] } - # normalize to TPM - stats <- Matrix::colSums(expr) - expr <- sweep_sparse(expr,2,stats,"/") - expr@x <- expr@x * scale.factor - - # transform to log space - expr@x <- log2(expr@x + 1) - - expr_control <- expr + expr_control <- normalize_log_sparse(expr, scale.factor) # case vs control @@ -1171,10 +1041,9 @@ SecAct.CCC.scRNAseq <- function( { ccc[,"overall_strength"] <- ccc[,"sender_exp_logFC"] * ccc[,"receiver_act_diff"] - library(metap) - ccc[ccc[,"sender_exp_pv"]==0,"sender_exp_pv"] <- .Machine$double.xmin # sumlog requires non-zero + ccc[ccc[,"sender_exp_pv"]==0,"sender_exp_pv"] <- .Machine$double.xmin - ccc[,"overall_pv"] <- apply(ccc[,c("sender_exp_pv","receiver_act_pv")],1,function(x) sumlog(x)$p) + ccc[,"overall_pv"] <- apply(ccc[,c("sender_exp_pv","receiver_act_pv")],1,function(x) metap::sumlog(x)$p) ccc[,"overall_pv.adj"] <- p.adjust(ccc[,"overall_pv"], method="BH") ccc <- ccc[ccc[,"overall_pv.adj"] 0 + list(i=i[valid], j=j[valid], x=x[valid], n=nrow(neighbor_indices)) +} + +compute_spatial_correlation <- function(act_new, exp_new, exp_new_aggr) +{ + genes <- rownames(act_new) + n <- length(genes) + rs <- numeric(n) + ps <- numeric(n) + names(rs) <- names(ps) <- genes + + for(i in seq_len(n)) + { + gene <- genes[i] + if(gene %in% rownames(exp_new)) + { + cor_res <- cor.test(act_new[gene,], exp_new_aggr[gene,], method="spearman") + rs[i] <- cor_res$estimate + ps[i] <- cor_res$p.value + }else{ + rs[i] <- NA + ps[i] <- NA + } + } + data.frame(r=rs, p=ps, padj=p.adjust(ps, method="BH")) +} + +unpack_ridge_results <- function(res, m, X_colnames, Y_colnames) +{ + dims <- list(X_colnames, Y_colnames) + list( + beta = matrix(res$beta, byrow=TRUE, ncol=m, dimnames=dims), + se = matrix(res$se, byrow=TRUE, ncol=m, dimnames=dims), + zscore = matrix(res$zscore, byrow=TRUE, ncol=m, dimnames=dims), + pvalue = matrix(res$pvalue, byrow=TRUE, ncol=m, dimnames=dims) + ) +} diff --git a/R/visualization.R b/R/visualization.R index 61d1a8e..36dec9c 100644 --- a/R/visualization.R +++ b/R/visualization.R @@ -10,46 +10,21 @@ #' SecAct.CCC.heatmap <- function(data, row.sorted=FALSE, column.sorted=FALSE, colors_cellType) { - if(class(data)[1]=="SpaCET") - { - ccc <- data @results $SecAct_output $SecretedProteinCCC - } - if(class(data)[1]=="Seurat") - { - ccc <- data @misc $SecAct_output $SecretedProteinCCC - } - - ccc <- cbind(ccc, communication=1) - ccc <- cbind(ccc, senderReceiver=paste0(ccc[,"sender"],"-",ccc[,"receiver"])) - - - mat = reshape2::acast( ccc[,c("sender","receiver","communication")], sender~receiver, length, value.var="communication") - - cellTypes <- sort(unique(c(rownames(mat),colnames(mat)))) - for(cellType in cellTypes) - { - if(cellType%in%rownames(mat)&cellType%in%colnames(mat)) - { - mat[cellType,cellType] <- NA - } - } - - suppressPackageStartupMessages({ - library(ComplexHeatmap) - }) + ccc <- extract_ccc_data(data) + mat <- build_ccc_matrix(ccc) if(row.sorted==TRUE) mat <- mat[order(apply(mat,1,function(x) sum(x,na.rm=T)),decreasing=T),,drop=F] if(column.sorted==TRUE) mat <- mat[,order(apply(mat,2,function(x) sum(x,na.rm=T)),decreasing=T),drop=F] - row_ha <- rowAnnotation( - Count = anno_barplot(rowSums(mat,na.rm=T),gp = gpar(fill = colors_cellType[rownames(mat)]) ) + row_ha <- ComplexHeatmap::rowAnnotation( + Count = ComplexHeatmap::anno_barplot(rowSums(mat,na.rm=T),gp = grid::gpar(fill = colors_cellType[rownames(mat)]) ) ) - column_ha <- columnAnnotation( - Count = anno_barplot(colSums(mat,na.rm=T),gp = gpar(fill = colors_cellType[colnames(mat)]) ), + column_ha <- ComplexHeatmap::columnAnnotation( + Count = ComplexHeatmap::anno_barplot(colSums(mat,na.rm=T),gp = grid::gpar(fill = colors_cellType[colnames(mat)]) ), annotation_name_side = "left" ) - ht <- Heatmap(as.matrix(mat), + ht <- ComplexHeatmap::Heatmap(as.matrix(mat), name = "Count", col = circlize::colorRamp2(c(-50, 0,50), c("green", "white", "red")), row_names_side = "left", @@ -61,10 +36,10 @@ SecAct.CCC.heatmap <- function(data, row.sorted=FALSE, column.sorted=FALSE, colo right_annotation = row_ha, cluster_rows = FALSE, cluster_columns = FALSE, - cell_fun = function(j, i, x, y, width, height, fill) {grid.text(mat[i, j], x, y)} + cell_fun = function(j, i, x, y, width, height, fill) {grid::grid.text(mat[i, j], x, y)} ) - draw(ht) + ComplexHeatmap::draw(ht) } @@ -78,39 +53,12 @@ SecAct.CCC.heatmap <- function(data, row.sorted=FALSE, column.sorted=FALSE, colo #' SecAct.CCC.circle <- function(data, colors_cellType, sender=NULL, receiver=NULL) { - if(class(data)[1]=="SpaCET") - { - ccc <- data @results $SecAct_output $SecretedProteinCCC - } - if(class(data)[1]=="Seurat") - { - ccc <- data @misc $SecAct_output $SecretedProteinCCC - } - - ccc <- cbind(ccc, communication=1) - ccc <- cbind(ccc, senderReceiver=paste0(ccc[,"sender"],"-",ccc[,"receiver"])) - - - mat = reshape2::acast( ccc[,c("sender","receiver","communication")], sender~receiver, length, value.var="communication") - - cellTypes <- sort(unique(c(rownames(mat),colnames(mat)))) - for(cellType in cellTypes) - { - if(cellType%in%rownames(mat)&cellType%in%colnames(mat)) - { - mat[cellType,cellType] <- NA - } - } - - suppressPackageStartupMessages({ - library(circlize) - }) - - #mat = log(mat+1) + ccc <- extract_ccc_data(data) + mat <- build_ccc_matrix(ccc) if(is.null(sender)&is.null(receiver)) { - chordDiagram( + circlize::chordDiagram( mat, directional = 1, grid.col = colors_cellType, @@ -124,16 +72,16 @@ SecAct.CCC.circle <- function(data, colors_cellType, sender=NULL, receiver=NULL) col_mat <- mat for(i in 1:nrow(col_mat)) { - col_mat[i,] <- my_cols[rownames(col_mat)[i]] + col_mat[i,] <- colors_cellType[rownames(col_mat)[i]] } if(!is.null(receiver)) col_mat[,!colnames(col_mat)%in%receiver] = "#00000000" if(!is.null(sender)) col_mat[!rownames(col_mat)%in%sender,] = "#00000000" - chordDiagram( + circlize::chordDiagram( mat, directional = 1, - grid.col = my_cols, + grid.col = colors_cellType, col = col_mat, annotationTrack = c("name", "grid"), direction.type = c("diffHeight", "arrows"), @@ -161,18 +109,7 @@ SecAct.CCC.circle <- function(data, colors_cellType, sender=NULL, receiver=NULL) #' SecAct.CCC.sankey <- function(data, colors_cellType, sender=NULL, secretedProtein=NULL, receiver=NULL) { - if(class(data)[1]=="SpaCET") - { - ccc <- data @results $SecAct_output $SecretedProteinCCC - } - if(class(data)[1]=="Seurat") - { - ccc <- data @misc $SecAct_output $SecretedProteinCCC - } - - ccc <- cbind(ccc, communication=1) - ccc <- cbind(ccc, senderReceiver=paste0(ccc[,"sender"],"-",ccc[,"receiver"])) - + ccc <- extract_ccc_data(data) ccc_sub <- ccc[ ccc[,"sender"]%in%sender & @@ -181,12 +118,6 @@ SecAct.CCC.sankey <- function(data, colors_cellType, sender=NULL, secretedProtei ,] - suppressPackageStartupMessages({ - library(ggalluvial) - library(networkD3) - }) - - ccc_sub[,"sender"] <- factor( ccc_sub[,"sender"], levels=names(sort(table(ccc_sub[,"sender"]),decreasing = T)) @@ -197,14 +128,14 @@ SecAct.CCC.sankey <- function(data, colors_cellType, sender=NULL, secretedProtei levels=names(sort(table(ccc_sub[,"receiver"]),decreasing = T)) ) - ccc_sub_long <- to_lodes_form(data.frame(ccc_sub), + ccc_sub_long <- ggalluvial::to_lodes_form(data.frame(ccc_sub), key = "Demographic", value = "Group", id = "Cohort", axes = 1:3) ggplot(ccc_sub_long, aes(x = Demographic, stratum = Group, alluvium = Cohort, y = communication)) + - geom_alluvium(aes(fill=Group)) + - geom_stratum(aes(fill=Group)) + - scale_fill_manual(values=my_cols, na.value="grey88")+ + ggalluvial::geom_alluvium(aes(fill=Group)) + + ggalluvial::geom_stratum(aes(fill=Group)) + + scale_fill_manual(values=colors_cellType, na.value="grey88")+ geom_text(stat = "stratum", aes(label = after_stat(stratum)))+ theme_void()+ theme( @@ -227,17 +158,7 @@ SecAct.CCC.sankey <- function(data, colors_cellType, sender=NULL, secretedProtei #' SecAct.CCC.dot <- function(data, sender=NULL, secretedProtein=NULL, receiver=NULL) { - if(class(data)[1]=="SpaCET") - { - ccc <- data @results $SecAct_output $SecretedProteinCCC - } - if(class(data)[1]=="Seurat") - { - ccc <- data @misc $SecAct_output $SecretedProteinCCC - } - - ccc <- cbind(ccc, communication=1) - ccc <- cbind(ccc, senderReceiver=paste0(ccc[,"sender"],"-",ccc[,"receiver"])) + ccc <- extract_ccc_data(data) ccc_sub <- ccc[ ccc[,"sender"]%in%sender & @@ -245,7 +166,7 @@ SecAct.CCC.dot <- function(data, sender=NULL, secretedProtein=NULL, receiver=NUL ccc[,"receiver"]%in%receiver ,] - if(class(data)[1]=="SpaCET") + if(inherits(data, "SpaCET")) { fg.df <- ccc_sub[,c("sender","secretedProtein","receiver","ratio","pv")] @@ -253,7 +174,7 @@ SecAct.CCC.dot <- function(data, sender=NULL, secretedProtein=NULL, receiver=NUL fg.df <- cbind(fg.df, score=fg.df[,"ratio"]) fg.df <- cbind(fg.df, logpv=-log10(fg.df[,"pv"])) } - if(class(data)[1]=="Seurat") + if(inherits(data, "Seurat")) { fg.df <- ccc_sub[,c("sender","secretedProtein","receiver","overall_strength","overall_pv")] @@ -300,7 +221,6 @@ SecAct.heatmap.plot <- function(fg.mat, title=NULL, colors=c("#03c383","#aad962" fg.df[["Var1"]] <- factor(fg.df[["Var1"]], levels=rev(rownames(fg.mat))) fg.df[["Var2"]] <- factor(fg.df[["Var2"]], levels=colnames(fg.mat)) - library(ggplot2) ggplot(fg.df, aes(Var2, Var1, fill=Activity)) + geom_tile(color = "white") + scale_fill_gradientn(colours = colors)+ @@ -336,7 +256,6 @@ SecAct.bar.plot <- function(fg.vec, title=NULL, colors=c("#91bfdb","#fc8d59")) fg.df <- cbind(fg.df, hjust=ifelse(fg.vec<0,0,1)) fg.df[["gene"]] <- factor(fg.df[["gene"]], levels=names(sort(fg.vec))) - library(ggplot2) ggplot(fg.df, aes(gene, value, label=gene)) + geom_col(aes(fill=dir), width = .88, color = "white") + geom_text(aes(y = y, hjust=hjust), angle = 0) + @@ -376,7 +295,6 @@ SecAct.lollipop.plot <- function(fg.vec, title=NULL) fg.df <- cbind(fg.df, hjust=ifelse(fg.vec<0,0,1)) fg.df[["gene"]] <- factor(fg.df[["gene"]], levels=names(sort(fg.vec))) - library(ggplot2) ggplot(fg.df, aes(gene, value, label=gene)) + geom_segment(aes(x = gene, xend = gene, y = 0, yend = value), color = "grey") + geom_point(color = "#619CFF", size=3)+ @@ -422,19 +340,16 @@ SecAct.survival.plot <- function(mat, surv, gene, x.title="Time") data <- Y_olp[,gene,drop=F] survival <- X_olp margin <- 5 - # align matrix names common = Reduce(intersect, list(rownames(data),rownames(survival))) - # sprintf("%s samples", length(common)) data = data[common,,drop=F] survival = survival[common,,drop=F] - # stop at low death rate death_rate = sum(survival[,2])/dim(survival)[1] - if(length(death_rate) < 0.1) q() + if(death_rate < 0.1) stop("Death rate too low for survival analysis.") # split up survival and background - surv = Surv(survival[,1], survival[,2]) + surv = survival::Surv(survival[,1], survival[,2]) if(dim(survival)[2] > 2){ B = survival[,3:dim(survival)[2], drop=F] @@ -493,11 +408,10 @@ SecAct.survival.plot <- function(mat, surv, gene, x.title="Time") groups <- as.character(data[,gene]>cutoff) - library(survminer) surv.df <- cbind(survival,groups) - fit <- survfit(Surv(Time, Event) ~ groups, data = surv.df) + fit <- survival::survfit(survival::Surv(Time, Event) ~ groups, data = surv.df) - ggsurvplot(fit, + survminer::ggsurvplot(fit, data=surv.df, palette = c("blue","red"), legend.labs = c(paste0("Low (n=",sum(groups=="FALSE"),")"),paste0("High (n=",sum(groups=="TRUE"),")")) @@ -505,3 +419,28 @@ SecAct.survival.plot <- function(mat, surv, gene, x.title="Time") xlab(x.title)+ ylab("Percentage") } + + +#' @title Launch SecAct Visualization App +#' @description Launch the unified SecAct Shiny application for exploring +#' secreted protein activity across bulk, single-cell, and spatial data. +#' @param port Port to run the app on. Default NULL uses Shiny's default. +#' @param launch.browser Whether to launch a browser window. Default TRUE. +#' @param ... Additional arguments passed to shiny::runApp. +#' @return Invisible NULL (runs the app). +#' @rdname runSecActApp +#' @export +#' +runSecActApp <- function(port = NULL, launch.browser = TRUE, ...) { + if (!requireNamespace("shiny", quietly = TRUE)) { + stop("The 'shiny' package is required to run the SecAct app.\n", + "Install it with: install.packages('shiny')") + } + + app_dir <- system.file("shiny", "SecActApp", package = "SecAct") + if (app_dir == "") { + stop("Could not find the SecAct Shiny app. Try reinstalling the SecAct package.") + } + + shiny::runApp(app_dir, port = port, launch.browser = launch.browser, ...) +} diff --git a/docs/articles/.DS_Store b/docs/articles/.DS_Store deleted file mode 100644 index 97b5bbd..0000000 Binary files a/docs/articles/.DS_Store and /dev/null differ diff --git a/docs/articles/img/.DS_Store b/docs/articles/img/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/docs/articles/img/.DS_Store and /dev/null differ diff --git a/docs/reference/.DS_Store b/docs/reference/.DS_Store deleted file mode 100644 index 4cc7846..0000000 Binary files a/docs/reference/.DS_Store and /dev/null differ diff --git a/docs/reference/figures/.DS_Store b/docs/reference/figures/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/docs/reference/figures/.DS_Store and /dev/null differ diff --git a/inst/.DS_Store b/inst/.DS_Store deleted file mode 100644 index 3b72be5..0000000 Binary files a/inst/.DS_Store and /dev/null differ diff --git a/inst/extdata/.DS_Store b/inst/extdata/.DS_Store deleted file mode 100644 index 4943886..0000000 Binary files a/inst/extdata/.DS_Store and /dev/null differ diff --git a/inst/extdata/Visium_HCC/.DS_Store b/inst/extdata/Visium_HCC/.DS_Store deleted file mode 100644 index a6ae830..0000000 Binary files a/inst/extdata/Visium_HCC/.DS_Store and /dev/null differ diff --git a/inst/shiny/SecActApp/R/mod_bulk.R b/inst/shiny/SecActApp/R/mod_bulk.R new file mode 100644 index 0000000..1a47656 --- /dev/null +++ b/inst/shiny/SecActApp/R/mod_bulk.R @@ -0,0 +1,255 @@ +# Bulk Analysis Module +# Two workflows: Activity Change (treatment vs control) and Cohort Survival. + +source(file.path("R", "utils_viz.R"), local = TRUE) + +bulkUI <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::tabsetPanel( + id = ns("bulkSubTabs"), + + # Sub-tab 1: Activity Change + shiny::tabPanel("Activity Change", + shiny::fluidRow( + shiny::column(4, + shiny::wellPanel( + shiny::h4("Activity Change", style = paste0("color: ", UI_COLORS$primary)), + shiny::p("Compare secreted protein activity between treatment and control.", + style = "color: #666; font-size: 0.9em;"), + shiny::fileInput(ns("treatmentFile"), "Treatment expression (CSV/TSV/RDS):"), + shiny::fileInput(ns("controlFile"), "Control expression (CSV/TSV/RDS):"), + shiny::checkboxInput(ns("singleSample"), "Single-sample level analysis", value = FALSE), + shiny::actionButton(ns("runChangeBtn"), "Run Activity Change", + class = "btn-primary btn-block", icon = shiny::icon("play")), + shiny::hr(), + shiny::textOutput(ns("changeStatus")) + ) + ), + shiny::column(8, + shiny::conditionalPanel( + condition = paste0("output['", ns("hasChangeResults"), "']"), + shiny::wellPanel( + shiny::h4("Activity Change Results", style = paste0("color: ", UI_COLORS$primary)), + shiny::plotOutput(ns("barPlot"), height = "400px"), + shiny::br(), + DT::dataTableOutput(ns("changeTable")), + shiny::br(), + shiny::downloadButton(ns("downloadChange"), "Download Results (CSV)", class = "btn-success") + ) + ), + shiny::conditionalPanel( + condition = paste0("!output['", ns("hasChangeResults"), "']"), + shiny::div( + style = "text-align: center; padding: 80px 0; color: #999;", + shiny::h3("Upload treatment and control expression data"), + shiny::p("Rows = genes, Columns = samples. Values should be log2(x+1) transformed.") + ) + ) + ) + ) + ), + + # Sub-tab 2: Cohort Survival + shiny::tabPanel("Cohort Survival", + shiny::fluidRow( + shiny::column(4, + shiny::wellPanel( + shiny::h4("Cohort Survival", style = paste0("color: ", UI_COLORS$primary)), + shiny::p("Link secreted protein activity to clinical outcomes.", + style = "color: #666; font-size: 0.9em;"), + shiny::fileInput(ns("cohortExprFile"), "Expression matrix (CSV/TSV/RDS):"), + shiny::fileInput(ns("clinicalFile"), "Clinical data (CSV/TSV):"), + shiny::p("Clinical file must have 'Time' and 'Event' columns.", + style = "color: #999; font-size: 0.85em;"), + shiny::actionButton(ns("runSurvivalBtn"), "Run Survival Analysis", + class = "btn-primary btn-block", icon = shiny::icon("play")), + shiny::hr(), + shiny::textOutput(ns("survivalStatus")), + + shiny::conditionalPanel( + condition = paste0("output['", ns("hasSurvivalResults"), "']"), + shiny::hr(), + shinyWidgets::pickerInput( + ns("survivalProtein"), "Select Protein for Survival Curve:", + choices = NULL, + options = list(`live-search` = TRUE, size = 10), + multiple = FALSE + ) + ) + ) + ), + shiny::column(8, + shiny::conditionalPanel( + condition = paste0("output['", ns("hasSurvivalResults"), "']"), + shiny::wellPanel( + shiny::h4("Risk Scores", style = paste0("color: ", UI_COLORS$primary)), + shiny::plotOutput(ns("lollipopPlot"), height = "400px"), + shiny::hr(), + shiny::h4("Survival Curve", style = paste0("color: ", UI_COLORS$primary)), + shiny::plotOutput(ns("survivalPlot"), height = "400px"), + shiny::br(), + DT::dataTableOutput(ns("survivalTable")), + shiny::br(), + shiny::downloadButton(ns("downloadSurvival"), "Download Risk Scores (CSV)", class = "btn-success") + ) + ), + shiny::conditionalPanel( + condition = paste0("!output['", ns("hasSurvivalResults"), "']"), + shiny::div( + style = "text-align: center; padding: 80px 0; color: #999;", + shiny::h3("Upload expression and clinical data"), + shiny::p("Expression: rows = genes, columns = patients."), + shiny::p("Clinical: must have 'Time' (survival time) and 'Event' (0/1) columns.") + ) + ) + ) + ) + ) + ) + ) +} + +bulkServer <- function(id) { + shiny::moduleServer(id, function(input, output, session) { + rv <- shiny::reactiveValues( + change_results = NULL, + activity_mat = NULL, + clinical_data = NULL, + risk_mat = NULL + ) + + output$hasChangeResults <- shiny::reactive({ !is.null(rv$change_results) }) + shiny::outputOptions(output, "hasChangeResults", suspendWhenHidden = FALSE) + + output$hasSurvivalResults <- shiny::reactive({ !is.null(rv$risk_mat) }) + shiny::outputOptions(output, "hasSurvivalResults", suspendWhenHidden = FALSE) + + output$changeStatus <- shiny::renderText({ "" }) + output$survivalStatus <- shiny::renderText({ "" }) + + # Helper to load expression data from uploaded file + load_expr <- function(file_input) { + ext <- tolower(tools::file_ext(file_input$name)) + if (ext == "rds") return(readRDS(file_input$datapath)) + if (ext == "csv") return(as.matrix(read.csv(file_input$datapath, row.names = 1, check.names = FALSE))) + as.matrix(read.delim(file_input$datapath, row.names = 1, check.names = FALSE)) + } + + # --- Activity Change workflow --- + shiny::observeEvent(input$runChangeBtn, { + shiny::req(input$treatmentFile, input$controlFile) + output$changeStatus <- shiny::renderText({ "Running..." }) + + tryCatch({ + shiny::withProgress(message = "Computing activity change...", { + shiny::incProgress(0.1, detail = "Loading data...") + treatment <- load_expr(input$treatmentFile) + control <- load_expr(input$controlFile) + + shiny::incProgress(0.3, detail = "Running inference...") + res <- SecAct::SecAct.activity.inference( + inputProfile = treatment, + inputProfile_control = control, + is.singleSampleLevel = input$singleSample + ) + + shiny::incProgress(0.5, detail = "Done") + rv$change_results <- as.data.frame(res$zscore) + output$changeStatus <- shiny::renderText({ "Complete!" }) + }) + }, error = function(e) { + output$changeStatus <- shiny::renderText({ paste("Error:", e$message) }) + }) + }) + + output$barPlot <- shiny::renderPlot({ + shiny::req(rv$change_results) + tryCatch({ + if (ncol(rv$change_results) == 1) { + fg_vec <- rv$change_results[, 1] + names(fg_vec) <- rownames(rv$change_results) + SecAct::SecAct.bar.plot(fg_vec, title = "Activity Change") + } else { + SecAct::SecAct.heatmap.plot(as.matrix(rv$change_results), title = "Activity Change") + } + }, error = function(e) { empty_state_plot(paste("Plot error:", e$message)) }) + }) + + output$changeTable <- DT::renderDataTable({ + shiny::req(rv$change_results) + DT::datatable(rv$change_results, options = list(pageLength = 15, scrollX = TRUE)) + }) + + output$downloadChange <- shiny::downloadHandler( + filename = function() paste0("activity_change_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".csv"), + content = function(file) { shiny::req(rv$change_results); write.csv(rv$change_results, file) } + ) + + # --- Cohort Survival workflow --- + shiny::observeEvent(input$runSurvivalBtn, { + shiny::req(input$cohortExprFile, input$clinicalFile) + output$survivalStatus <- shiny::renderText({ "Running..." }) + + tryCatch({ + shiny::withProgress(message = "Running survival analysis...", { + shiny::incProgress(0.1, detail = "Loading expression data...") + expr <- load_expr(input$cohortExprFile) + + shiny::incProgress(0.1, detail = "Loading clinical data...") + ext <- tolower(tools::file_ext(input$clinicalFile$name)) + if (ext == "csv") { + clinical <- read.csv(input$clinicalFile$datapath, row.names = 1, check.names = FALSE) + } else { + clinical <- read.delim(input$clinicalFile$datapath, row.names = 1, check.names = FALSE) + } + rv$clinical_data <- clinical + + shiny::incProgress(0.3, detail = "Running SecAct inference...") + res <- SecAct::SecAct.activity.inference(inputProfile = expr, inputProfile_control = NULL) + rv$activity_mat <- res$zscore + + shiny::incProgress(0.3, detail = "Computing risk scores...") + rv$risk_mat <- SecAct::SecAct.coxph.regression(rv$activity_mat, clinical) + + proteins <- rownames(rv$risk_mat) + shinyWidgets::updatePickerInput(session, "survivalProtein", + choices = proteins, selected = proteins[1]) + + shiny::incProgress(0.2, detail = "Done") + output$survivalStatus <- shiny::renderText({ "Complete!" }) + }) + }, error = function(e) { + output$survivalStatus <- shiny::renderText({ paste("Error:", e$message) }) + }) + }) + + output$lollipopPlot <- shiny::renderPlot({ + shiny::req(rv$risk_mat) + tryCatch({ + risk_vec <- rv$risk_mat[, "zscore"] + names(risk_vec) <- rownames(rv$risk_mat) + SecAct::SecAct.lollipop.plot(risk_vec, title = "Risk Score") + }, error = function(e) { empty_state_plot(paste("Plot error:", e$message)) }) + }) + + output$survivalPlot <- shiny::renderPlot({ + shiny::req(rv$activity_mat, rv$clinical_data, input$survivalProtein) + tryCatch({ + SecAct::SecAct.survival.plot(rv$activity_mat, rv$clinical_data, + input$survivalProtein, x.title = "Time") + }, error = function(e) { empty_state_plot(paste("Plot error:", e$message)) }) + }) + + output$survivalTable <- DT::renderDataTable({ + shiny::req(rv$risk_mat) + DT::datatable(as.data.frame(rv$risk_mat), options = list(pageLength = 15, scrollX = TRUE)) + }) + + output$downloadSurvival <- shiny::downloadHandler( + filename = function() paste0("risk_scores_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".csv"), + content = function(file) { shiny::req(rv$risk_mat); write.csv(rv$risk_mat, file) } + ) + }) +} diff --git a/inst/shiny/SecActApp/R/mod_inference.R b/inst/shiny/SecActApp/R/mod_inference.R new file mode 100644 index 0000000..6f99b22 --- /dev/null +++ b/inst/shiny/SecActApp/R/mod_inference.R @@ -0,0 +1,122 @@ +# Run Inference Module +# Users upload expression data (CSV/TSV/RDS) and run SecAct inference. + +source(file.path("R", "utils_viz.R"), local = TRUE) + +inferenceUI <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::fluidRow( + shiny::column(4, + shiny::wellPanel( + shiny::h4("Upload Data", style = paste0("color: ", UI_COLORS$primary)), + shiny::fileInput(ns("userFile"), "Expression data (CSV, TSV, or RDS):", + accept = c(".csv", ".tsv", ".txt", ".rds", ".RDS")), + shiny::radioButtons(ns("inputType"), "Input type:", + choices = c("Differential expression (logFC)" = "logFC", + "Raw expression matrix" = "expression"), + selected = "logFC"), + shiny::actionButton(ns("submitBtn"), "Run SecAct Inference", + class = "btn-primary btn-block", + icon = shiny::icon("play")), + shiny::hr(), + shiny::textOutput(ns("statusText")) + ) + ), + shiny::column(8, + shiny::conditionalPanel( + condition = paste0("output['", ns("hasResults"), "']"), + shiny::wellPanel( + shiny::h4("Results", style = paste0("color: ", UI_COLORS$primary)), + DT::dataTableOutput(ns("resultsTable")), + shiny::br(), + shiny::downloadButton(ns("downloadResults"), "Download Results (CSV)", + class = "btn-success") + ) + ), + shiny::conditionalPanel( + condition = paste0("!output['", ns("hasResults"), "']"), + shiny::div( + style = "text-align: center; padding: 80px 0; color: #999;", + shiny::h3("Upload expression data and run inference"), + shiny::p("Rows = genes, Columns = samples/spots. First column = gene names.") + ) + ) + ) + ) + ) +} + +inferenceServer <- function(id) { + shiny::moduleServer(id, function(input, output, session) { + rv <- shiny::reactiveValues(results = NULL) + + output$hasResults <- shiny::reactive({ !is.null(rv$results) }) + shiny::outputOptions(output, "hasResults", suspendWhenHidden = FALSE) + + output$statusText <- shiny::renderText({ "" }) + + shiny::observeEvent(input$submitBtn, { + shiny::req(input$userFile) + + output$statusText <- shiny::renderText({ "Running inference..." }) + + tryCatch({ + shiny::withProgress(message = "Running SecAct inference...", detail = "This may take a few minutes", { + file_path <- input$userFile$datapath + ext <- tolower(tools::file_ext(input$userFile$name)) + + shiny::incProgress(0.1, detail = "Loading data...") + + # Load expression data + if (ext %in% c("rds")) { + expr_data <- readRDS(file_path) + } else if (ext %in% c("csv")) { + expr_data <- read.csv(file_path, row.names = 1, check.names = FALSE) + } else { + expr_data <- read.delim(file_path, row.names = 1, check.names = FALSE) + } + + shiny::incProgress(0.3, detail = "Running inference...") + + # Run SecAct inference + is_diff <- input$inputType == "logFC" + result <- SecAct::SecAct.activity.inference( + inputProfile = as.matrix(expr_data), + is.differential = is_diff + ) + + shiny::incProgress(0.5, detail = "Processing results...") + + # Extract z-scores + if (!is.null(result$zscore)) { + rv$results <- as.data.frame(result$zscore) + } else if (!is.null(result)) { + rv$results <- as.data.frame(result) + } + + shiny::incProgress(0.1) + output$statusText <- shiny::renderText({ "Inference complete!" }) + }) + }, error = function(e) { + output$statusText <- shiny::renderText({ paste("Error:", e$message) }) + }) + }) + + output$resultsTable <- DT::renderDataTable({ + shiny::req(rv$results) + DT::datatable(rv$results, options = list(pageLength = 15, scrollX = TRUE)) + }) + + output$downloadResults <- shiny::downloadHandler( + filename = function() { + paste0("secact_results_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".csv") + }, + content = function(file) { + shiny::req(rv$results) + write.csv(rv$results, file) + } + ) + }) +} diff --git a/inst/shiny/SecActApp/R/mod_singlecell.R b/inst/shiny/SecActApp/R/mod_singlecell.R new file mode 100644 index 0000000..9c3e717 --- /dev/null +++ b/inst/shiny/SecActApp/R/mod_singlecell.R @@ -0,0 +1,152 @@ +# Single-Cell Analysis Module +# Upload scRNA-seq data, run SecAct inference, visualize activity by cell type. + +source(file.path("R", "utils_viz.R"), local = TRUE) + +singlecellUI <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::fluidRow( + shiny::column(3, + shiny::wellPanel( + shiny::h4("Upload scRNA-seq Data", style = paste0("color: ", UI_COLORS$primary)), + shiny::fileInput(ns("scFile"), "Seurat object or expression matrix (.RDS)", + accept = c(".rds", ".RDS")), + shiny::textInput(ns("cellTypeCol"), "Cell type column:", value = "cellType"), + shiny::actionButton(ns("runScBtn"), "Run SC Inference", + class = "btn-primary btn-block", + icon = shiny::icon("play")), + shiny::hr(), + shiny::textOutput(ns("statusText")), + + shiny::conditionalPanel( + condition = paste0("output['", ns("hasResults"), "']"), + shiny::hr(), + shiny::h4("Visualization", style = paste0("color: ", UI_COLORS$primary)), + shinyWidgets::pickerInput( + ns("protein"), "Select Protein:", + choices = NULL, + options = list(`live-search` = TRUE, size = 10), + multiple = FALSE + ), + shiny::selectInput(ns("plotType"), "Plot Type:", + choices = c("Activity Bar" = "bar", + "Activity Heatmap" = "heatmap", + "Activity Lollipop" = "lollipop")) + ) + ) + ), + shiny::column(9, + shiny::conditionalPanel( + condition = paste0("!output['", ns("hasResults"), "']"), + shiny::div( + style = "text-align: center; padding: 80px 0; color: #999;", + shiny::h3("Single-Cell SecAct Analysis"), + shiny::p("Upload an scRNA-seq dataset and run cell-type level inference."), + shiny::p("Provide a Seurat object (.RDS) with cell type annotations.") + ) + ), + shiny::conditionalPanel( + condition = paste0("output['", ns("hasResults"), "']"), + shiny::fluidRow( + shiny::column(12, + shiny::div( + style = "border: 1px solid #ddd; border-radius: 5px; padding: 10px;", + shiny::plotOutput(ns("activityPlot"), height = "500px") + ) + ) + ), + shiny::br(), + shiny::fluidRow( + shiny::column(12, + DT::dataTableOutput(ns("resultsTable")) + ) + ) + ) + ) + ) + ) +} + +singlecellServer <- function(id) { + shiny::moduleServer(id, function(input, output, session) { + rv <- shiny::reactiveValues( + sc_result = NULL, + zscore_mat = NULL + ) + + output$hasResults <- shiny::reactive({ !is.null(rv$zscore_mat) }) + shiny::outputOptions(output, "hasResults", suspendWhenHidden = FALSE) + + output$statusText <- shiny::renderText({ "" }) + + shiny::observeEvent(input$runScBtn, { + shiny::req(input$scFile) + output$statusText <- shiny::renderText({ "Running SC inference..." }) + + tryCatch({ + shiny::withProgress(message = "Running single-cell SecAct inference...", + detail = "This may take several minutes", { + shiny::incProgress(0.1, detail = "Loading data...") + obj <- readRDS(input$scFile$datapath) + + shiny::incProgress(0.3, detail = "Running inference...") + + # Determine if Seurat object or raw matrix + if (inherits(obj, "Seurat")) { + result <- SecAct::SecAct.activity.inference.scRNAseq(obj, + cellTypeColumn = input$cellTypeCol) + } else if (is.matrix(obj) || inherits(obj, "dgCMatrix")) { + result <- SecAct::SecAct.activity.inference( + inputProfile = obj) + } else { + shiny::showNotification("Unsupported object type", type = "error") + return() + } + + shiny::incProgress(0.5, detail = "Processing results...") + + rv$sc_result <- result + if (!is.null(result$zscore)) { + rv$zscore_mat <- as.data.frame(result$zscore) + proteins <- rownames(rv$zscore_mat) + shinyWidgets::updatePickerInput(session, "protein", + choices = proteins, + selected = proteins[1]) + } + + shiny::incProgress(0.1) + output$statusText <- shiny::renderText({ "Inference complete!" }) + }) + }, error = function(e) { + output$statusText <- shiny::renderText({ paste("Error:", e$message) }) + }) + }) + + output$activityPlot <- shiny::renderPlot({ + shiny::req(rv$zscore_mat, input$protein, input$plotType) + + tryCatch({ + zscore_vec <- as.numeric(rv$zscore_mat[input$protein, ]) + names(zscore_vec) <- colnames(rv$zscore_mat) + + if (input$plotType == "bar") { + SecAct::SecAct.bar.plot(zscore_vec, title = input$protein) + } else if (input$plotType == "heatmap") { + SecAct::SecAct.heatmap.plot(rv$zscore_mat, title = "SecAct Activity") + } else if (input$plotType == "lollipop") { + SecAct::SecAct.lollipop.plot(zscore_vec, title = input$protein) + } + }, error = function(e) { + empty_state_plot(paste("Plot error:", e$message)) + }) + }) + + output$resultsTable <- DT::renderDataTable({ + shiny::req(rv$zscore_mat) + DT::datatable(rv$zscore_mat, + options = list(pageLength = 15, scrollX = TRUE)) + }) + }) +} diff --git a/inst/shiny/SecActApp/R/mod_spatial.R b/inst/shiny/SecActApp/R/mod_spatial.R new file mode 100644 index 0000000..1e05af5 --- /dev/null +++ b/inst/shiny/SecActApp/R/mod_spatial.R @@ -0,0 +1,437 @@ +# Spatial Visualization Module +# Displays SecAct activity, cell types, gene expression on spatial coordinates. +# Delegates rendering to SpaCET.visualize.spatialFeature() for multi-platform support. + +source(file.path("R", "utils_viz.R"), local = TRUE) + +# --- UI --- +spatialUI <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + + # Dataset loading + shiny::wellPanel( + shiny::h4("Dataset", style = paste0("color: ", UI_COLORS$primary)), + + shiny::tabsetPanel( + id = ns("loadTabs"), + + # Tab: Upload pre-built object + shiny::tabPanel("Upload Object", + shiny::div(style = "margin-top: 10px;", + shiny::fileInput(ns("dataUpload"), "SpaCET/Seurat Object (.RDS, .h5seurat)", + accept = c(".rds", ".RDS", ".h5seurat")), + shiny::actionButton(ns("loadBtn"), "Load Dataset", + class = "btn-primary btn-block") + ) + ), + + # Tab: Upload Space Ranger output + shiny::tabPanel("Space Ranger", + shiny::div(style = "margin-top: 10px;", + shiny::fileInput(ns("spacerUpload"), "Space Ranger Output (.zip)", + accept = c(".zip")), + shiny::actionButton(ns("loadSpaceRangerBtn"), "Load Visium Data", + class = "btn-primary btn-block") + ) + ), + + # Tab: Upload CosMx output + shiny::tabPanel("CosMx", + shiny::div(style = "margin-top: 10px;", + shiny::fileInput(ns("cosmxUpload"), "CosMx Output (.zip)", + accept = c(".zip")), + shiny::actionButton(ns("loadCosmxBtn"), "Load CosMx Data", + class = "btn-primary btn-block") + ) + ), + + # Tab: Upload Xenium output + shiny::tabPanel("Xenium", + shiny::div(style = "margin-top: 10px;", + shiny::fileInput(ns("xeniumUpload"), "Xenium Output (.zip)", + accept = c(".zip")), + shiny::actionButton(ns("loadXeniumBtn"), "Load Xenium Data", + class = "btn-primary btn-block") + ) + ), + + # Tab: Demo dataset + shiny::tabPanel("Demo", + shiny::div(style = "margin-top: 10px;", + shiny::p("Load the bundled Visium HCC example dataset.", + style = "color: #666; font-size: 0.9em;"), + shiny::actionButton(ns("loadDemoBtn"), "Load Visium HCC Demo", + class = "btn-info btn-block", + icon = shiny::icon("flask")) + ) + ) + ) + ), + + # SecAct inference controls (visible after data loaded, before inference run) + shiny::conditionalPanel( + condition = paste0("output['", ns("dataLoaded"), "'] && !output['", ns("hasSecActResults"), "']"), + shiny::wellPanel( + shiny::h4("Run SecAct Inference", style = paste0("color: ", UI_COLORS$warning)), + shiny::p("No SecAct activity results found. Run inference on this dataset.", + style = "color: #666; font-size: 0.9em;"), + shiny::actionButton(ns("runInferenceBtn"), "Run SecAct Inference", + class = "btn-warning btn-block", + icon = shiny::icon("play")) + ) + ), + + # Visualization controls (visible after data loaded) + shiny::conditionalPanel( + condition = paste0("output['", ns("dataLoaded"), "']"), + shiny::wellPanel( + shiny::h4("Visualization", style = paste0("color: ", UI_COLORS$primary)), + + shiny::selectInput(ns("spatialType"), "Display Type:", + choices = c("SecAct Activity" = "SecActActivity", + "Gene Expression" = "GeneExpression", + "Cell Fraction" = "CellFraction", + "Cell Type Composition" = "CellTypeComposition")), + + shinyWidgets::pickerInput( + ns("feature"), "Select Feature:", + choices = NULL, + options = list(`live-search` = TRUE, size = 10), + multiple = FALSE + ), + + shiny::sliderInput(ns("pointSize"), "Point Size:", + min = 0.1, max = 3, value = 1, step = 0.1), + + shiny::checkboxInput(ns("imageBg"), "Show Tissue Image", value = TRUE) + ) + ) + ), + + shiny::mainPanel( + width = 9, + + # Welcome screen (before data loaded) + shiny::conditionalPanel( + condition = paste0("!output['", ns("dataLoaded"), "']"), + shiny::div( + style = "height: 500px; display: flex; justify-content: center; align-items: center; background-color: #f8f9fa; border-radius: 5px;", + shiny::div( + style = "text-align: center; max-width: 600px;", + shiny::h2("Spatial Visualization"), + shiny::p("Upload a SpaCET or Seurat object, a Space Ranger output zip, or try the demo dataset."), + shiny::p("Supports: Visium, VisiumHD, CosMx, Xenium, Slide-Seq", + style = "color: #666;") + ) + ) + ), + + # Visualization panel (after data loaded) + shiny::conditionalPanel( + condition = paste0("output['", ns("dataLoaded"), "']"), + shiny::fluidRow( + shiny::column(12, + shiny::div( + style = "border: 1px solid #ddd; border-radius: 5px; padding: 10px;", + shiny::plotOutput(ns("spatialPlot"), height = "600px") + ) + ) + ), + shiny::br(), + shiny::fluidRow( + shiny::column(12, + DT::dataTableOutput(ns("dataTable")) + ) + ) + ) + ) + ) + ) +} + +# --- Server --- +spatialServer <- function(id) { + shiny::moduleServer(id, function(input, output, session) { + # Reactive values + rv <- shiny::reactiveValues( + spacet_obj = NULL, + dataLoaded = FALSE + ) + + # Flags for conditionalPanel + output$dataLoaded <- shiny::reactive({ rv$dataLoaded }) + shiny::outputOptions(output, "dataLoaded", suspendWhenHidden = FALSE) + + output$hasSecActResults <- shiny::reactive({ + !is.null(rv$spacet_obj) && !is.null(rv$spacet_obj@results$SecAct_output) + }) + shiny::outputOptions(output, "hasSecActResults", suspendWhenHidden = FALSE) + + # Helper: finalize after any load path succeeds + finish_load <- function(obj, source_label) { + rv$spacet_obj <- obj + rv$dataLoaded <- TRUE + update_features() + shiny::showNotification(paste(source_label, "loaded successfully"), type = "message") + } + + # --- Load path 1: Pre-built object (.RDS / .h5seurat) --- + shiny::observeEvent(input$loadBtn, { + shiny::req(input$dataUpload) + + file_path <- input$dataUpload$datapath + ext <- tolower(tools::file_ext(input$dataUpload$name)) + + tryCatch({ + shiny::withProgress(message = "Loading dataset...", { + if (ext == "h5seurat") { + if (!requireNamespace("SeuratDisk", quietly = TRUE)) { + shiny::showNotification("SeuratDisk package required for .h5seurat files", type = "error") + return() + } + seu <- SeuratDisk::LoadH5Seurat(file_path) + finish_load(SpaCET::convert.Seurat(seu), "Seurat object") + } else { + obj <- readRDS(file_path) + if (inherits(obj, "SpaCET")) { + finish_load(obj, "SpaCET object") + } else if (inherits(obj, "Seurat")) { + finish_load(SpaCET::convert.Seurat(obj), "Seurat object") + } else { + shiny::showNotification("File must contain a SpaCET or Seurat object", type = "error") + return() + } + } + }) + }, error = function(e) { + shiny::showNotification(paste("Error loading file:", e$message), type = "error") + }) + }) + + # --- Load path 2: Space Ranger zip --- + shiny::observeEvent(input$loadSpaceRangerBtn, { + shiny::req(input$spacerUpload) + tryCatch({ + shiny::withProgress(message = "Loading Space Ranger output...", { + shiny::incProgress(0.2, detail = "Extracting zip...") + visium_path <- extract_platform_zip(input$spacerUpload, "Space Ranger", "^spatial$", "dir") + if (is.null(visium_path)) return() + + shiny::incProgress(0.4, detail = "Building SpaCET object...") + obj <- SpaCET::create.SpaCET.object.10X(visiumPath = visium_path) + + shiny::incProgress(0.4, detail = "Done") + finish_load(obj, "Visium dataset") + }) + }, error = function(e) { + shiny::showNotification(paste("Error loading Space Ranger data:", e$message), type = "error") + }) + }) + + # --- Load path: CosMx zip --- + shiny::observeEvent(input$loadCosmxBtn, { + shiny::req(input$cosmxUpload) + tryCatch({ + shiny::withProgress(message = "Loading CosMx data...", { + shiny::incProgress(0.2, detail = "Extracting zip...") + cosmx_path <- extract_platform_zip(input$cosmxUpload, "CosMx", "metadata", "file") + if (is.null(cosmx_path)) return() + + shiny::incProgress(0.4, detail = "Building SpaCET object...") + obj <- SpaCET::create.SpaCET.object.CosMx(cosmxPath = cosmx_path) + + shiny::incProgress(0.4, detail = "Done") + finish_load(obj, "CosMx dataset") + }) + }, error = function(e) { + shiny::showNotification(paste("Error loading CosMx data:", e$message), type = "error") + }) + }) + + # --- Load path: Xenium zip --- + shiny::observeEvent(input$loadXeniumBtn, { + shiny::req(input$xeniumUpload) + tryCatch({ + shiny::withProgress(message = "Loading Xenium data...", { + shiny::incProgress(0.2, detail = "Extracting zip...") + xenium_path <- extract_platform_zip(input$xeniumUpload, "Xenium", "cells\\.(csv\\.gz|parquet)$", "file") + if (is.null(xenium_path)) return() + + shiny::incProgress(0.4, detail = "Building SpaCET object...") + obj <- SpaCET::create.SpaCET.object.Xenium(xeniumPath = xenium_path) + + shiny::incProgress(0.4, detail = "Done") + finish_load(obj, "Xenium dataset") + }) + }, error = function(e) { + shiny::showNotification(paste("Error loading Xenium data:", e$message), type = "error") + }) + }) + + # --- Load path 3: Demo dataset --- + shiny::observeEvent(input$loadDemoBtn, { + tryCatch({ + shiny::withProgress(message = "Loading Visium HCC demo...", { + demo_path <- system.file("extdata", "Visium_HCC", package = "SecAct") + if (demo_path == "") { + shiny::showNotification("Demo data not found. Is SecAct installed?", type = "error") + return() + } + + shiny::incProgress(0.3, detail = "Building SpaCET object...") + obj <- SpaCET::create.SpaCET.object.10X(visiumPath = demo_path) + + shiny::incProgress(0.6, detail = "Done") + finish_load(obj, "Visium HCC demo") + }) + }, error = function(e) { + shiny::showNotification(paste("Error loading demo:", e$message), type = "error") + }) + }) + + # --- Run SecAct inference --- + shiny::observeEvent(input$runInferenceBtn, { + shiny::req(rv$spacet_obj) + + tryCatch({ + shiny::withProgress(message = "Running SecAct inference...", detail = "This may take a few minutes", { + shiny::incProgress(0.1) + rv$spacet_obj <- SecAct::SecAct.activity.inference.ST(rv$spacet_obj) + shiny::incProgress(0.9) + update_features() + + shiny::showNotification("SecAct inference complete!", type = "message") + }) + }, error = function(e) { + shiny::showNotification(paste("Inference error:", e$message), type = "error") + }) + }) + + # Update feature picker when spatial type changes + update_features <- function() { + shiny::req(rv$spacet_obj) + obj <- rv$spacet_obj + + choices <- switch(input$spatialType, + "SecActActivity" = { + if (!is.null(obj@results$SecAct_output$SecActTarget)) { + rownames(obj@results$SecAct_output$SecActTarget) + } else if (!is.null(obj@results$SecAct_output)) { + nms <- names(obj@results$SecAct_output) + mat_name <- nms[grepl("Target|activity", nms, ignore.case = TRUE)][1] + if (!is.na(mat_name)) rownames(obj@results$SecAct_output[[mat_name]]) else character(0) + } else { + character(0) + } + }, + "GeneExpression" = rownames(obj@input$counts), + "CellFraction" = { + if (!is.null(obj@results$deconvolution$propMat)) { + rownames(obj@results$deconvolution$propMat) + } else character(0) + }, + "CellTypeComposition" = "All", + character(0) + ) + + shinyWidgets::updatePickerInput(session, "feature", + choices = choices, + selected = if (length(choices) > 0) choices[1] else NULL) + } + + shiny::observeEvent(input$spatialType, { + if (rv$dataLoaded) update_features() + }) + + # Render spatial plot using SpaCET + output$spatialPlot <- shiny::renderPlot({ + shiny::req(rv$spacet_obj, input$feature) + + tryCatch({ + spacet_type <- switch(input$spatialType, + "SecActActivity" = "GeneExpression", + "GeneExpression" = "GeneExpression", + "CellFraction" = "CellFraction", + "CellTypeComposition" = "CellTypeComposition", + "GeneExpression" + ) + + if (input$spatialType == "SecActActivity") { + act_mat <- rv$spacet_obj@results$SecAct_output$SecActTarget + if (is.null(act_mat)) { + return(empty_state_plot("No SecAct activity data found. Run inference first.")) + } + + temp_obj <- swap_activity_matrix(rv$spacet_obj, act_mat) + + SpaCET::SpaCET.visualize.spatialFeature( + temp_obj, + spatialType = "GeneExpression", + spatialFeatures = input$feature, + scaleTypeForGeneExpression = "RawCounts", + pointSize = input$pointSize, + imageBg = input$imageBg + ) + } else { + SpaCET::SpaCET.visualize.spatialFeature( + rv$spacet_obj, + spatialType = spacet_type, + spatialFeatures = input$feature, + pointSize = input$pointSize, + imageBg = input$imageBg + ) + } + }, error = function(e) { + empty_state_plot(paste("Visualization error:", e$message)) + }) + }) + + # Data table + output$dataTable <- DT::renderDataTable({ + shiny::req(rv$spacet_obj, input$feature, input$spatialType) + + tryCatch({ + obj <- rv$spacet_obj + + if (input$spatialType == "SecActActivity") { + act_mat <- obj@results$SecAct_output$SecActTarget + shiny::req(act_mat) + if (!input$feature %in% rownames(act_mat)) return(NULL) + values <- act_mat[input$feature, ] + } else if (input$spatialType == "GeneExpression") { + counts <- obj@input$counts + if (!input$feature %in% rownames(counts)) return(NULL) + values <- counts[input$feature, ] + } else { + return(NULL) + } + + coords <- obj@input$spotCoordinates + df <- data.frame( + SpotID = names(values), + Value = as.numeric(values), + stringsAsFactors = FALSE + ) + + if (!is.null(coords)) { + df$x <- coords[match(df$SpotID, rownames(coords)), "x"] + df$y <- coords[match(df$SpotID, rownames(coords)), "y"] + } + + if (!is.null(obj@input$metaData) && CELLTYPE_COLUMN %in% colnames(obj@input$metaData)) { + df$CellType <- obj@input$metaData[match(df$SpotID, rownames(obj@input$metaData)), CELLTYPE_COLUMN] + df$CellType <- normalize_tumor_labels(df$CellType) + } + + DT::datatable(df, options = list(pageLength = 15, scrollX = TRUE), rownames = FALSE) + }, error = function(e) { + DT::datatable(data.frame(Error = e$message)) + }) + }) + }) +} diff --git a/inst/shiny/SecActApp/R/utils_viz.R b/inst/shiny/SecActApp/R/utils_viz.R new file mode 100644 index 0000000..cf389d6 --- /dev/null +++ b/inst/shiny/SecActApp/R/utils_viz.R @@ -0,0 +1,90 @@ +# Shared helpers for the SecAct Shiny app +# These are app-internal utilities, not exported from the SecAct package. + +# --- Constants --- +DEFAULT_PLOT_WIDTH <- 600 +DEFAULT_PLOT_HEIGHT <- 400 +DIMENSION_ROUNDING <- 10 +CELLTYPE_COLUMN <- "cellType" + +MARKER_COLORS <- c("#00FF00", "#FF0000", "#888888", "#0000FF") +MARKER_LABELS <- c("PanCK (Epithelial)", "CD45 (Immune)", "CD3 (T-cells)", "DAPI (Nuclei)") + +# --- Helpers --- + +#' Placeholder plot for missing data or error states +empty_state_plot <- function(label) { + ggplot2::ggplot() + + ggplot2::annotate("text", x = 0.5, y = 0.5, label = label) + + ggplot2::theme_void() +} + +#' Get responsive plot dimensions from Shiny client data, rounded to reduce redraws +get_responsive_dims <- function(outputId, session) { + width <- session$clientData$output[[outputId]]$width + height <- session$clientData$output[[outputId]]$height + if (is.null(width) || is.null(height)) { + width <- DEFAULT_PLOT_WIDTH + height <- DEFAULT_PLOT_HEIGHT + } + width <- round(width / DIMENSION_ROUNDING) * DIMENSION_ROUNDING + height <- round(height / DIMENSION_ROUNDING) * DIMENSION_ROUNDING + list(width = width, height = height) +} + +#' CosMx labels tumor subtypes as "tumor 1", "tumor 2", etc. — collapse to single label +normalize_tumor_labels <- function(cell_types) { + gsub("^tumor\\s+\\d+$", "tumor", cell_types) +} + +#' Radius "0" means target cell itself; all others are neighbor distances in micrometers +format_radius_label <- function(radius) { + if (radius == "0") "Target" else paste0(radius, " \u03bcm") +} + +#' Swap a SpaCET object's counts slot with an activity matrix for visualization. +#' SpaCET.visualize.spatialFeature() renders from @input$counts, so we temporarily +#' replace it with the activity matrix to reuse the existing rendering pipeline. +swap_activity_matrix <- function(spacet_obj, activity_matrix) { + common_spots <- intersect(colnames(activity_matrix), colnames(spacet_obj@input$counts)) + temp_mat <- Matrix::Matrix(0, nrow = nrow(activity_matrix), ncol = ncol(spacet_obj@input$counts), + sparse = TRUE, + dimnames = list(rownames(activity_matrix), colnames(spacet_obj@input$counts))) + temp_mat[, common_spots] <- activity_matrix[, common_spots] + spacet_obj@input$counts <- temp_mat + spacet_obj +} + +#' Extract a platform zip upload and find the output directory. +#' Handles nested zip structures by searching for a landmark file pattern. +#' @param upload_input The Shiny fileInput value (must have $datapath) +#' @param platform_name Label for notifications (e.g., "Space Ranger", "CosMx") +#' @param landmark_pattern Regex to find the platform's landmark file/dir +#' @param landmark_type "dir" to search for directories, "file" for files +#' @return Path to the platform output directory, or NULL on failure +extract_platform_zip <- function(upload_input, platform_name, landmark_pattern, landmark_type = "file") { + zip_path <- upload_input$datapath + extract_dir <- file.path(tempdir(), paste0(tolower(gsub(" ", "_", platform_name)), "_upload")) + if (dir.exists(extract_dir)) unlink(extract_dir, recursive = TRUE) + on.exit(unlink(extract_dir, recursive = TRUE), add = TRUE) + + utils::unzip(zip_path, exdir = extract_dir) + + if (landmark_type == "dir") { + matches <- list.files(extract_dir, pattern = landmark_pattern, + recursive = TRUE, include.dirs = TRUE, full.names = TRUE) + } else { + matches <- list.files(extract_dir, pattern = landmark_pattern, + recursive = TRUE, full.names = TRUE) + } + + if (length(matches) == 0) { + shiny::showNotification( + paste0("No '", landmark_pattern, "' found in zip. Is this ", platform_name, " output?"), + type = "error" + ) + return(NULL) + } + + dirname(matches[1]) +} diff --git a/inst/shiny/SecActApp/README.md b/inst/shiny/SecActApp/README.md new file mode 100644 index 0000000..1f7f9be --- /dev/null +++ b/inst/shiny/SecActApp/README.md @@ -0,0 +1,26 @@ +# SecAct Unified Visualization App + +Interactive Shiny application for exploring secreted protein activity across +bulk, single-cell, and spatial transcriptomics data. + +## Quick Start + +```r +# Install SecAct (if not already installed) +devtools::install_github("data2intelligence/SecAct") + +# Launch the app +SecAct::runSecActApp() +``` + +## Tabs + +- **Spatial** — Visualize SecAct activity on spatial coordinates (Visium, CosMx, Xenium, etc.) +- Bulk, Single Cell, and Inference tabs coming in future releases. + +## Requirements + +- R >= 3.5.0 +- SpaCET package (for spatial visualization) +- shiny, shinyWidgets, bslib, DT (installed automatically via Suggests) +- Optional: SeuratObject, SeuratDisk (for .h5seurat file support) diff --git a/inst/shiny/SecActApp/app.R b/inst/shiny/SecActApp/app.R new file mode 100644 index 0000000..0758c7c --- /dev/null +++ b/inst/shiny/SecActApp/app.R @@ -0,0 +1,44 @@ +# SecAct Unified Visualization App +# Entry point — loads modules and launches the tabbed interface. +# Run via SecAct::runSecActApp() or shiny::runApp("inst/shiny/SecActApp") + +# Load global config and dependencies +source("global.R", local = TRUE) + +# Load modules +source(file.path("R", "mod_spatial.R"), local = TRUE) +source(file.path("R", "mod_inference.R"), local = TRUE) +source(file.path("R", "mod_singlecell.R"), local = TRUE) +source(file.path("R", "mod_bulk.R"), local = TRUE) + +# --- UI --- +ui <- shiny::fluidPage( + theme = bslib::bs_theme(bootswatch = "flatly"), + if (requireNamespace("shinyjs", quietly = TRUE)) shinyjs::useShinyjs(), + + # Header + shiny::div( + style = paste0("background-color: ", UI_COLORS$primary, "; color: white; padding: 15px; margin-bottom: 20px;"), + shiny::h2("SecAct", style = "margin-top: 0; display: inline;"), + shiny::span("Secreted Protein Activity Analysis", style = "margin-left: 15px; opacity: 0.8;") + ), + + # Tabbed interface — Phase 1 has spatial only; more tabs added in later phases + shiny::tabsetPanel( + id = "mainTabs", + shiny::tabPanel("Bulk", bulkUI("bulk")), + shiny::tabPanel("Spatial", spatialUI("spatial")), + shiny::tabPanel("Single Cell", singlecellUI("singlecell")), + shiny::tabPanel("Run Inference", inferenceUI("inference")) + ) +) + +# --- Server --- +server <- function(input, output, session) { + bulkServer("bulk") + spatialServer("spatial") + singlecellServer("singlecell") + inferenceServer("inference") +} + +shiny::shinyApp(ui = ui, server = server) diff --git a/inst/shiny/SecActApp/global.R b/inst/shiny/SecActApp/global.R new file mode 100644 index 0000000..6a53325 --- /dev/null +++ b/inst/shiny/SecActApp/global.R @@ -0,0 +1,32 @@ +# SecAct Unified Visualization App — Global Configuration + +# Load app-internal helpers +source(file.path("R", "utils_viz.R"), local = TRUE) + +# Shiny dependencies — checked by runSecActApp() launcher before we get here +library(shiny) +library(shinyWidgets) +library(ggplot2) +library(DT) +library(bslib) + +# Optional packages — loaded if available +if (requireNamespace("shinyjs", quietly = TRUE)) library(shinyjs) +if (requireNamespace("shinyFeedback", quietly = TRUE)) library(shinyFeedback) + +# SpaCET is required for spatial visualization +if (!requireNamespace("SpaCET", quietly = TRUE)) { + stop("SpaCET package is required. Install from: https://github.com/data2intelligence/spacet") +} + +# Maximum file upload size (3 GB) +options(shiny.maxRequestSize = 3000 * 1024^2) + +# App-wide color palette +UI_COLORS <- list( + primary = "#3498db", + success = "#2ecc71", + warning = "#f39c12", + danger = "#e74c3c", + muted = "#95a5a6" +) diff --git a/man/.DS_Store b/man/.DS_Store deleted file mode 100644 index 948a85f..0000000 Binary files a/man/.DS_Store and /dev/null differ diff --git a/man/figures/.DS_Store b/man/figures/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/man/figures/.DS_Store and /dev/null differ diff --git a/src/.DS_Store b/src/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/src/.DS_Store and /dev/null differ diff --git a/src/Makevars b/src/Makevars index c3ded6c..7ba007e 100644 --- a/src/Makevars +++ b/src/Makevars @@ -1,4 +1,2 @@ PKG_CFLAGS = $(shell gsl-config --cflags) PKG_LIBS = $(shell gsl-config --libs) -GSL_CFLAGS=-I/usr/local/Cellar/gsl/2.8/include -GSL_LIBS=-L/usr/local/Cellar/gsl/2.8/lib -lgsl -lgslcblas diff --git a/src/main.c b/src/main.c index 8ebdc88..85f6f1b 100644 --- a/src/main.c +++ b/src/main.c @@ -2,19 +2,6 @@ #include #include #include -#include - -/* -void hello(int *n) -{ - int i; - for(i=0; i < *n; i++) - { - Rprintf("Hello, world!\n"); - fprintf( stdout, "p = %d\n", *p); - } -} -*/ gsl_matrix *RVectorObject_to_gsl_matrix(double *vec, size_t nr, size_t nc) { diff --git a/vignettes/.DS_Store b/vignettes/.DS_Store deleted file mode 100644 index f7103b0..0000000 Binary files a/vignettes/.DS_Store and /dev/null differ diff --git a/vignettes/img/.DS_Store b/vignettes/img/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/vignettes/img/.DS_Store and /dev/null differ