R/Flimited.R

In borishejblum/NPflow: Bayesian Nonparametrics for Automatic Gating of Flow-Cytometry Data

#'Compute a limited F-measure
#'
#'A limited version of F-measure that only takes into account small clusters
#'
#'@param n_small_clst an integer for limit size of the small cluster
#'
#'@param pred vector of a predicted partition
#'
#'@param ref vector of a reference partition
#'
#'@references Hejblum BP, Alkhassim C, Gottardo R, Caron F and Thiebaut R (2019) 
#'Sequential Dirichlet Process Mixtures of Multivariate Skew t-distributions for 
#'Model-based Clustering of Flow Cytometry Data. The Annals of Applied Statistics, 
#'13(1): 638-660. <doi: 10.1214/18-AOAS1209> <arXiv: 1702.04407> 
#'\url{https://arxiv.org/abs/1702.04407} \doi{10.1214/18-AOAS1209}
#'
#'@examples
#'pred <- c(rep(1, 5),rep(2, 8),rep(3,10))
#'ref <- c(rep(1, 5),rep(c(2,3), 4),rep(c(3,2),5))
#'FmeasureC(pred, ref)
#'Flimited(6, pred, ref)
#'
#'@export
Flimited <- function(n_small_clst, pred, ref){

  stopifnot(length(pred)==length(ref))

  partition_ref <- as.numeric(ref)
  partition_est <- as.numeric(pred)

  label_obs_in_small_class_ref <- which(table(partition_ref)<=n_small_clst)
  if(!length(label_obs_in_small_class_ref)){
    stop('n_small_clst should be increased')
  }

  label_obs_in_small_class_ref <- as.numeric(names(label_obs_in_small_class_ref))
  index_obs_in_small_class_ref <- which(partition_ref %in% label_obs_in_small_class_ref)
  label_obs_in_small_class_est <- unique(partition_est[index_obs_in_small_class_ref])

  index_obs_restricted <- which(partition_est%in%label_obs_in_small_class_est)
  partition_est_restricted <- partition_est[index_obs_restricted]
  partition_ref_restricted <- partition_ref[index_obs_restricted]

  return(FmeasureC(ref=partition_ref_restricted, pred=partition_est_restricted))
}