Multiple Imputation using CRAWL

Multiple Imputation using CRAWL

Let’s load the elk data from Morales et al. (2004) and use momentuHMM to format the data

library(momentuHMM)
elkdata = read.table("https://sites.google.com/site/modelosydatos/elk_data.txt", 
    header = TRUE)
datos <- prepData(elkdata, type = "UTM", coordNames = c("Easting", 
    "Northing"))

We have to provide times for the observations. I am inventing an initial date. Should look at the actual date of release…

library(lubridate)
tmp <- table(datos$ID)

times <- as.Date("2002/4/7")
for (i in 1:length(tmp)) {
    tmp1 <- seq(as.Date("2002/4/7"), by = "day", length.out = tmp[i])
    times <- c(times, seq(as.Date("2002/4/7"), by = "day", length.out = tmp[i]))
}

time <- times[2:length(times)]
hrs <- rep("00:00:00", times = length(time))

datos$time <- as.POSIXct(paste(as.character(time), hrs), format = "%Y-%m-%d %H:%M:%S")

Now we delete some data to pretend we have 20% of missing locations:

set.seed(1234)
mis <- sample.int(dim(datos)[1], round(dim(datos)[1] * 0.2))
datosr <- datos[-mis, ]

Now we use CRAWL to impute the missing observations. We will check for each animal if we can fit the continuous time CRW and simulate a trajectory. This is a bit painful but I have not figured out a better way.

library(crawl)
ids <- unique(datos$ID)
nind <- length(ids)

fits <- vector(mode = "list", length = nind)
sim_objs <- vector(mode = "list", length = nind)
sims <- NULL

for (i in 1:nind) {
    
    fit1 <- crwMLE(mov.model = ~1, err.model = NULL, drift = FALSE, 
        data = datosr[datosr$ID == ids[i], ], Time.name = "time", 
        time.scale = "day", fixPar = c(NA, NA), attempts = 100)
    
    while (any(is.na(fit1$se))) {
        fit1 <- crwMLE(mov.model = ~1, err.model = NULL, drift = FALSE, 
            data = datosr[datosr$ID == ids[i], ], Time.name = "time", 
            time.scale = "day", fixPar = c(NA, NA), attempts = 100)
    }
    fits[[i]] <- fit1
    predObj <- crwPredict(fit1, predTime = "24 hours", return.type = "flat")
    simObj <- crwSimulator(fit1, predTime = "24 hour")  #, method='quadrature', quad.ask=F)
    sim_objs[[i]] <- simObj
    sim <- crwPostIS(simObj, fullPost = TRUE)
    tmp <- data.frame(ID = rep(ids[i], dim(sim$alpha.sim)[1]), 
        time = sim$time, x = sim$alpha.sim[, 1], y = sim$alpha.sim[, 
            3])
    sims <- rbind(sims, tmp)
}

Now we can see how the simulated trajectories (in red) compare to the observed ones (in black), I added the locations used to fit the continuous time CRW in green.

for (i in 1:nind) {
    elk = i
    tmp <- which(datos$ID == ids[elk])
    plot(datos$x[tmp], datos$y[tmp], type = "o", asp = 1, pch = 19)
    tmp <- which(sims$ID == ids[elk])
    lines(sims$x[tmp], sims$y[tmp], col = 2)
    tmp <- which(datosr$ID == ids[elk])
    points(datosr$x[tmp], datosr$y[tmp], col = 3, pch = 19)
}

For the multiple imputation, we want to:

1- simulate trajectories using crwPostIS using the saved simObj

2- fit whatever model we want to the simulated trajectories (a CRW where step length depend on local density of conspecifics for example)

3- repeat 1 and 2 a number of times (10 might be enough, more are better)

4- combine paremter estimates as in McClintock 2017