-
Notifications
You must be signed in to change notification settings - Fork 0
/
variation.R
59 lines (54 loc) · 1.38 KB
/
variation.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
52
53
54
55
56
57
58
59
# VARIATION MATRIX
#' @include AllGenerics.R
NULL
# Variation matrix =============================================================
#' @export
#' @rdname variation
#' @aliases variation,CompositionMatrix-method
setMethod(
f = "variation",
signature = c(x = "CompositionMatrix"),
definition = function(x) {
J <- ncol(x)
parts <- colnames(x)
varia <- utils::combn(
x = seq_len(J),
m = 2,
FUN = function(i, coda) {
z <- log(coda[, i[1]] / coda[, i[2]], base = exp(1))
stats::var(z)
},
coda = x
)
mtx <- matrix(data = 0, nrow = J, ncol = J)
mtx[lower.tri(mtx, diag = FALSE)] <- varia
mtx <- t(mtx)
mtx[lower.tri(mtx, diag = FALSE)] <- varia
dimnames(mtx) <- list(parts, parts)
mtx
}
)
# Variation array ==============================================================
# @export
# @rdname variation_array
# @aliases variation_array,CompositionMatrix-method
# setMethod(
# f = "variation_array",
# signature = c(object = "CompositionMatrix"),
# definition = function(object) {
# J <- ncol(object)
# cbn <- utils::combn(seq_len(J), 2)
# varia <- apply(
# X = cbn,
# MARGIN = 2,
# FUN = function(j, x) {
# mean(log(x[, j[1]] / x[, j[2]]))
# },
# x = object
# )
#
# mtx <- variation(object)
# mtx[lower.tri(mtx, diag = FALSE)] <- varia
# mtx
# }
# )