/
kerneloverlap.R
131 lines (120 loc) · 4.24 KB
/
kerneloverlap.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
131
kerneloverlap <- function(xy, id = NULL,
method = c("HR", "PHR", "VI", "BA", "UDOI", "HD"),
lev=95, conditional=FALSE, ...)
{
## Verifications
method <- match.arg(method)
## UD estimation
x <- kernelUD(xy, id, same4all=TRUE, ...)
vol <- getvolumeUD(x)
## Matrix of results
res <- matrix(0, ncol=length(x), nrow=length(x))
## loop for each animal
for (i in 1:length(x)) {
for (j in 1:i) {
if (method=="HR") {
vi <- vol[[i]]$UD
vj <- vol[[j]]$UD
vi[vi<=lev] <- 1
vi[vi>lev] <- 0
vj[vj<=lev] <- 1
vj[vj>lev] <- 0
vk <- vi*vj
res[i,j] <- sum(vk)/sum(vi)
res[j,i] <- sum(vk)/sum(vj)
}
if (method=="PHR") {
vi <- x[[i]]$UD
vj <- x[[j]]$UD
ai <- vol[[i]]$UD
aj <- vol[[j]]$UD
ai[ai<=lev] <- 1
ai[ai>lev] <- 0
aj[aj<=lev] <- 1
aj[aj>lev] <- 0
if (conditional) {
vi <- vi*ai
vj <- vj*aj
res[j,i] <- sum(vi*aj)*(attr(vi,"cellsize")^2)
res[i,j] <- sum(vj*ai)*(attr(vi,"cellsize")^2)
} else {
res[j,i] <- sum(vi*aj)*(attr(vi,"cellsize")^2)
res[i,j] <- sum(vj*ai)*(attr(vi,"cellsize")^2)
}
}
if (method=="VI") {
vi <- c(x[[i]]$UD)
vj <- c(x[[j]]$UD)
ai <- vol[[i]]$UD
aj <- vol[[j]]$UD
ai[ai<=lev] <- 1
ai[ai>lev] <- 0
aj[aj<=lev] <- 1
aj[aj>lev] <- 0
if (conditional) {
vi <- vi*ai
vj <- vj*aj
res[i,j] <- res[j,i] <- sum(pmin(vi, vj))*(attr(x[[i]]$UD,"cellsize")^2)
} else {
res[i,j] <- res[j,i] <- sum(pmin(vi, vj))*(attr(x[[i]]$UD,"cellsize")^2)
}
}
if (method=="BA") {
vi <- x[[i]]$UD
vj <- x[[j]]$UD
ai <- vol[[i]]$UD
aj <- vol[[j]]$UD
ai[ai<=lev] <- 1
ai[ai>lev] <- 0
aj[aj<=lev] <- 1
aj[aj>lev] <- 0
if (conditional) {
vi <- vi*ai
vj <- vj*aj
res[j,i] <- res[i,j] <- sum(sqrt(vi)*sqrt(vj))*(attr(vi,"cellsize")^2)
} else {
res[j,i] <- res[i,j] <- sum(sqrt(vi)*sqrt(vj))*(attr(vi,"cellsize")^2)
}
}
if (method=="UDOI") {
vi <- x[[i]]$UD
vj <- x[[j]]$UD
ai <- vol[[i]]$UD
aj <- vol[[j]]$UD
ai[ai<=lev] <- 1
ai[ai>lev] <- 0
aj[aj<=lev] <- 1
aj[aj>lev] <- 0
if (conditional) {
vi <- vi*ai
vj <- vj*aj
ak <- sum(ai*aj)*(attr(vi,"cellsize")^2)
res[j,i] <- res[i,j] <- ak * sum(vi*vj)*(attr(vi,"cellsize")^2)
} else {
ak <- sum(ai*aj)*(attr(vi,"cellsize")^2)
res[j,i] <- res[i,j] <- ak * sum(vi*vj)*(attr(vi,"cellsize")^2)
}
}
if (method=="HD") {
vi <- x[[i]]$UD
vj <- x[[j]]$UD
ai <- vol[[i]]$UD
aj <- vol[[j]]$UD
ai[ai<=lev] <- 1
ai[ai>lev] <- 0
aj[aj<=lev] <- 1
aj[aj>lev] <- 0
if (conditional) {
vi <- vi*ai
vj <- vj*aj
res[j,i] <- res[i,j] <- sqrt(sum((sqrt(vi) - sqrt(vj))^2*(attr(vi,"cellsize")^2)))
} else {
res[j,i] <- res[i,j] <- sqrt(sum((sqrt(vi) - sqrt(vj))^2*(attr(vi,"cellsize")^2)))
}
}
}
}
rownames(res) <- names(x)
colnames(res) <- names(x)
return(res)
}