-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathCV.R
51 lines (51 loc) · 1.28 KB
/
CV.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#' compute CV for each row in matrix
#'
#' Typically used to create and violin plot
#'
#' @param data matrix
#' @param top remove top (default 30) CV
#' @param na.rm default TRUE
#' @export
#' @examples
#' dat <- matrix(rnorm(1000,10,5), ncol=20)
#' dim(dat)
#' cv <- CV(dat, top=5)
#' length(cv)
#' stopifnot(length(cv) == 45)
#' hist(cv)
#'
CV <- function(data, top = 30, na.rm = TRUE){
# TODO review code - there might to many checks and filters for NA
idx <- apply(data,1, function(x){(ncol(data) - sum(is.na(x))) >= 2 })
data <- data[idx,]
sd = apply(data, 1, sd, na.rm = na.rm)
mean = apply(data, 1, mean, na.rm = na.rm)
idx <- mean==0 | is.na(mean)
sd <- sd[!idx]
mean <- mean[!idx]
res = sd/mean * 100
xx <- rank(res)
res <- res[xx<=(length(xx)-top)]
return(res)
}
#' geometric coefficient of variation (CV for log transformed data)
#' Typically used to create and violin plot
#'
#' @param data matrix
#' @param top remove top (default 30) CV
#' @export
#' @seealso CV
#' @examples
#' dat <- matrix(rnorm(1000,10,5), ncol=20)
#' dim(dat)
#' cv <- CVlog(dat, top=5)
#' length(cv)
#' stopifnot(length(cv) == 45)
#' hist(cv)
CVlog <- function(data,top=30){
sd=apply(data,1,sd, na.rm=TRUE)
res = (exp(sd)-1)
xx <- rank(res)
res <- res[xx<=(length(xx)-top)]
return(res)
}