mirror of
https://github.com/johrpan/geposan.git
synced 2025-10-26 10:47:25 +01:00
ranking: Remove caching for optimization
This commit is contained in:
parent
57fc119993
commit
33cc33f81a
1 changed files with 27 additions and 32 deletions
59
R/ranking.R
59
R/ranking.R
|
|
@ -65,41 +65,36 @@ optimal_weights <- function(analysis, methods, reference_gene_ids,
|
||||||
stop("Invalid analyis. Use geposan::analyze().")
|
stop("Invalid analyis. Use geposan::analyze().")
|
||||||
}
|
}
|
||||||
|
|
||||||
cached(
|
|
||||||
"optimization",
|
|
||||||
c(analysis$preset, methods, reference_gene_ids, target),
|
|
||||||
{ # nolint
|
|
||||||
# Compute the target rank of the reference genes when applying the
|
|
||||||
# weights.
|
|
||||||
target_rank <- function(factors) {
|
|
||||||
data <- ranking(analysis, as.list(factors))
|
|
||||||
|
|
||||||
result <- data[
|
# Compute the target rank of the reference genes when applying the
|
||||||
gene %chin% reference_gene_ids,
|
# weights.
|
||||||
if (target == "min") {
|
target_rank <- function(factors) {
|
||||||
min(rank)
|
data <- ranking(analysis, as.list(factors))
|
||||||
} else if (target == "max") {
|
|
||||||
max(rank)
|
|
||||||
} else if (target == "mean") {
|
|
||||||
mean(rank)
|
|
||||||
} else {
|
|
||||||
stats::median(rank)
|
|
||||||
}
|
|
||||||
]
|
|
||||||
|
|
||||||
if (result > 0) {
|
result <- data[
|
||||||
result
|
gene %chin% reference_gene_ids,
|
||||||
} else {
|
if (target == "min") {
|
||||||
Inf
|
min(rank)
|
||||||
}
|
} else if (target == "max") {
|
||||||
|
max(rank)
|
||||||
|
} else if (target == "mean") {
|
||||||
|
mean(rank)
|
||||||
|
} else {
|
||||||
|
stats::median(rank)
|
||||||
}
|
}
|
||||||
|
]
|
||||||
|
|
||||||
initial_factors <- rep(1.0, length(methods))
|
if (result > 0) {
|
||||||
names(initial_factors) <- methods
|
result
|
||||||
|
} else {
|
||||||
optimal_factors <- stats::optim(initial_factors, target_rank)$par
|
Inf
|
||||||
|
|
||||||
as.list(optimal_factors / max(abs(optimal_factors)))
|
|
||||||
}
|
}
|
||||||
)
|
}
|
||||||
|
|
||||||
|
initial_factors <- rep(1.0, length(methods))
|
||||||
|
names(initial_factors) <- methods
|
||||||
|
|
||||||
|
optimal_factors <- stats::optim(initial_factors, target_rank)$par
|
||||||
|
|
||||||
|
as.list(optimal_factors / max(abs(optimal_factors)))
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue