mirror of
https://github.com/johrpan/geposan.git
synced 2025-10-26 18:57:25 +01:00
Restructure classes and their responsibilities
This commit is contained in:
parent
01ec301d6d
commit
e2b93babe5
27 changed files with 974 additions and 634 deletions
151
R/correlation.R
151
R/correlation.R
|
|
@ -1,88 +1,101 @@
|
|||
# Compute the mean correlation coefficient comparing gene distances with a set
|
||||
# of reference genes.
|
||||
correlation <- function(preset, progress = NULL) {
|
||||
species_ids <- preset$species_ids
|
||||
gene_ids <- preset$gene_ids
|
||||
reference_gene_ids <- preset$reference_gene_ids
|
||||
#' Compute the mean correlation coefficient comparing gene distances with a set
|
||||
#' of reference genes.
|
||||
#'
|
||||
#' @return An object of class `geposan_method`.
|
||||
#'
|
||||
#' @export
|
||||
correlation <- function() {
|
||||
method(
|
||||
id = "correlation",
|
||||
name = "Correlation",
|
||||
description = "Correlation with reference genes",
|
||||
function(preset, progress) {
|
||||
species_ids <- preset$species_ids
|
||||
gene_ids <- preset$gene_ids
|
||||
reference_gene_ids <- preset$reference_gene_ids
|
||||
|
||||
cached(
|
||||
"correlation", c(species_ids, gene_ids, reference_gene_ids), {
|
||||
# Prefilter distances by species.
|
||||
distances <- geposan::distances[species %chin% species_ids]
|
||||
cached(
|
||||
"correlation",
|
||||
c(species_ids, gene_ids, reference_gene_ids),
|
||||
{ # nolint
|
||||
# Prefilter distances by species.
|
||||
distances <- geposan::distances[species %chin% species_ids]
|
||||
|
||||
# Tranform data to get species as rows and genes as columns. We
|
||||
# construct columns per species, because it requires fewer
|
||||
# iterations, and transpose the table afterwards.
|
||||
# Tranform data to get species as rows and genes as columns.
|
||||
# We construct columns per species, because it requires
|
||||
# fewer iterations, and transpose the table afterwards.
|
||||
|
||||
data <- data.table(gene = gene_ids)
|
||||
data <- data.table(gene = gene_ids)
|
||||
|
||||
# Make a column containing distance data for each species.
|
||||
for (species_id in species_ids) {
|
||||
species_data <- distances[
|
||||
species == species_id,
|
||||
.(gene, distance)
|
||||
]
|
||||
# Make a column containing distance data for each species.
|
||||
for (species_id in species_ids) {
|
||||
species_data <- distances[
|
||||
species == species_id,
|
||||
.(gene, distance)
|
||||
]
|
||||
|
||||
data <- merge(data, species_data, all.x = TRUE)
|
||||
setnames(data, "distance", species_id)
|
||||
}
|
||||
data <- merge(data, species_data, all.x = TRUE)
|
||||
setnames(data, "distance", species_id)
|
||||
}
|
||||
|
||||
# Transpose to the desired format.
|
||||
data <- transpose(data, make.names = "gene")
|
||||
# Transpose to the desired format.
|
||||
data <- transpose(data, make.names = "gene")
|
||||
|
||||
if (!is.null(progress)) progress(0.33)
|
||||
progress(0.33)
|
||||
|
||||
# Take the reference data.
|
||||
reference_data <- data[, ..reference_gene_ids]
|
||||
# Take the reference data.
|
||||
reference_data <- data[, ..reference_gene_ids]
|
||||
|
||||
# Perform the correlation between all possible pairs.
|
||||
results <- stats::cor(
|
||||
data[, ..gene_ids],
|
||||
reference_data,
|
||||
use = "pairwise.complete.obs",
|
||||
method = "spearman"
|
||||
)
|
||||
# Perform the correlation between all possible pairs.
|
||||
results <- stats::cor(
|
||||
data[, ..gene_ids],
|
||||
reference_data,
|
||||
use = "pairwise.complete.obs",
|
||||
method = "spearman"
|
||||
)
|
||||
|
||||
results <- data.table(results, keep.rownames = TRUE)
|
||||
setnames(results, "rn", "gene")
|
||||
results <- data.table(results, keep.rownames = TRUE)
|
||||
setnames(results, "rn", "gene")
|
||||
|
||||
# Remove correlations between the reference genes themselves.
|
||||
for (reference_gene_id in reference_gene_ids) {
|
||||
column <- quote(reference_gene_id)
|
||||
results[gene == reference_gene_id, eval(column) := NA]
|
||||
}
|
||||
# Remove correlations between the reference genes
|
||||
# themselves.
|
||||
for (reference_gene_id in reference_gene_ids) {
|
||||
column <- quote(reference_gene_id)
|
||||
results[gene == reference_gene_id, eval(column) := NA]
|
||||
}
|
||||
|
||||
if (!is.null(progress)) progress(0.66)
|
||||
progress(0.66)
|
||||
|
||||
# Compute the final score as the mean of known correlation scores.
|
||||
# Negative correlations will correctly lessen the score, which will
|
||||
# be clamped to zero as its lower bound. Genes with no possible
|
||||
# correlations at all will be assumed to have a score of 0.0.
|
||||
# Compute the final score as the mean of known correlation
|
||||
# scores. Negative correlations will correctly lessen the
|
||||
# score, which will be clamped to zero as its lower bound.
|
||||
# Genes with no possible correlations at all will be assumed
|
||||
# to have a score of 0.0.
|
||||
|
||||
compute_score <- function(scores) {
|
||||
score <- mean(scores, na.rm = TRUE)
|
||||
compute_score <- function(scores) {
|
||||
score <- mean(scores, na.rm = TRUE)
|
||||
|
||||
if (is.na(score) | score < 0.0) {
|
||||
score <- 0.0
|
||||
if (is.na(score) | score < 0.0) {
|
||||
score <- 0.0
|
||||
}
|
||||
|
||||
score
|
||||
}
|
||||
|
||||
results[,
|
||||
score := compute_score(as.matrix(.SD)),
|
||||
.SDcols = reference_gene_ids,
|
||||
by = gene
|
||||
]
|
||||
|
||||
results[, .(gene, score)]
|
||||
|
||||
result(
|
||||
method = "correlation",
|
||||
scores = results[, .(gene, score)],
|
||||
details = list(all_correlations = results)
|
||||
)
|
||||
}
|
||||
|
||||
score
|
||||
}
|
||||
|
||||
results[,
|
||||
score := compute_score(as.matrix(.SD)),
|
||||
.SDcols = reference_gene_ids,
|
||||
by = gene
|
||||
]
|
||||
|
||||
results[, .(gene, score)]
|
||||
|
||||
structure(
|
||||
list(
|
||||
results = results[, .(gene, score)],
|
||||
all_correlations = results
|
||||
),
|
||||
class = "geposan_method_results"
|
||||
)
|
||||
}
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue