fix: DELETED caused duplicated names

bigomics · Oct 19, 2023 · 0a3ad32 · 0a3ad32
1 parent b2bc8b6
commit 0a3ad32
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 9 deletions.
diff --git a/R/pgx-files.R b/R/pgx-files.R
@@ -671,7 +671,8 @@ pgxinfo.updateDatasetFolder <- function(pgx.dir,
     h5.files <- sub("[.]pgx$", "", h5.files) ## strip pgx
     del <- which(h5.files %in% h5.delete)
     if (length(del)) {
-      cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+      ##      cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+      cn[del] <- paste("[DELETED]", cn[del])        
       rhdf5::h5delete(sigdb.file, "data/colnames")
       rhdf5::h5write(cn, sigdb.file, "data/colnames")
       if (delete.old) {
@@ -825,7 +826,8 @@ pgxinfo.updateDatasetFolder <- function(pgx.dir,
       }
       if (fc.del) {
         del <- which(!cn %in% colnames(allFC))
-        cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+##        cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+        cn[del] <- paste("[DELETED]", cn[del])                
         rhdf5::h5delete(sigdb.file, "data/colnames")
         rhdf5::h5write(cn, sigdb.file, "data/colnames")
         if (delete.old) {
@@ -915,7 +917,8 @@ pgxinfo.delete <- function(pgx.dir, pgxname, purge.h5 = FALSE) {
     h5.files <- sub("[.]pgx$", "", h5.files) ## strip pgx
     del <- which(h5.files == pgxname)
     if (length(del)) {
-      cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+##      cn[del] <- paste("[DELETED]", sub(".*\\] ", "", cn[del]))
+      cn[del] <- paste("[DELETED]", cn[del])        
       rhdf5::h5delete(sigdb.file, "data/colnames")
       rhdf5::h5write(cn, sigdb.file, "data/colnames")
     }

diff --git a/R/pgx-signature.R b/R/pgx-signature.R
@@ -34,7 +34,6 @@
 #' @export
 pgx.computeConnectivityScores <- function(pgx, sigdb, ntop = 200, contrasts = NULL,
                                           remove.le = FALSE) {
-  meta <- pgx.getMetaFoldChangeMatrix(pgx, what = "meta")
 
   is.h5ref <- grepl("h5$", sigdb)
   if (!is.h5ref) {
@@ -51,6 +50,9 @@ pgx.computeConnectivityScores <- function(pgx, sigdb, ntop = 200, contrasts = NU
     return(NULL)
   }
 
+  dbg("[pgx.computeConnectivityScores] computing connectivity scores for sigdb = ",sigdb)    
+  meta <- pgx.getMetaFoldChangeMatrix(pgx, what = "meta")
+
   if (is.null(contrasts)) {
     contrasts <- colnames(meta$fc)
   }
@@ -112,6 +114,7 @@ pgx.correlateSignatureH5 <- function(fc, h5.file, nsig = 100, ntop = 200, nperm
   ## if we have less than 100 genes, we should make smaller GMT sets!
   nsig <- min(100, round(length(fc) / 5))
   sel.idx <- 1:length(cn) ## all
+  sel.idx <- grep("DELETED", cn, invert=TRUE)
   idx <- list(1:nsig, sel.idx)
   sig100.up <- rhdf5::h5read(h5.file, "signature/sig100.up", index = idx)
   sig100.dn <- rhdf5::h5read(h5.file, "signature/sig100.dn", index = idx)
@@ -122,11 +125,10 @@ pgx.correlateSignatureH5 <- function(fc, h5.file, nsig = 100, ntop = 200, nperm
   ## Test signatures using fGSEA (this is pretty fast. amazing.)
   ## ------------------------------------------------------------
   ## combine up/down into one (unsigned GSEA test)
-  dbg("[pgx.correlateSignatureH5] computing fGSEA...")
   system.time({
     gmt <- rbind(sig100.up, sig100.dn)
     gmt <- unlist(apply(gmt, 2, list), recursive = FALSE)
-    names(gmt) <- cn[sel.idx]
+    names(gmt) <- colnames(sig100.up)
     suppressMessages(suppressWarnings(
       res <- fgsea::fgseaSimple(gmt, abs(fc), nperm = nperm, scoreType = "pos")
     )) ## really unsigned???
@@ -151,7 +153,6 @@ pgx.correlateSignatureH5 <- function(fc, h5.file, nsig = 100, ntop = 200, nperm
   ## --------------------------------------------------
   ## Fisher test
   ## --------------------------------------------------
-  dbg("[pgx.correlateSignatureH5] computing Fisher test...")
   fc.up <- fc[fc > 0]
   fc.dn <- fc[fc < 0]
   top.up <- head(names(sort(-fc.up)), 3 * nsig) ## RETHINK!
@@ -170,7 +171,6 @@ pgx.correlateSignatureH5 <- function(fc, h5.file, nsig = 100, ntop = 200, nperm
   ## ---------------------------------------------------------------
   ## Compute truncated rank correlation
   ## ---------------------------------------------------------------
-  dbg("[pgx.correlateSignatureH5] computing rank correlation...")
   system.time({
     ## get signature subset
     fc1 <- sort(fc)
@@ -196,7 +196,6 @@ pgx.correlateSignatureH5 <- function(fc, h5.file, nsig = 100, ntop = 200, nperm
   ## --------------------------------------------------
   ## Cosine distance with sparse GSET matrix
   ## --------------------------------------------------
-  dbg("[pgx.correlateSignatureH5] computing cosine distance...")
   system.time({
     bg <- intersect(names(fc), rn)
     gmt100.up <- unlist(apply(sig100.up[, sel], 2, list), recursive = FALSE)