Skip to content

Commit 17f0707

Browse files
authored
Merge pull request #331 from bigomics/multiwgcna
Multiwgcna playbase part
2 parents a3552ad + f4ccb91 commit 17f0707

39 files changed

+5094
-920
lines changed

NAMESPACE

Lines changed: 39 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,13 @@ export(MNNcorrect)
1212
export(MultiOmicsSAE)
1313
export(abbreviate_pheno)
1414
export(add_opacity)
15+
export(ai.ask)
16+
export(ai.genesets_keywords)
17+
export(ai.genesets_summary)
18+
export(ai.get_models)
19+
export(ai.get_ollama_models)
20+
export(ai.get_remote_models)
21+
export(ai.model_is_available)
1522
export(alias2hugo)
1623
export(allSpecies)
1724
export(allSpecies.ANNOTHUB)
@@ -41,6 +48,7 @@ export(clean_probe_names)
4148
export(clean_symbols)
4249
export(clustermap)
4350
export(colSignedRanks)
51+
export(collapseTraitMatrix)
4452
export(collapse_by_humansymbol)
4553
export(color_from_middle)
4654
export(colorscale)
@@ -95,6 +103,7 @@ export(extend_metabolite_sets)
95103
export(extend_metabolite_sets2)
96104
export(extremeCorrelation)
97105
export(fastCor)
106+
export(fastTOMsimilarity)
98107
export(filterProbes)
99108
export(first_feature)
100109
export(fixContrastMatrix)
@@ -193,7 +202,6 @@ export(is_logged)
193202
export(isanumber)
194203
export(itercluster_louvain)
195204
export(justGSEA)
196-
export(labels2rainbow)
197205
export(lasagna.create_from_pgx)
198206
export(lasagna.create_model)
199207
export(lasagna.plot3D)
@@ -243,6 +251,7 @@ export(mofa.get_prefix)
243251
export(mofa.intNMF)
244252
export(mofa.log1s)
245253
export(mofa.merge_data)
254+
export(mofa.merge_data2)
246255
export(mofa.plot_all_factortraits)
247256
export(mofa.plot_biplot)
248257
export(mofa.plot_centrality)
@@ -484,6 +493,7 @@ export(pos.compact)
484493
export(probe2symbol)
485494
export(psort)
486495
export(pubmedlink)
496+
export(purpleGreyYellow)
487497
export(rbind_sparse_matrix)
488498
export(read.as_matrix)
489499
export(read.gmt)
@@ -565,23 +575,50 @@ export(validate_samples)
565575
export(visPrint)
566576
export(visplot.PCSF)
567577
export(wgcna.compute)
578+
export(wgcna.computeConsensusGeneStats)
579+
export(wgcna.computeConsensusMatrix)
580+
export(wgcna.computeDistinctMatrix)
581+
export(wgcna.computeModuleEnrichment)
582+
export(wgcna.compute_multiomics)
583+
export(wgcna.createConsensusLayers)
568584
export(wgcna.filterColors)
585+
export(wgcna.getConsensusGeneStats)
586+
export(wgcna.getConsensusTopGenesAndSets)
569587
export(wgcna.getGeneStats)
570-
export(wgcna.labels2colors)
588+
export(wgcna.getModuleCrossGenes)
589+
export(wgcna.getTopGenesAndSets)
590+
export(wgcna.matchColors)
591+
export(wgcna.pickSoftThreshold)
592+
export(wgcna.plotConsensusOverlapHeatmap)
593+
export(wgcna.plotConsensusSampleDendroAndColors)
571594
export(wgcna.plotDendroAndColors)
595+
export(wgcna.plotDendroAndTraitCorrelation)
596+
export(wgcna.plotDendroAndTraitCorrelation_multi)
572597
export(wgcna.plotEigenGeneAdjacencyHeatmap)
573598
export(wgcna.plotEigenGeneClusterDendrogram)
574599
export(wgcna.plotEigenGeneGraph)
575600
export(wgcna.plotFeatureUMAP)
601+
export(wgcna.plotGeneNetwork)
576602
export(wgcna.plotLabeledCorrelationHeatmap)
577603
export(wgcna.plotMDS)
578604
export(wgcna.plotMMvsGS)
605+
export(wgcna.plotModuleHeatmap)
579606
export(wgcna.plotModuleHubGenes)
607+
export(wgcna.plotModuleScores)
580608
export(wgcna.plotModuleSignificance)
581609
export(wgcna.plotModuleTraitHeatmap)
610+
export(wgcna.plotMultiEigengeneCorrelation)
611+
export(wgcna.plotPowerAnalysis)
612+
export(wgcna.plotPowerAnalysis_multi)
613+
export(wgcna.plotPreservationModuleTraits)
614+
export(wgcna.plotPreservationSummaries)
582615
export(wgcna.plotSampleDendroAndColors)
583616
export(wgcna.plotTOM)
617+
export(wgcna.plotTopModules)
618+
export(wgcna.plotTopModules_multi)
619+
export(wgcna.plotTraitCorrelationBarPlots)
584620
export(wgcna.runConsensusWGCNA)
621+
export(wgcna.runPreservationWGCNA)
585622
export(wikipathview)
586623
export(wrapHyperLink)
587624
export(write.gmt)

