[AniMov] help with error during trajectory analysis in adehabitatLT

S. Skrafner s.skrafner at gmail.com
Wed Apr 6 14:25:05 CEST 2011


Thank you very much Clément, I just tested it out and it works perfectly!

Cheers,
Steve

2011/4/6 Clément Calenge <clement.calenge at oncfs.gouv.fr>

>  Dear Steve,
>
>
>
> I am exploring the trajectory analysis functions of the new adehabitatLT
> package and am coming across an error while I am trying to partition the
> trajectory using the function partmod.ltraj.  Unfortunately I do not get the
> error on all data sets that I am working on, which is making it very
> difficult for me to track down exactly what the cause is. The error is
> "Error in if (prot > 1e-08) { : missing value where TRUE/FALSE needed"
>
> As an example, the code below shows the process for one particular data
> set, the first completes successfully, while the second results in the above
> error:
>
> # Example 1
> tested.means <- round(seq(0,20000, length=10),0)
> limod <- as.list(paste("dnorm(dist, mean=", tested.means, ", sd=750)"))
> (mod <- modpartltraj(tr3, limod))
> bestpartmod(mod)
> (pm <- partmod.ltraj(tr3,14, mod))
>
> # Example 2
> tested.means <- round(seq(0,15000, length=10),0)
> limod <- as.list(paste("dnorm(dist, mean=", tested.means, ", sd=750)"))
> (mod <- modpartltraj(tr3, limod))
> bestpartmod(mod)
> (pm <- partmod.ltraj(tr3,8, mod))
>
> In the second example, I have only changed the upper bound of the set of
> models.  As a result, the recommended number of partitions (bestpartmod)
> changes to 8, which I use to create 'pm' but the above error is the result.
> If I continue to reduce the number of partitions, it's finally successful at
> 3.   Alternatively, if I reduce the upper bound of the model from 20000 to
> 16000 and also reduce the number of models from 10 to 8, it will also run
> successfully.
>
>
> This is indeed a bug that occurs in partmod.ltraj when missing values occur
> in the trajectory and na.manage="prop.move". It is now corrected. Until I
> submit a revised version (probably by the end of the week), you can use this
> corrected version of partmod.ltraj:
>
> partmod.ltraj <- function (tr, npart, mods, na.manage = c("prop.move",
> "locf"))
> {
>     if (!inherits(tr, "ltraj"))
>         stop("tr should be of class \"ltraj\"")
>     if (length(tr) > 1)
>         stop("only one traject can be passed")
>     if (!inherits(mods, "modpartltraj"))
>         stop("mods should be of class modpartltraj")
>     na.manage <- match.arg(na.manage)
>     cor <- tr[[1]]
>     indiceNA <- attr(mods, "nna.places")
>     if (npart > nrow(mods))
>         stop("too large number of segments required")
>     toto <- .C("partrajr", as.double(t(as.matrix(mods))), double(npart),
>         integer(npart), integer(npart + 1), as.integer(nrow(mods)),
>         as.integer(ncol(mods)), as.integer(npart), PACKAGE =
> "adehabitatLT")
>     curloc <- rev(toto[[4]])
>     curloc[2:length(curloc)] <- curloc[2:length(curloc)] + 1
>     curmod <- rev(toto[[3]])
>     curma <- rev(toto[[2]])
>     filo <- curloc[-length(curloc)]
>     lalo <- curloc[-1]
>     lalo[length(lalo)] <- nrow(cor)
>     resltr <- lapply(1:length(lalo), function(i) {
>         if (i == 1) {
>             xyt <- cor[1:indiceNA[lalo[i]], c("x", "y", "date")]
>         }
>         else {
>             if (i == length(lalo)) {
>                 xyt <- cor[indiceNA[filo[i]]:nrow(cor), c("x",
>                   "y", "date")]
>             }
>             else {
>                 xyt <- cor[indiceNA[filo[i]]:indiceNA[lalo[i]],
>                   c("x", "y", "date")]
>             }
>         }
>         return(as.ltraj(xyt[, c("x", "y")], xyt[, c("date")],
>             id = id(tr), burst = i))
>     })
>     cseq <- function(x) {
>         id <- diff(c(1, c(1:length(x))[abs(c(0, diff(x))) > 0],
>             length(x) + 1))
>         split(x, unlist(sapply(1:length(id), function(i) rep(i,
>             id[i]))))
>     }
>     if (na.manage == "prop.move") {
>         nadf <- do.call("rbind", lapply(1:length(resltr), function(i) {
>             nas <- is.na(resltr[[i]][[1]]$dist[-nrow(resltr[[i]][[1]])])
>             vec <- cseq(nas)
>             beg <- sum(vec[[length(vec)]])
>             intern <- sum(nas) - beg
>             return(c(beg, intern))
>         }))
>         nadf <- as.data.frame(nadf)
>         typmod <- tapply(nadf[, 2], factor(curmod), sum)
>         typmod <- typmod/sum(typmod)
>         for (i in 2:length(resltr)) {
>             gg <- resltr[[i - 1]][[1]]
>             gg2 <- resltr[[i]][[1]]
>             gg <- gg[-nrow(gg), ]
>             ff <- cseq(is.na(gg$dist))
>             nna <- sum(ff[[length(ff)]])
>             if (nna > 1) {
>                 prot <- sum(typmod[names(typmod)%in%c(curmod[i - 1],
> curmod[i])])
>                 if (prot > 1e-08) {
>                   nna1 <- floor(nna * typmod[names(typmod)==curmod[i -
> 1]]/prot)
>                 }
>                 else {
>                   nna1 <- floor(nna/2)
>                 }
>                 nna2 <- nna - nna1
>                 gg2 <- rbind(gg[(nrow(gg) - nna2):nrow(gg), ],
>                   gg2)
>                 gg <- gg[1:(nrow(gg) - nna2), ]
>                 resltr[[i - 1]] <- as.ltraj(gg[, c("x", "y")],
>                   gg[, c("date")], id = id(tr), burst = i - 1)
>                 resltr[[i]] <- as.ltraj(gg2[, c("x", "y")], gg2[,
>                   c("date")], id = id(tr), burst = i)
>             }
>         }
>     }
>     resltr <- do.call("c.ltraj", resltr)
>     resu <- list(ltraj = resltr, stats = list(locs = curloc,
>         Mk = curma, mod = curmod, which.mod = colnames(mods)[curmod]))
>     attr(resu, "nna.places") <- indiceNA
>     class(resu) <- "partltraj"
>     return(resu)
> }
>
>
> Thanks for reporting,
> Best regards,
>
>
> Clément Calenge.
>
>
>
>
>
>
>
>
> If anyone has any experience with this or thoughts that might help, I would
> appreciate hearing from you.
>
> Thanks in advance
> Steve
>
>
> _______________________________________________
> AniMov mailing listAniMov at faunalia.ithttp://lists.faunalia.it/cgi-bin/mailman/listinfo/animov
>
>
>
> --
> 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
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.faunalia.it/pipermail/animov/attachments/20110406/d990b61e/attachment-0001.html>


More information about the AniMov mailing list