diff --git a/R/pgx-annot.R b/R/pgx-annot.R index 31a1ce8e..1b2d3493 100644 --- a/R/pgx-annot.R +++ b/R/pgx-annot.R @@ -234,9 +234,9 @@ getGeneAnnotation.ANNOTHUB <- function( cols <- intersect(cols, AnnotationDbi::keytypes(orgdb)) if (organism %in% c("Mus musculus", "Rattus norvegicus")) { - cols <- unique(c(cols, "ENTREZID")) + cols <- unique(c(cols, "ENTREZID")) } - + cat("get gene annotation columns:", cols, "\n") message("retrieving annotation for ", length(probes), " ", probe_type, " features...") @@ -251,25 +251,25 @@ getGeneAnnotation.ANNOTHUB <- function( ## Attempt to retrieve chr map via org.Mm.egCHRLOC / org.Rn.egCHRLOC. if (organism %in% c("Mus musculus", "Rattus norvegicus")) { - if (organism == "Mus musculus") { - library(org.Mm.eg.db) - chrloc <- org.Mm.egCHRLOC - } - if (organism == "Rattus norvegicus") { - library(org.Rn.eg.db) - chrloc <- org.Rn.egCHRLOC - } - mapped_genes <- as.list(chrloc[mappedkeys(chrloc)]) - cm <- intersect(as.character(annot$ENTREZID), names(mapped_genes)) - mapped_genes <- mapped_genes[cm] - locs <- unlist(lapply(mapped_genes, function(x) names(x[1]))) - jj <- match(names(locs), annot$ENTREZID) - annot$MAP <- NA - annot$MAP[jj] <- unname(locs) - cls <- setdiff(colnames(annot), "ENTREZID") - annot <- annot[, cls, drop = FALSE] - } - + if (organism == "Mus musculus") { + library(org.Mm.eg.db) + chrloc <- org.Mm.egCHRLOC + } + if (organism == "Rattus norvegicus") { + library(org.Rn.eg.db) + chrloc <- org.Rn.egCHRLOC + } + mapped_genes <- as.list(chrloc[mappedkeys(chrloc)]) + cm <- intersect(as.character(annot$ENTREZID), names(mapped_genes)) + mapped_genes <- mapped_genes[cm] + locs <- unlist(lapply(mapped_genes, function(x) names(x[1]))) + jj <- match(names(locs), annot$ENTREZID) + annot$MAP <- NA + annot$MAP[jj] <- unname(locs) + cls <- setdiff(colnames(annot), "ENTREZID") + annot <- annot[, cls, drop = FALSE] + } + # some organisms do not provide symbol but rather gene name (e.g. yeast) if (!"SYMBOL" %in% colnames(annot)) { annot$SYMBOL <- annot$GENENAME diff --git a/R/pgx-correlation.R b/R/pgx-correlation.R index 7176cf91..e55c7f2e 100644 --- a/R/pgx-correlation.R +++ b/R/pgx-correlation.R @@ -430,20 +430,20 @@ pgx.testPhenoCorrelation <- function(df, plot = TRUE, cex = 1, compute.pv = TRUE fisher.P <- NULL if (ncol(dd)) { fisher.P <- matrix(NA, ncol(dd), ncol(dd)) - if(nrow(fisher.P) == 1 && ncol(fisher.P) == 1) { - tb <- table(dd[, 1], dd[, 1]) - fisher.P[1, 1] <- stats::fisher.test(tb, simulate.p.value = TRUE)$p.value + if (nrow(fisher.P) == 1 && ncol(fisher.P) == 1) { + tb <- table(dd[, 1], dd[, 1]) + fisher.P[1, 1] <- stats::fisher.test(tb, simulate.p.value = TRUE)$p.value } else { - i <- 1 - j <- 2 - for (i in 1:(ncol(dd) - 1)) { - kk <- which(!is.na(dd[, i]) & !is.na(dd[, j])) - if (length(unique(dd[kk, i])) < 2 || length(unique(dd[kk, j])) < 2) next - for (j in (i + 1):ncol(dd)) { - tb <- table(dd[, i], dd[, j]) - fisher.P[i, j] <- stats::fisher.test(tb, simulate.p.value = TRUE)$p.value - } + i <- 1 + j <- 2 + for (i in 1:(ncol(dd) - 1)) { + kk <- which(!is.na(dd[, i]) & !is.na(dd[, j])) + if (length(unique(dd[kk, i])) < 2 || length(unique(dd[kk, j])) < 2) next + for (j in (i + 1):ncol(dd)) { + tb <- table(dd[, i], dd[, j]) + fisher.P[i, j] <- stats::fisher.test(tb, simulate.p.value = TRUE)$p.value } + } } rownames(fisher.P) <- colnames(dd) colnames(fisher.P) <- colnames(dd) diff --git a/R/pgx-pcsf.R b/R/pgx-pcsf.R index 2cae262b..f10094bd 100644 --- a/R/pgx-pcsf.R +++ b/R/pgx-pcsf.R @@ -22,8 +22,8 @@ pgx.computePCSF <- function(pgx, contrast, level = "gene", } fx <- F[, contrast] if (level == "gene") { - ##names(fx) <- pgx$genes[rownames(F), "human_ortholog"] - fx <- collapse_by_humansymbol(fx, pgx$genes) ## safe + ## names(fx) <- pgx$genes[rownames(F), "human_ortholog"] + fx <- collapse_by_humansymbol(fx, pgx$genes) ## safe } } @@ -62,8 +62,8 @@ pgx.computePCSF <- function(pgx, contrast, level = "gene", sel <- (STRING$from %in% nodes & STRING$to %in% nodes) ee <- STRING[which(sel), ] if (use.corweight) { - ##X <- rename_by(pgx$X, pgx$genes, "human_ortholog", unique = TRUE) - X <- collapse_by_humansymbol(pgx$X, pgx$genes) ## safe + ## X <- rename_by(pgx$X, pgx$genes, "human_ortholog", unique = TRUE) + X <- collapse_by_humansymbol(pgx$X, pgx$genes) ## safe selx <- rownames(X) %in% union(ee$from, ee$to) R <- cor(t(X[selx, , drop = FALSE])) if (rm.negedge) R[which(R < 0)] <- NA