R/ai-llm.R

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
#'
2+
#' @export
3+
ai.get_ollama_models <- function(models=NULL) {
4+
available.models <- system("ollama list | tail -n +2 | cut -d' ' -f 1", intern=TRUE)
5+
if(!is.null(models)) available.models <- intersect(models,available.models)
6+
return(available.models)
7+
}
8+
9+
OLLAMA_MODELS = ai.get_ollama_models()
10+
DEFAULT_LLM = "gpt-5-nano"
11+
12+
if(0) {
13+
model="gpt-5-nano";prompt=NULL
14+
model="gemma3:1b";prompt=NULL
15+
model="grok-4-fast-non-reasoning";prompt=NULL
16+
}
17+
18+
#' @export
19+
ai.get_remote_models <- function(models=NULL) {
20+
keys <- NULL
21+
22+
dbg("[ai.get_remote_models] models = ",models)
23+
dbg("[ai.get_remote_models] len.models = ",length(models))
24+
dbg("[ai.get_remote_models] OPENAI_API_KEY = ",Sys.getenv("OPENAI_API_KEY"))
25+
dbg("[ai.get_remote_models] XAI_API_KEY = ",Sys.getenv("XAI_API_KEY"))
26+
dbg("[ai.get_remote_models] GROQ_API_KEY = ",Sys.getenv("GROQ_API_KEY"))
27+
dbg("[ai.get_remote_models] GEMINI_API_KEY = ",Sys.getenv("GEMINI_API_KEY"))
28+
29+
if (Sys.getenv("OPENAI_API_KEY")!="") keys <- c(keys,"gpt-.*")
30+
if (Sys.getenv("XAI_API_KEY")!="") keys <- c(keys,"grok-.*")
31+
if (Sys.getenv("GROQ_API_KEY")!="") keys <- c(keys,"groq:.*")
32+
if (Sys.getenv("GEMINI_API_KEY")!="") keys <- c(keys,"gemini-.*")
33+
34+
if(is.null(models) || length(models)==0 || models[1]=="" ) {
35+
models <- keys
36+
} else if(!is.null(keys)) {
37+
regex <- paste0("^",keys,collapse="|")
38+
models <- grep(regex,models,value=TRUE)
39+
} else {
40+
models <- NULL
41+
}
42+
models
43+
}
44+
45+
#' @export
46+
ai.get_models <- function(models=NULL) {
47+
local.models <- ai.get_ollama_models(models)
48+
remote.models <- ai.get_remote_models(models)
49+
if(!is.null(models)) {
50+
models <- models[ models %in% c(local.models, remote.models)]
51+
} else {
52+
models <- c(local.models, remote.models)
53+
}
54+
return(models)
55+
}
56+
57+
#' @export
58+
ai.model_is_available <- function(model) {
59+
model %in% ai.get_models(models=model)
60+
}
61+
62+
#' @export
63+
ai.ask <- function(question, model=DEFAULT_LLM, prompt=NULL) {
64+
chat <- NULL
65+
if(inherits(model, "Chat")) {
66+
chat <- model
67+
} else if(is.character(model)) {
68+
if (model %in% OLLAMA_MODELS) {
69+
chat <- ellmer::chat_ollama(model = model, system_prompt = prompt)
70+
} else if (grepl("^gpt",model) && Sys.getenv("OPENAI_API_KEY")!="") {
71+
message("warning: using remote GPT model:", model)
72+
chat <- ellmer::chat_openai(
73+
model = model, system_prompt = prompt,
74+
api_key = Sys.getenv("OPENAI_API_KEY") )
75+
} else if (grepl("^grok",model) && Sys.getenv("XAI_API_KEY")!="") {
76+
chat <- ellmer::chat_openai(
77+
model = model, system_prompt = prompt,
78+
api_key = Sys.getenv("XAI_API_KEY"),
79+
base_url="https://api.x.ai/v1/")
80+
} else if (grepl("^groq",model) && Sys.getenv("GROQ_API_KEY")!="") {
81+
model <- sub("groq:","",model)
82+
chat <- ellmer::chat_groq(
83+
model = model, system_prompt = prompt,
84+
api_key = Sys.getenv("GROQ_API_KEY")
85+
)
86+
} else if (grepl("^gemini",model) && Sys.getenv("GEMINI_API_KEY")!="") {
87+
chat <- ellmer::chat_google_gemini(
88+
model = model, system_prompt = prompt,
89+
api_key = Sys.getenv("GEMINI_API_KEY")
90+
)
91+
}
92+
}
93+
94+
if(is.null(chat)) {
95+
message("ERROR. could not create model ", model)
96+
return(NULL)
97+
}
98+
. <- chat$chat(question, echo=FALSE)
99+
chat$last_turn()@text
100+
}
101+
102+
#' @export
103+
ai.genesets_summary <- function(gsets, pheno=NULL, model=DEFAULT_LLM,
104+
detail=1, html=FALSE, verbose=1) {
105+
q <- "Extract the main biological function of this list of gene sets that were found by doing geneset enrichment. Just give the answer. Do not acknowledge."
106+
if(!is.null(pheno)) q <- paste0(q, "Discuss in relation with the phenotype: '",pheno,"'.")
107+
if(detail==0) q <- paste(q, "Be very very short.")
108+
if(detail==1) q <- paste(q, "Describe in one short paragraph.")
109+
if(detail>=2) q <- paste(q, "Describe in detail.")
110+
if(html) q <- paste(q, "Use HTML formatting.")
111+
if(verbose>0) cat("Question:",q,"... \n")
112+
ss <- paste(gsets, collapse='; ')
113+
q <- paste(q, "These are the genesets: <list>",ss,"</list>. ")
114+
r <- ai.ask(q, model=model)
115+
#r <- ai.ask(q, model="gemma3:270m")
116+
#r <- ai.ask(q, model="gemma3:1b")
117+
return(r)
118+
}
119+
120+
num=3
121+
#' @export
122+
ai.genesets_keywords <- function(gsets, num=3, pheno=NULL, model=DEFAULT_LLM) {
123+
ss <- paste(gsets, collapse='; ')
124+
q <- paste0("Extract ",num," keywords describing the following collection of gene sets. ")
125+
q <- paste0(q, "These are the genesets: <list>",ss,"</list>. ")
126+
r <- ai.ask(q, model=model)
127+
return(r)
128+
}
129+
130+

