[R-sig-Geo] estUDm not accepted by kerneloverlaphr
Clément Calenge
clement.calenge at oncfs.gouv.fr
Sat Feb 26 17:55:36 CET 2011
On 02/26/2011 04:56 PM, Tom_R wrote:
> Hi List!
> I converting my script from the old adehabitat to adehabitatHR and
> adehabitatTR, in order to take advantage of the Biased Random Bridge
> utilisation distribution estimation techniques.
> However, the BRB (in adehabitatHR) outputs an "estUDm" object, which
> kerneloverlaphr doesn't accept; it only accepts khrud or kbbrud objects
> (from the original adehabitat).
> It seems that adehabitatHR provides the facility to converting khrud to
> estudm, using "khr2estUDm" but not the reverse. Also, adehabitatHR doesn't
> seem to include a newer version of kerneloverlaphr...
>
> So my question is simple; how do I persuade adehabitat's kerneloveraphr to
> accept adehabitatHR's estUDm objects?
You're right, I forgot to program kerneloverlaphr in the new version.
It will be in the next version of HR.
Here is the code, where x is an object of class "estUDm":
kerneloverlaphr <- function (x, method = c("HR", "PHR", "VI", "BA",
"UDOI", "HD"),
percent = 95, conditional = FALSE, ...)
{
method <- match.arg(method)
if (!inherits(x, "estUDm"))
stop("x should be of class estUDm")
if (length(x)==1)
stop("several animals are needed for this function")
if (slot(x[[1]],"vol"))
stop("x should not be a volume under UD")
vol <- getvolumeUD(x)
gp <- gridparameters(vol[[1]])
res <- matrix(0, ncol = length(x), nrow = length(x))
for (i in 1:length(x)) {
for (j in 1:i) {
if (method == "HR") {
vi <- as.data.frame(vol[[i]])[, 1]
vj <- as.data.frame(vol[[j]])[, 1]
vi[vi <= percent] <- 1
vi[vi > percent] <- 0
vj[vj <= percent] <- 1
vj[vj > percent] <- 0
vk <- vi * vj
res[i, j] <- sum(vk)/sum(vi)
res[j, i] <- sum(vk)/sum(vj)
}
if (method == "PHR") {
vi <- as.data.frame(x[[i]])[, 1]
vj <- as.data.frame(x[[j]])[, 1]
ai <- as.data.frame(vol[[i]])[, 1]
aj <- as.data.frame(vol[[j]])[, 1]
ai[ai <= percent] <- 1
ai[ai > percent] <- 0
aj[aj <= percent] <- 1
aj[aj > percent] <- 0
if (conditional) {
vi <- vi * ai
vj <- vj * aj
res[j, i] <- sum(vi * aj) * (gp[1, 2]^2)
res[i, j] <- sum(vj * ai) * (gp[1, 2]^2)
}
else {
res[j, i] <- sum(vi * aj) * (gp[1, 2]^2)
res[i, j] <- sum(vj * ai) * (gp[1, 2]^2)
}
}
if (method == "VI") {
vi <- c(as.data.frame(x[[i]])[, 1])
vj <- c(as.data.frame(x[[j]])[, 1])
ai <- as.data.frame(vol[[i]])[, 1]
aj <- as.data.frame(vol[[j]])[, 1]
ai[ai <= percent] <- 1
ai[ai > percent] <- 0
aj[aj <= percent] <- 1
aj[aj > percent] <- 0
if (conditional) {
vi <- vi * ai
vj <- vj * aj
res[i, j] <- res[j, i] <- sum(pmin(vi, vj)) *
(gp[1, 2]^2)
}
else {
res[i, j] <- res[j, i] <- sum(pmin(vi, vj)) *
(gp[1, 2]^2)
}
}
if (method == "BA") {
vi <- c(as.data.frame(x[[i]])[, 1])
vj <- c(as.data.frame(x[[j]])[, 1])
ai <- as.data.frame(vol[[i]])[, 1]
aj <- as.data.frame(vol[[j]])[, 1]
ai[ai <= percent] <- 1
ai[ai > percent] <- 0
aj[aj <= percent] <- 1
aj[aj > percent] <- 0
if (conditional) {
vi <- vi * ai
vj <- vj * aj
res[j, i] <- res[i, j] <- sum(sqrt(vi) * sqrt(vj)) *
(gp[1, 2]^2)
}
else {
res[j, i] <- res[i, j] <- sum(sqrt(vi) * sqrt(vj)) *
(gp[1, 2]^2)
}
}
if (method == "UDOI") {
vi <- c(as.data.frame(x[[i]])[, 1])
vj <- c(as.data.frame(x[[j]])[, 1])
ai <- as.data.frame(vol[[i]])[, 1]
aj <- as.data.frame(vol[[j]])[, 1]
ai[ai <= percent] <- 1
ai[ai > percent] <- 0
aj[aj <= percent] <- 1
aj[aj > percent] <- 0
if (conditional) {
vi <- vi * ai
vj <- vj * aj
ak <- sum(ai * aj) * (gp[1, 2]^2)
res[j, i] <- res[i, j] <- ak * sum(vi * vj) *
(gp[1, 2]^2)
}
else {
ak <- sum(ai * aj) * (gp[1, 2]^2)
res[j, i] <- res[i, j] <- ak * sum(vi * vj) *
(gp[1, 2]^2)
}
}
if (method == "HD") {
vi <- c(as.data.frame(x[[i]])[, 1])
vj <- c(as.data.frame(x[[j]])[, 1])
ai <- as.data.frame(vol[[i]])[, 1]
aj <- as.data.frame(vol[[j]])[, 1]
ai[ai <= percent] <- 1
ai[ai > percent] <- 0
aj[aj <= percent] <- 1
aj[aj > percent] <- 0
if (conditional) {
vi <- vi * ai
vj <- vj * aj
res[j, i] <- res[i, j] <- sqrt(sum((sqrt(vi) -
sqrt(vj))^2 * (gp[1, 2]^2)))
}
else {
res[j, i] <- res[i, j] <- sqrt(sum((sqrt(vi) -
sqrt(vj))^2 * (gp[1, 2]^2)))
}
}
}
}
rownames(res) <- names(x)
colnames(res) <- names(x)
return(res)
}
>
> Many thanks !
>
> Reproducible code :
>
> library(adehabitat)
> library(adehabitatHR)
>
> x<- runif(100)
> y<-runif(100)
> z<- seq(1:100)
> xy<- as.matrix(data.frame(cbind(x,y)))
> id<- as.factor(c(rep(1,50),rep(2,50)))
> class(z)<- "POSIXct"
> traject<- as.ltraj( xy, z, id, typeII=TRUE )
> traject<- rec(traject)
>
> D<- BRB.D(traject, Tmax=100, Lmin=0.05)
> UD<- BRB(traject, D, tau=1, Tmax=100, Lmin=0.05, hmin=0.2) ## Biased random
> bridge
>
> contr1<- getverticeshr(UD[[1]], lev =50)
> contr2<- getverticeshr(UD[[2]], lev =50)
> plot(contr1, add=TRUE, col=rgb(0,0,0,0.2)) ## plot
> plot(contr2, add=TRUE, col=rgb(0,0,0,0.2))
>
> overlap<- kerneloverlaphr(UD, method = "UDOI") ## ERROR: need to convert
> estUDm to khrud or kbbrud
>
>
>
>
>
>
--
Clément CALENGE
Cellule d'appui à l'analyse de données
Direction des Etudes et de la Recherche
Office national de la chasse et de la faune sauvage
Saint Benoist - 78610 Auffargis
tel. (33) 01.30.46.54.14
More information about the R-sig-Geo
mailing list