In un messaggio del Monday 12 September 2011, anne dozieres ha scritto: > Hello, > > I'm conducting home range analyses on squirrel species from radiotelemetric > data; > > I estimated utilization distribution using fixed kernel density with the > h-adjusted smoothing parameter (Wauters et al., 2007). > > Despite numerous assays, I could not find a way to calculate home range > overlap using my kernel estimations (with h adj); I’ve tried to calculate > overlap using the “kerneloverlap” function but it seems that the > estimation can be done just with “href” or “hlscv”. > > Is there a way to conduct this analyse with the Wauters' hadj?? > > Many thanks for any help > > Anne
Hi anne. I used a modified version of the kerneloverlap function. The trick is that while the original kerneloverlap _recalculates_ home-ranges, my modified version needs an R object of class "khr" if i remember correctly. Anyway, here's the code! Happy number crunching ;) -- Q: Why do firemen wear red suspenders? A: To conform with departmental regulations concerning uniform dress. ----------------------------------------------------------- Damiano G. Preatoni, PhD Unità di Analisi e Gestione delle Risorse Ambientali Dipartimento Ambiente-Salute-Sicurezza Università degli Studi dell'Insubria Via J.H. Dunant, 3 - 21100 Varese (ITALY) tel +39 0332421538 fax +39 0332421446 http://biocenosi.dipbsf.uninsubria.it/ ICQ: 78690321 jabber: p...@jabber.org skype: prea.net ----------------------------------------------------------- Please consider the environment before printing this email Please do not send attachments in proprietary formats http://www.gnu.org/philosophy/no-word-attachments.html Use the UNI CEI Standard ISO/IEC 26300:2006 ----------------------------------------------------------- O< stop html mail - http://www.asciiribbon.org
###############################################################################
## Lepre Alpina calcolo sovrapposizione HR
################################################################################
# Version 1.0
# created prea 20090302
# updated prea 20090302
#
# Calculates overlap using the "single point of truth" approach: UDs are pre-
# calculated and stored as R objects (either on disk or not) of class khrud, khr
# Compared to original kerneloverlap, function kerneloverlap2 doesn't calculate
# UDs by itself, but needs an object of class khrud, khr containing already
# calculated UDs
#
# revision history:
# prea 20090302 - rewrote from scratch modifying adehabitat kerneloverlap
# function
#
################################################################################
kerneloverlap.spot <- function (UD, method = c("HR", "PHR", "VI", "BA",
"UDOI", "HD"), lev = 95, conditional = FALSE, ...)
{
method <- match.arg(method)
#@TODO fix this test...
if (class(UD) != c("khrud","khr")) {
print("UD argument must be of class khrud! Aborting.")
exit()
}
vol <- getvolumeUD(UD)
res <- matrix(0, ncol = length(x), nrow = length(x))
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)
}
signature.asc
Description: This is a digitally signed message part.
_______________________________________________ AniMov mailing list AniMov@faunalia.it http://lists.faunalia.it/cgi-bin/mailman/listinfo/animov