R/compute2-extra.R

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -236,7 +236,10 @@ compute_extra <- function(pgx, extra = c(
236236
tt <- system.time({
237237
tryCatch(
238238
{
239-
pgx$wgcna <- pgx.wgcna(pgx)
239+
pgx$wgcna <- pgx.wgcna(
240+
pgx,
241+
ai_model = NULL ## no AI by default (yet)
242+
)
240243
},
241244
error = function(e) {
242245
message("[ERROR_WGCNA] FATAL: ", as.character(e))

R/gset-fisher.r

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,8 @@ gset.fisher2 <- function(genes.up, genes.dn, genesets, background = NULL,
104104
gset.fisher <- function(genes, genesets, background = NULL,
105105
fdr = 0.05, mc = TRUE, sort.by = "zratio", nmin = 3,
106106
min.genes = 15, max.genes = 500, method = "fast.fisher",
107-
check.background = TRUE, common.genes = TRUE, verbose = 1) {
107+
check.background = TRUE, common.genes = TRUE,
108+
no.pass=NA, verbose = 1) {
108109
if (is.null(background)) {
109110
background <- unique(unlist(genesets))
110111
if (verbose > 0) {
@@ -221,6 +222,11 @@ gset.fisher <- function(genes, genesets, background = NULL,
221222
stop("unknown method")
222223
}
223224

225+
## replace NA values
226+
if(any(is.na(pv))) {
227+
pv[is.na(pv)] <- no.pass
228+
}
229+
224230
## compute q-value
225231
qv <- rep(NA, length(pv))
226232
qv <- stats::p.adjust(pv, method = "fdr")

R/pgx-annot.R

Lines changed: 23 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1194,25 +1194,40 @@ getHumanOrtholog.biomart <- function(organism, symbols, verbose = 1) {
11941194
#' }
11951195
#' @import data.table
11961196
#' @export
1197-
probe2symbol <- function(probes, annot_table, query = c("symbol", "gene_name"),
1197+
probe2symbol <- function(probes, annot_table, query = "symbol",
11981198
key = NULL, fill_na = FALSE) {
1199-
# Prepare inputs
1199+
1200+
# Prepare inputs. add extra matching columns.
12001201
annot_table <- cbind(rownames = rownames(annot_table), annot_table)
1202+
id.cols <- intersect(c("feature","gene_name","symbol"),colnames(annot_table))
1203+
if(length(id.cols)>0) {
1204+
stripped_annot <- apply(annot_table[,id.cols,drop=FALSE],2,function(a) sub("^[A-Za-z]+:","",a))
1205+
##colnames(stripped_annot) <- paste0(colnames(stripped_annot),"_stripped")
1206+
annot_table <- cbind(annot_table, stripped_annot)
1207+
}
1208+
12011209
probes1 <- setdiff(probes, c(NA, ""))
12021210
if (is.null(key) || !key %in% colnames(annot_table)) {
12031211
key <- which.max(apply(annot_table, 2, function(a) sum(probes1 %in% a)))
12041212
}
12051213
if (is.null(key)) {
1206-
stop("[probe2symbol] FATAL. could not get key column.")
1214+
message("[probe2symbol] FATAL. could not get key column.")
1215+
return(NULL)
12071216
}
12081217

1209-
# match query
1210-
ii <- match(probes, annot_table[, key])
1211-
query <- intersect(query, colnames(annot_table))
1218+
query <- head(intersect(query, colnames(annot_table)),1)
12121219
if (length(query) == 0) {
1213-
stop("ERROR. no symbol column.")
1220+
message("ERROR. no symbol column.")
1221+
return(NULL)
12141222
}
1215-
query_col <- annot_table[ii, query[1]]
1223+
1224+
# fall back on old gene_name
1225+
if(query=="symbol" && !"symbol" %in% colnames(annot_table) &&
1226+
"gene_name" %in% colnames(annot_table)) query <- "gene_name"
1227+
1228+
# match query
1229+
ii <- match(probes, annot_table[, key])
1230+
query_col <- annot_table[ii, query]
12161231

12171232
# Deal with NA
12181233
if (fill_na) {

R/pgx-deconv.R

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -500,7 +500,6 @@ pgx.deconvolution <- function(X, ref,
500500
dbg("WARNING:: pgx.deconvolution: is X really counts? (not logarithmic)\n")
501501
}
502502

503-
504503
## clean up matrix, remove duplicate names
505504
mat <- as.matrix(X)
506505
rownames(mat) <- gsub(".*:", "", rownames(mat)) ## strip prefix
@@ -565,12 +564,14 @@ pgx.deconvolution <- function(X, ref,
565564
source(CIBERSORT.code)
566565
stime <- system.time(
567566
# The f CIBERSORT is likely from CIBERSORT package but better confirm
568-
## try(ciber.out <- CIBERSORT(ref, mat, perm = 0, QN = FALSE))
567+
## try(ciber.out <- CIBERSORT(ref, mat, perm = 0, QN = FALSE))
568+
NULL
569569
)
570570
}
571571
if (has.ciber2) {
572572
stime <- system.time(
573-
## try(ciber.out <- CIBERSORT::cibersort(ref, mat, perm = 0, QN = FALSE))
573+
## try(ciber.out <- CIBERSORT::cibersort(ref, mat, perm = 0, QN = FALSE))
574+
NULL
574575
)
575576
}
576577
if (!is.null(ciber.out)) {

0 commit comments

Comments
 (0)