-
Notifications
You must be signed in to change notification settings - Fork 14
/
Copy pathhill_func_parti_pairwise.R
130 lines (121 loc) · 5.74 KB
/
hill_func_parti_pairwise.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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
#' Pairwise comparisons for all sites.
#'
#' Calculate pairwise functional gamma, alpha, and beta diversity for communities, as
#' well as site similarity. It is based on \code{\link{hill_func_parti}}.
#' If comm has >2 sites, this function will give results for all pairwise comparisons.
#'
#' @inheritParams hill_func_parti
#' @inheritParams hill_taxa_parti_pairwise
#' @param ... additional arguments for \code{hill_func_parti}.
#' @export
#' @references Chao, Anne, Chun-Huo Chiu, and Lou Jost. Unifying Species Diversity, Phylogenetic Diversity, Functional Diversity, and Related Similarity and Differentiation Measures Through Hill Numbers. Annual Review of Ecology, Evolution, and Systematics 45, no. 1 (2014): 297–324. <doi:10.1146/annurev-ecolsys-120213-091540>.
#'
#' Chiu, Chun-Huo, and Anne Chao. Distance-Based Functional Diversity Measures and Their Decomposition: A Framework Based on Hill Numbers. PLoS ONE 9, no. 7 (July 7, 2014): e100014. <doi:10.1371/journal.pone.0100014>.
#' @return a data frame with results for all pairwise comparisons.
#' @seealso \code{\link{hill_func_parti}}
#' @examples
#' \dontrun{
#' dummy = FD::dummy
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 0)
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 0,
#' output = 'matrix')
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 0,
#' output = 'matrix', pairs = 'full')
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 1)
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 0.9999)
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 2)
#' hill_func_parti_pairwise(comm = dummy$abun, traits = dummy$trait, q = 3)
#' }
hill_func_parti_pairwise <- function(comm, traits, traits_as_is = FALSE,
q = 0, rel_then_pool = TRUE,
output = c("data.frame", "matrix"),
pairs = c("unique", "full"),
.progress = TRUE, show_warning = TRUE,
...) {
if (any(comm < 0))
stop("Negative value in comm data")
if (is.null(rownames(traits))) {
stop("\n Traits have no row names\n")
}
if (is.null(colnames(comm))) {
stop("\n Comm data have no col names\n")
}
if (any(colSums(comm) == 0) & show_warning)
warning("Some species in comm data were not observed in any site,\n delete them...")
if (any(rowSums(comm) == 0) & show_warning)
warning("Some sites in comm data do not have any species,\n delete them...")
comm <- comm[rowSums(comm) != 0, colSums(comm) != 0, drop = FALSE]
output <- match.arg(output)
pairs <- match.arg(pairs)
nsite <- nrow(comm)
temp <- matrix(1, nsite, nsite)
dimnames(temp) <- list(row.names(comm), row.names(comm))
gamma_pair <- alpha_pair <- beta_pair <- local_simi <- region_simi <- temp
if(.progress)
progbar = utils::txtProgressBar(min = 0, max = nsite - 1, initial = 0, style = 3)
for (i in 1:(nsite - 1)) {
if(.progress) utils::setTxtProgressBar(progbar, i)
for (j in (i + 1):nsite) {
o <- hill_func_parti(comm = comm[c(i, j), ], traits = traits,
traits_as_is = traits_as_is, q = q,
rel_then_pool = rel_then_pool, check_data = FALSE,
...)
gamma_pair[i, j] <- o$FD_gamma
gamma_pair[j, i] <- o$FD_gamma
alpha_pair[i, j] <- o$FD_alpha
alpha_pair[j, i] <- o$FD_alpha
beta_pair[i, j] <- o$FD_beta
beta_pair[j, i] <- o$FD_beta
local_simi[i, j] <- o$local_similarity
local_simi[j, i] <- o$local_similarity
region_simi[i, j] <- o$region_similarity
region_simi[j, i] <- o$region_similarity
}
}
if(.progress) close(progbar)
if (pairs == "full") {
if (output == "matrix") {
out <- list(q = q, FD_gamma = gamma_pair, FD_alpha = alpha_pair, FD_beta = beta_pair,
local_similarity = local_simi, region_similarity = region_simi)
}
if (output == "data.frame") {
site.comp <- as.matrix(expand.grid(row.names(comm), row.names(comm)))
out <- plyr::adply(site.comp, 1, function(x) {
data.frame(q = q, site1 = x[1], site2 = x[2],
FD_gamma = gamma_pair[x[1], x[2]],
FD_alpha = alpha_pair[x[1], x[2]],
FD_beta = beta_pair[x[1], x[2]],
local_similarity = local_simi[x[1], x[2]],
region_similarity = region_simi[x[1], x[2]])
})[, -1]
out <- tibble::as_tibble(out)
}
out
}
if (pairs == "unique") {
gamma_pair[lower.tri(gamma_pair, diag = TRUE)] <- NA
alpha_pair[lower.tri(alpha_pair, diag = TRUE)] <- NA
beta_pair[lower.tri(beta_pair, diag = TRUE)] <- NA
local_simi[lower.tri(local_simi, diag = TRUE)] <- NA
region_simi[lower.tri(region_simi, diag = TRUE)] <- NA
if (output == "matrix") {
out <- list(q = q, FD_gamma = gamma_pair, FD_alpha = alpha_pair, FD_beta = beta_pair,
local_similarity = local_simi, region_similarity = region_simi)
}
if (output == "data.frame") {
site.comp <- as.matrix(expand.grid(row.names(comm), row.names(comm)))
out <- plyr::adply(site.comp, 1, function(x) {
data.frame(q = q, site1 = x[1], site2 = x[2],
FD_gamma = gamma_pair[x[1], x[2]],
FD_alpha = alpha_pair[x[1], x[2]],
FD_beta = beta_pair[x[1], x[2]],
local_similarity = local_simi[x[1], x[2]],
region_similarity = region_simi[x[1], x[2]])
})
out <- na.omit(out)[, -1]
row.names(out) <- NULL
out <- tibble::as_tibble(out)
}
}
out
}