# R/optClust.R In SingerLab/gac: Genetic Analysis of Cells

#### Documented in minimum.intersectoptClust

```#' optimizing clustering for single-cell copy number
#'
#' The optClust is a simple attempt to set a threshold on where to cut the an
#' hclust tree.  The aim is to maximize the number of cluster with multiple-cells
#' while minimizing the number of one-cell clusters.
#'
#' @return
#'
#' Returns a matrix where rows are the heights in the opt.range, and three columns.
#'
#' One-cell specifies the number of clusters with only one cell,
#' Multi-cell specifyies the number of clusters with multiple cells (>=2), and
#' %CMC which is the percentage of cells in multi-cell clusters
#'
#' A good threshold is one that minimizes the one-cell cluster, and maximizes
#' the %CMC
#'
#'
#' @param cnr a cnr bundle
#'
#' @param opt.range  range of tree heights that need to be optimized
#'
#' @examples
#'
#' data(cnr)
#'
#' cnr <- phyloCNR(cnr)
#'
#' optClust(cnr, opt.range = seq(0, 0.3, by = 0.05))
#'
#' #for micro-optimization
#'
#' optClust(cnr, opt.range = seq(0, 0.2, by = 0.001))
#'
#' @export
optClust <- function(cnr, opt.range = seq(0.005, 0.6, by = 0.005)) {

clL <- sapply(opt.range, function(h) {
ctbl <- sort(table(cutree(cnr[["hcdb"]], h = h)),
decreasing = TRUE)
})
names(clL) <- opt.range

omt <- matrix(t(sapply(clL, function(i) {
cbind(sum(i == 1), sum(i != 1), sum(i != 1)/length(i))
})),
ncol = 3,
dimnames = list(opt.range, c("One-cell", "Multi-cell", "%CMC")))

return(omt)

} # optClust

#' Minimum tree.height at the intersect of one-cell and multi-cell clusters
#'
#' @param mocp output from \link{optClust}
#'
#' @export
minimum.intersect <- function(mocp) {

mi <- as.numeric(names(which(mocp[,1] < mocp[,2])))
return(mi)

} #end minimum.intersect
```
SingerLab/gac documentation built on Sept. 24, 2021, 8:17 p.m.
{"ft_lang_label":"__label__en","ft_lang_prob":0.60299635,"math_prob":0.9298136,"size":1780,"snap":"2021-43-2021-49","text_gpt3_token_len":544,"char_repetition_ratio":0.14358108,"word_repetition_ratio":0.021276595,"special_character_ratio":0.33764046,"punctuation_ratio":0.14095744,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.98659074,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2021-10-23T15:25:44Z\",\"WARC-Record-ID\":\"<urn:uuid:bbdc40e7-c695-442b-865a-72a9bc0e8378>\",\"Content-Length\":\"48466\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:33ea8654-42e7-4284-83ab-bc412c1c0f2b>\",\"WARC-Concurrent-To\":\"<urn:uuid:92478888-69e2-4f5f-8951-ae50d97b3a48>\",\"WARC-IP-Address\":\"51.81.83.12\",\"WARC-Target-URI\":\"https://rdrr.io/github/SingerLab/gac/src/R/optClust.R\",\"WARC-Payload-Digest\":\"sha1:R2CFAWVRQV23AZN73GILIK3F6P6UG2NR\",\"WARC-Block-Digest\":\"sha1:KBDXPC2U5QQVM7HSOZFMFY2BUU55FLDR\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2021/CC-MAIN-2021-43/CC-MAIN-2021-43_segments_1634323585696.21_warc_CC-MAIN-20211023130922-20211023160922-00649.warc.gz\"}"}