johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 19:27:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Optimize clustering for speed

Browse source
This commit is contained in:
Elias Projahn 2021-10-09 14:22:28 +02:00
parent ae0643741a
commit b122f2e240
1 changed files with 16 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

53
clustering.R
View file

@ -1,6 +1,4 @@
library(data.table) library(data.table)
library(progress)
library(rlog)
#' Perform a cluster analysis. #' Perform a cluster analysis.
#' #'
@ -11,13 +9,18 @@ library(rlog)
#' score between zero and one. Lower ranking clusters contribute less to this #' score between zero and one. Lower ranking clusters contribute less to this
#' score. #' score.
clusteriness <- function(data, n, height = 1000000) { clusteriness <- function(data, n, height = 1000000) {
# Return a score of 0.0 if there is just one or no value at all.
if (length(data) < 2) {
return(0.0)
}
# Cluster the data and compute the cluster sizes. # Cluster the data and compute the cluster sizes.
tree <- hclust(dist(data)) tree <- hclust(dist(data))
clusters <- cutree(tree, h = height) clusters <- cutree(tree, h = height)
cluster_sizes <- sort(tabulate(clusters), decreasing = TRUE) cluster_sizes <- sort(tabulate(clusters), decreasing = TRUE)
# Compute the "cluteriness" score. # Compute the "clusteriness" score.
score <- 0.0 score <- 0.0
@ -38,49 +41,25 @@ clusteriness <- function(data, n, height = 1000000) {
#' The return value will be a data.table with the following columns: #' The return value will be a data.table with the following columns:
#' #'
#' - `gene` Gene ID of the processed gene. #' - `gene` Gene ID of the processed gene.
#' - `cluster_length` Length of the largest cluster. #' - `clusteriness` Score quantidying the gene's clusters.
#' - `cluster_mean` Mean value of the largest cluster.
#' - `cluster_species` List of species contributing to the largest cluster.
#' #'
#' @param distances Gene distance data to use. #' @param distances Gene distance data to use.
#' @param species_ids IDs of species to include in the analysis. #' @param species_ids IDs of species to include in the analysis.
#' @param gene_ids Genes to include in the computation. #' @param gene_ids Genes to include in the computation.
process_clustering <- function(distances, species_ids, gene_ids) { process_clustering <- function(distances, species_ids, gene_ids) {
results <- data.table(gene = gene_ids) results <- data.table(gene = gene_ids)
gene_count <- length(gene_ids) species_count <- length(species)
log_info(sprintf( # Prefilter the input data by species.
"Clustering %i genes from %i species", distances <- distances[species %chin% species_ids]
gene_count,
length(species_ids)
))
progress <- progress_bar$new( # Add an index for quickly accessing data per gene.
total = gene_count, setkey(distances, gene)
format = "Clustering genes [:bar] :percent (ETA :eta)"
)
for (i in 1:gene_count) { #' Perform the cluster analysis for one gene.
progress$tick() compute <- function(gene_id) {
clusteriness(distances[gene_id, distance], species_count)
gene_id <- gene_ids[i]
data <- distances[
species %chin% species_ids & gene == gene_id,
.(species, distance)
]
if (data[, .N] < 10) {
next
}
score <- clusteriness(data[, distance], length(species_ids))
results[
gene == gene_id,
clusteriness := score
]
} }
results results[, clusteriness := compute(gene), by = 1:nrow(results)]
} }