├── .Rbuildignore ├── .github └── workflows │ └── r.yml ├── .gitignore ├── CRAN-SUBMISSION ├── DESCRIPTION ├── NAMESPACE ├── R ├── AllMethod.R ├── RcppExports.R ├── aic.crw.R ├── argosDiag2Cov.R ├── crawl-internal.R ├── crawl-package.R ├── crw-methods.R ├── crwMLE.R ├── crwN2ll.R ├── crwPostIS.R ├── crwPredict.R ├── crwPredictPlot.R ├── crwSamplePar.R ├── crwSimulator.R ├── crwUseGrid.R ├── crw_coerce_sf.R ├── crw_coerce_tibble.R ├── detect_timescale.R ├── displayPar.R ├── expandPred.R ├── fillCols.R ├── getQ.R ├── intToPOSIX.R ├── mergeTrackStop.R ├── par2arglist.R ├── print.crwFit.R ├── run_shiny_apps.R ├── tidy_crwFit.R └── utils-pipe.R ├── README.Rmd ├── README.md ├── data ├── beardedSeals.rda ├── harborSeal.rda ├── harborSeal_sf.rda └── northernFurSeal.rda ├── hex_sticker ├── crawl.png ├── crocodile_1f40a.png ├── hex_sticker.R ├── mean_gator.png └── noaa.png ├── inst └── CITATION ├── man ├── aic.crw.Rd ├── argosDiag2Cov.Rd ├── as.flat.Rd ├── beardedSeals.Rd ├── crawl-package.Rd ├── crwMLE.Rd ├── crwN2ll.Rd ├── crwPostIS.Rd ├── crwPredict.Rd ├── crwPredictPlot.Rd ├── crwSamplePar.Rd ├── crwSimulator.Rd ├── crw_as_sf.Rd ├── crw_as_tibble.Rd ├── detect_timescale.Rd ├── displayPar.Rd ├── expandPred.Rd ├── fillCols.Rd ├── fix_path.Rd ├── flatten.Rd ├── harborSeal.Rd ├── harborSeal_sf.Rd ├── intToPOSIX.Rd ├── mergeTrackStop.Rd ├── northernFurSeal.Rd ├── pipe.Rd ├── sub-.crwIS.Rd └── tidy_crwFit.Rd └── src ├── CTCRWN2LL.cpp ├── CTCRWN2LL_DRIFT.cpp ├── CTCRWPREDICT.cpp ├── CTCRWPREDICT_DRIFT.cpp ├── CTCRWSAMPLE.cpp ├── CTCRWSAMPLE_DRIFT.cpp ├── Makevars ├── Makevars.win ├── RcppExports.cpp ├── SMM_MATS.cpp └── init.c /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.gitignore$ 4 | ^\.DS_Store$ 5 | ^\.git$ 6 | ^\.github$ 7 | ^README\.Rmd$ 8 | ^README\.md$ 9 | ^README-.*\.png$ 10 | [.]so$ 11 | [.]o$ 12 | ^CRAN-SUBMISSION$ 13 | ^hex_sticker$ 14 | -------------------------------------------------------------------------------- /.github/workflows/r.yml: -------------------------------------------------------------------------------- 1 | # This workflow uses actions that are not certified by GitHub. 2 | # They are provided by a third-party and are governed by 3 | # separate terms of service, privacy policy, and support 4 | # documentation. 5 | # 6 | # See https://github.com/r-lib/actions/tree/master/examples#readme for 7 | # additional example workflows available for the R community. 8 | 9 | on: 10 | push: 11 | branches: [main, master, devel] 12 | pull_request: 13 | branches: [main, master, devel] 14 | 15 | name: R-CMD-check 16 | 17 | jobs: 18 | R-CMD-check: 19 | runs-on: ${{ matrix.config.os }} 20 | 21 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 22 | 23 | strategy: 24 | fail-fast: false 25 | matrix: 26 | config: 27 | - {os: macOS-latest, r: 'release'} 28 | - {os: windows-latest, r: 'release'} 29 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 30 | - {os: ubuntu-latest, r: 'release'} 31 | - {os: ubuntu-latest, r: 'oldrel-1'} 32 | 33 | env: 34 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 35 | R_KEEP_PKG_SOURCE: yes 36 | 37 | steps: 38 | - uses: actions/checkout@v2 39 | 40 | - uses: r-lib/actions/setup-pandoc@v2 41 | 42 | - uses: r-lib/actions/setup-r@v2 43 | with: 44 | r-version: ${{ matrix.config.r }} 45 | http-user-agent: ${{ matrix.config.http-user-agent }} 46 | use-public-rspm: true 47 | 48 | - uses: r-lib/actions/setup-r-dependencies@v2 49 | with: 50 | extra-packages: any::rcmdcheck 51 | needs: check 52 | 53 | - uses: r-lib/actions/check-r-package@v2 54 | with: 55 | upload-snapshots: true 56 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .project 3 | .Rhistory 4 | crawl.Rcheck 5 | crawl_1.3.tar.gz 6 | crawl_1.3.tgz 7 | crawl_1.3.zip 8 | crawl_archive 9 | northernFurSealExample.R 10 | .Rproj.user 11 | crawl.Rproj 12 | *.so 13 | *.o 14 | *.tar.gz 15 | *.zip 16 | *.tgz 17 | inst/doc 18 | /testing 19 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 2.3.0 2 | Date: 2022-10-06 21:31:25 UTC 3 | SHA: 2771ba364e9631d230afa3132eaea81ac9add5a1 4 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: crawl 2 | Type: Package 3 | Title: Fit Continuous-Time Correlated Random Walk Models to Animal Movement Data 4 | Version: 2.3.1 5 | Date: 2024-10-03 6 | Authors@R: c(person("Devin S.", "Johnson", email = "devin.johnson@noaa.gov", 7 | role = c("aut", "cre")), 8 | person("Josh", "London", email = "josh.london@noaa.gov", 9 | role = c("aut")), 10 | person("Brett T.", "McClintock", email = "brett.mcclintock@noaa.gov", 11 | role = c("ctb")), 12 | person("Kenady", "Wilson", email = "kenady@wildlifecomputers.com", 13 | role = c("ctb")) ) 14 | Depends: 15 | R (>= 3.4.0) 16 | Imports: 17 | mvtnorm, 18 | Rcpp (>= 0.11.1), 19 | methods, 20 | dplyr, 21 | sf, 22 | sp, 23 | tibble, 24 | magrittr, 25 | lubridate, 26 | purrr, 27 | rlang 28 | LinkingTo: 29 | Rcpp, 30 | RcppArmadillo 31 | Description: Fit continuous-time correlated random walk models with time indexed 32 | covariates to animal telemetry data. The model is fit using the Kalman-filter on 33 | a state space version of the continuous-time stochastic movement process. 34 | License: CC0 35 | Encoding: UTF-8 36 | LazyLoad: yes 37 | ByteCompile: TRUE 38 | NeedsCompilation: yes 39 | RoxygenNote: 7.3.2 40 | URL: https://github.com/NMML/crawl 41 | BugReports: https://github.com/NMML/crawl/issues 42 | LazyData: true 43 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",crwIS) 4 | S3method(crwMLE,SpatialPoints) 5 | S3method(crwMLE,default) 6 | S3method(crwMLE,sf) 7 | S3method(crw_as_sf,crwIS) 8 | S3method(crw_as_sf,crwPredict) 9 | S3method(crw_as_sf,list) 10 | S3method(crw_as_sf,sf) 11 | S3method(crw_as_tibble,crwIS) 12 | S3method(crw_as_tibble,crwPredict) 13 | S3method(crw_as_tibble,tbl) 14 | S3method(print,crwFit) 15 | export("%>%") 16 | export(aic.crw) 17 | export(argosDiag2Cov) 18 | export(as.flat) 19 | export(crwMLE) 20 | export(crwN2ll) 21 | export(crwPostIS) 22 | export(crwPredict) 23 | export(crwPredictPlot) 24 | export(crwSamplePar) 25 | export(crwSimulator) 26 | export(crw_as_sf) 27 | export(crw_as_tibble) 28 | export(detect_timescale) 29 | export(displayPar) 30 | export(expandPred) 31 | export(fillCols) 32 | export(fix_path) 33 | export(flatten) 34 | export(intToPOSIX) 35 | export(mergeTrackStop) 36 | export(tidy_crwFit) 37 | import(dplyr) 38 | import(mvtnorm) 39 | import(rlang) 40 | importFrom(Rcpp,evalCpp) 41 | importFrom(graphics,layout) 42 | importFrom(graphics,lines) 43 | importFrom(graphics,plot) 44 | importFrom(magrittr,"%>%") 45 | importFrom(methods,as) 46 | importFrom(methods,slot) 47 | importFrom(stats,approx) 48 | importFrom(stats,median) 49 | importFrom(stats,model.frame) 50 | importFrom(stats,model.matrix) 51 | importFrom(stats,na.pass) 52 | importFrom(stats,optim) 53 | importFrom(stats,pchisq) 54 | importFrom(stats,pexp) 55 | importFrom(stats,pnorm) 56 | importFrom(stats,qnorm) 57 | importFrom(stats,rchisq) 58 | importFrom(stats,rnorm) 59 | importFrom(stats,runif) 60 | importFrom(stats,sd) 61 | importFrom(stats,setNames) 62 | importFrom(stats,var) 63 | importFrom(utils,tail) 64 | useDynLib(crawl, .registration = TRUE) 65 | -------------------------------------------------------------------------------- /R/AllMethod.R: -------------------------------------------------------------------------------- 1 | #' 'Flattening' a list-form crwPredict object into a data.frame 2 | #' 3 | #' \dQuote{Flattens} a list form \code{\link{crwPredict}} object into a flat 4 | #' data.frame. 5 | #' 6 | #' 7 | #' @param predObj A crwPredict object 8 | #' @return a \code{\link{data.frame}} version of a crwPredict list with columns 9 | #' for the state standard errors 10 | #' @author Devin S. Johnson 11 | #' @seealso \code{\link{northernFurSeal}} for use example 12 | #' @export 13 | "as.flat" <- function(predObj) 14 | { 15 | se.y <- sqrt(t(apply(predObj$V.hat.y, 3, diag))) 16 | se.x <- sqrt(t(apply(predObj$V.hat.x, 3, diag))) 17 | colnames(se.y) <- paste("se", names(predObj$alpha.hat.y), sep=".") 18 | colnames(se.x) <- paste("se", names(predObj$alpha.hat.x), sep=".") 19 | flat <- cbind(predObj$originalData, predObj$alpha.hat.y, se.y, 20 | predObj$alpha.hat.x, se.x) 21 | if (!is.null(predObj$speed)) flat <- cbind(flat, predObj$speed) 22 | class(flat) <- c("crwPredict", "data.frame") 23 | attr(flat, "coord") <- attr(predObj, "coord") 24 | attr(flat, "random.drift") <- attr(predObj, "random.drift") 25 | attr(flat, "stop.model") <- attr(predObj, "stop.model") 26 | attr(flat, "polar.coord") <- attr(predObj, "polar.coord") 27 | attr(flat, "Time.name") <- attr(predObj, "Time.name") 28 | attr(flat, "flat") <- TRUE 29 | return(flat) 30 | } 31 | 32 | #' 'Flattening' a list-form crwPredict object into a data.frame 33 | #' 34 | #' \dQuote{Flattens} a list form \code{\link{crwPredict}} object into a flat 35 | #' data.frame. 36 | #' 37 | #' 38 | #' @param predObj A crwPredict object 39 | #' @return a \code{\link{data.frame}} version of a crwPredict list with columns 40 | #' for the state standard errors 41 | #' @author Devin S. Johnson 42 | #' @seealso \code{\link{northernFurSeal}} for use example 43 | #' @export 44 | "flatten" <- function(predObj) 45 | { 46 | se <- sqrt(t(apply(predObj$V.hat, 3, diag))) 47 | colnames(se) <- paste("se", names(predObj$alpha.hat), sep=".") 48 | flat <- cbind(predObj$originalData, predObj$alpha.hat, se) 49 | if (!is.null(predObj$speed)) flat <- cbind(flat, speed=predObj$speed) 50 | class(flat) <- c("crwPredict", "data.frame") 51 | attr(flat, "coord") <- attr(predObj, "coord") 52 | attr(flat, "random.drift") <- attr(predObj, "random.drift") 53 | attr(flat, "Time.name") <- attr(predObj, "Time.name") 54 | attr(flat, "flat") <- TRUE 55 | return(flat) 56 | } 57 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | CTCRWNLL <- function(y, Hmat, beta, sig2, delta, noObs, active, a, P) { 5 | .Call(`_crawl_CTCRWNLL`, y, Hmat, beta, sig2, delta, noObs, active, a, P) 6 | } 7 | 8 | CTCRWNLL_DRIFT <- function(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) { 9 | .Call(`_crawl_CTCRWNLL_DRIFT`, y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) 10 | } 11 | 12 | CTCRWPREDICT <- function(y, Hmat, beta, sig2, delta, noObs, active, a, P) { 13 | .Call(`_crawl_CTCRWPREDICT`, y, Hmat, beta, sig2, delta, noObs, active, a, P) 14 | } 15 | 16 | CTCRWPREDICT_DRIFT <- function(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) { 17 | .Call(`_crawl_CTCRWPREDICT_DRIFT`, y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) 18 | } 19 | 20 | CTCRWSAMPLE <- function(y, Hmat, beta, sig2, delta, noObs, active, a, P) { 21 | .Call(`_crawl_CTCRWSAMPLE`, y, Hmat, beta, sig2, delta, noObs, active, a, P) 22 | } 23 | 24 | CTCRWSAMPLE_DRIFT <- function(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) { 25 | .Call(`_crawl_CTCRWSAMPLE_DRIFT`, y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P) 26 | } 27 | 28 | makeT <- function(b, delta, active) { 29 | .Call(`_crawl_makeT`, b, delta, active) 30 | } 31 | 32 | makeQ <- function(b, sig2, delta, active) { 33 | .Call(`_crawl_makeQ`, b, sig2, delta, active) 34 | } 35 | 36 | makeT_drift <- function(b, b_drift, delta, active) { 37 | .Call(`_crawl_makeT_drift`, b, b_drift, delta, active) 38 | } 39 | 40 | makeQ_drift <- function(b, b_drift, sig2, sig2_drift, delta, active) { 41 | .Call(`_crawl_makeQ_drift`, b, b_drift, sig2, sig2_drift, delta, active) 42 | } 43 | 44 | -------------------------------------------------------------------------------- /R/aic.crw.R: -------------------------------------------------------------------------------- 1 | #' Calculates AIC for all objects of class crwFit listed as arguments 2 | #' 3 | #' AIC, delta AIC, and Akaike weights for all models listed as arguments. 4 | #' 5 | #' 6 | #' The function can either be executed with a series of 'crwFit' objects (see 7 | #' \code{\link{crwMLE}}) without the '.crwFit' suffix or the function can be 8 | #' called without any arguments and it will search out all 'crwFit' objects in 9 | #' the current workspace and produce the model selection table for all 'crwFit' 10 | #' objects in the workspace. Caution should be used when executing the function 11 | #' in this way. ALL 'crwFit' objects will be included whether or not the same 12 | #' locations are used! For all of the models listed as arguments (or in the 13 | #' workspace), AIC, delta AIC, and Akaike weights will be calculated. 14 | #' 15 | #' @param \dots a series of crwFit objects 16 | #' @return A table, sorted from lowest AIC value to highest. 17 | #' @author Devin S. Johnson 18 | #' @export 19 | "aic.crw" <- function(...) 20 | { 21 | lnms <- NULL 22 | models <- list(...) 23 | if(length(models) == 0) { 24 | lnms <- list() 25 | lx <- ls(envir=parent.frame(2)) 26 | for (i in 1:length(lx)) { 27 | classval <- class(eval(parse(text=lx[i]), envir=parent.frame(2))) 28 | if("crwFit" %in% classval) lnms <- append(lnms,list(lx[i])) 29 | } 30 | models <- eval(parse(text=paste("list(", 31 | paste(paste(lnms, "=", lnms, sep=""), 32 | collapse=","), ")")), envir=parent.frame()) 33 | vnms <- do.call("c", lnms) 34 | } else { 35 | models <- list(...) 36 | vnms <- all.vars(match.call()) 37 | } 38 | num.mod <- length(vnms) 39 | AIC.vec <- numeric(num.mod) 40 | ks <- numeric(num.mod) 41 | for (i in 1:num.mod) { 42 | AIC.vec[i] <- round(models[[i]]$aic, 2) 43 | ks[i] <- length(models[[i]]$fixPar) - sum(!is.na(models[[i]]$fixPar)) 44 | } 45 | deltaAIC <- round(AIC.vec - min(AIC.vec), 2) 46 | wAIC <- round(exp(-0.5 * deltaAIC) / sum(exp(-0.5 * deltaAIC)), 2) 47 | ord <- order(deltaAIC) 48 | out <- data.frame(Name=vnms, k=ks, AIC=AIC.vec, 49 | dAIC=deltaAIC, weight=wAIC) 50 | return(out[ord, ]) 51 | } 52 | 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /R/argosDiag2Cov.R: -------------------------------------------------------------------------------- 1 | #' @title Transform Argos diagnostic data to covariance matrix form 2 | #' 3 | #' @description Using this function the user can transform the Argos diagnostic data for location 4 | #' error into a form usable as a covariance matrix to approximate the location error with a 5 | #' bivariate Gaussian distribution. The resulting data.frame should be attached back to the data 6 | #' with \code{cbind} to use with the \code{crwMLE} function. 7 | #' @param Major A vector containing the major axis information for each observation (na values are ok) 8 | #' @param Minor A vector containing the minor axis information for each observation (na values are ok) 9 | #' @param Orientation A vector containing the angle orientation of the Major axis from North (na values are ok) 10 | #' @return A \code{data.frame} with the following columns 11 | #' \item{ln.sd.x}{The log standard deviation of the location error in the x coordinate} 12 | #' \item{ln.sd.y}{The log standard deviation of the location error in the x coordinate} 13 | #' \item{rho}{The correlation of the bivariate location error ellipse} 14 | #' @author Devin S. Johnson 15 | #' @export 16 | 17 | argosDiag2Cov = function(Major, Minor, Orientation){ 18 | a=Major 19 | b=Minor 20 | if(any(b<=.Machine$double.eps,na.rm=TRUE)) stop("There are very small (or 0) values for the minor ellipse lengths! These may need to be removed.") 21 | theta=Orientation 22 | if(any(theta < 0 | theta > 180, na.rm = TRUE)) stop("Argos diagnostic data orientation outside of [0,180]!") 23 | if(any(a < 0, na.rm = TRUE)) stop("Argos diagnostic data major axis < 0!") 24 | if(any(b < 0, na.rm = TRUE)) stop("Argos diagnostic data minor axis < 0!") 25 | theta = pi*(theta/180) 26 | k=sqrt(2) 27 | v1 = (a/k)^2*sin(theta)^2 + (b/k)^2*cos(theta)^2 28 | v2 = (a/k)^2*cos(theta)^2 + (b/k)^2*sin(theta)^2 29 | c12 = ((a^2 - b^2)/k^2)*cos(theta)*sin(theta) 30 | rho = c12/(sqrt(v1)*sqrt(v2)) 31 | check = (v1*v2-c12^2) > 0 32 | if(any(rho > 1 | rho < -1, na.rm=TRUE)) stop("Faulty Argos error correlation calculated from 'argosDiag2Cov' function") 33 | return(data.frame(ln.sd.x=log(sqrt(v1)), ln.sd.y=log(sqrt(v2)), error.corr=rho, diag.check=check)) 34 | } 35 | -------------------------------------------------------------------------------- /R/crawl-internal.R: -------------------------------------------------------------------------------- 1 | 2 | erf = function(x){ 3 | return(2*pnorm(x*sqrt(2))-1) 4 | } 5 | erfinv = function(z){ 6 | if(-1>=z | z>=1) stop("Correlation outside of (-1,1)\n") 7 | qnorm((z+1)/2)/sqrt(2) 8 | } 9 | 10 | makeAvail <- function(i, Tmat, Qmat, predx, predy, vary, varx, driftMod, lonadj){ 11 | .T <- matrix(0, 2+driftMod,2+driftMod) 12 | .T[1,1] <- 1 13 | .T[1,2] <- Tmat[i,1] 14 | .T[2,2] <- Tmat[i,2] 15 | if(driftMod){ 16 | .T[1,3] <- Tmat[i,3] 17 | .T[3,3] <- Tmat[i,4] 18 | } 19 | Sy <- Qmat[i,1] 20 | Sx <- Qmat[i,1]/(lonadj[i]^2) 21 | ax <- as.double(predx[i,]) 22 | ay <- as.double(predy[i,]) 23 | c(c(.T%*%ax)[1], c(.T%*%ay)[1], (.T%*%varx[,,i]%*%t(.T))[1,1] + Sx, (.T%*%vary[,,i]%*%t(.T))[1,1] + Sy) 24 | } 25 | 26 | rmvtt <- function(mu, Sigma, df=Inf, lower, upper){ 27 | p <- length(mu) 28 | out <- rep(NA,p) 29 | div <- ifelse(df==Inf, 1, sqrt(rchisq(1,df=df)/df)) 30 | truncLo <- pnorm(div*(lower[1]-mu[1])/sqrt(Sigma[1,1])) 31 | truncUp <- pnorm((div*upper[1]-mu[1])/sqrt(Sigma[1,1])) 32 | out[1] <- mu[1] + sqrt(Sigma[1,1])*(qnorm(runif(1, truncLo, truncUp))/div) 33 | if(p>1){ 34 | for(i in 2:p){ 35 | S12 <- Sigma[i,1:(i-1)] 36 | S22 <- Sigma[1:(i-1),1:(i-1)] 37 | res <- out[1:(i-1)]-mu[1:(i-1)] 38 | mu.c <- mu[i] + S12%*%solve(S22, res) 39 | S.c <- Sigma[i,i] - S12%*%solve(S22,S12) 40 | truncLo <- pnorm(div*(lower[i]-mu.c)/sqrt(S.c)) 41 | truncUp <- pnorm((div*upper[i]-mu.c)/sqrt(S.c)) 42 | out[i] <- mu.c + sqrt(S.c)*(qnorm(runif(1, truncLo, truncUp))/div) 43 | } 44 | return(out) 45 | } 46 | else return(out) 47 | } 48 | 49 | getSD <- function(x){ 50 | d <- as.numeric(sapply(strsplit(as.character(x),"e-"), function(x) x[2])) 51 | if(any(!is.na(d))) return(max(d, na.rm=TRUE)) 52 | else return(0) 53 | } 54 | 55 | check_fit <- function(mle) { 56 | checkMLE <- inherits(mle, 'try-error') 57 | checkConv <- 58 | ifelse(inherits(mle, 'try-error'), 1, mle$convergence > 0) 59 | 60 | C.tmp <- try(2 * solve(mle$hessian), silent = TRUE) 61 | if (inherits(C.tmp, "try-error")) { 62 | checkCovar <- 1 63 | checkDiag <- 1 64 | } else { 65 | checkCovar <- 0 66 | checkDiag <- ifelse(any(diag(C.tmp) <= 0), 1, 0) 67 | } 68 | return(sum(checkMLE, checkConv, checkCovar, checkDiag) > 0) 69 | } 70 | 71 | sfc_as_cols <- function(x, geometry, names = c("x","y")) { 72 | if (missing(geometry)) { 73 | geometry <- sf::st_geometry(x) 74 | } else { 75 | geometry <- rlang::eval_tidy(enquo(geometry), x) 76 | } 77 | stopifnot(inherits(x,"sf") && inherits(geometry,"sfc_POINT")) 78 | ret <- sf::st_coordinates(geometry) 79 | ret <- tibble::as_tibble(ret) 80 | stopifnot(length(names) == ncol(ret)) 81 | x <- x[ , !names(x) %in% names] 82 | ret <- setNames(ret,names) 83 | dplyr::bind_cols(x,ret) 84 | } 85 | 86 | # conf_elps <- function(x, y, V, prob=0.95){ 87 | # require(sf, quietly = TRUE) 88 | # v <- eigen(V)$vectors 89 | # lambda <- eigen(V)$values 90 | # t <- seq(0,2*pi, length=50) 91 | # m <- qchisq(prob,2) 92 | # x_l <- x + sqrt(m*lambda[1])*v[1,1]*cos(t) + sqrt(m*lambda[2])*v[1,2]*sin(t) 93 | # y_l <- y + sqrt(m*lambda[1])*v[2,1]*cos(t) + sqrt(m*lambda[2])*v[2,2]*sin(t) 94 | # ell <- cbind(x=x_l, y=y_l) 95 | # ell <- st_linestring(ell) |> st_cast("POLYGON") 96 | # return(st_sfc(list(ell))) 97 | # } 98 | 99 | -------------------------------------------------------------------------------- /R/crawl-package.R: -------------------------------------------------------------------------------- 1 | #' @title Fit Continuous-Time Correlated Random Walk Models to Animal Movement Data 2 | #' 3 | #' @description The [C]orrelated [RA]ndom [W]alk [L]ibrary (I know it is not an R library, 4 | #' but, "crawp" did not sound as good) of R functions was designed for fitting 5 | #' continuous-time correlated random walk (CTCRW) models with time indexed 6 | #' covariates. The model is fit using the Kalman-Filter on a state space 7 | #' version of the continuous-time stochastic movement process. 8 | #' 9 | #' \tabular{ll}{ 10 | #' Package: \tab crawl\cr 11 | #' Type: \tab Package\cr 12 | #' Version: \tab 2.3.1\cr 13 | #' Date: \tab October 3, 2024\cr 14 | #' License: \tab CC0 \cr 15 | #' LazyLoad: \tab yes\cr 16 | #' } 17 | #' 18 | #' @note This software package is developed and maintained by scientists at the NOAA Fisheries Alaska 19 | #' Fisheries Science Center and should be considered a fundamental research communication. 20 | #' The recommendations and conclusions presented here are those of 21 | #' the authors and this software should not be construed as official communication by NMFS, NOAA, 22 | #' or the U.S. Dept. of Commerce. In addition, reference to trade names does not imply endorsement by the 23 | #' National Marine Fisheries Service, NOAA. While the best efforts have been made to insure the 24 | #' highest quality, tools such as this are under constant development and are subject to change. 25 | #' 26 | #' @name crawl-package 27 | #' @aliases crawl-package crawl 28 | #' @author Josh London and Devin S. Johnson 29 | #' 30 | #' Maintainer: Devin S. Johnson 31 | #' @references Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 32 | #' Continuous-time correlated random walk model for animal telemetry data. 33 | #' Ecology 89(5) 1208-1215. 34 | #' @import dplyr rlang 35 | #' @importFrom Rcpp evalCpp 36 | #' @importFrom graphics layout 37 | #' @importFrom methods as slot 38 | #' @importFrom stats approx model.frame model.matrix 39 | #' na.pass optim pchisq pexp pnorm qnorm 40 | #' rchisq runif sd setNames median rnorm 41 | #' @useDynLib crawl, .registration = TRUE 42 | "_PACKAGE" 43 | 44 | 45 | if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) 46 | 47 | #' Northern fur seal pup relocation data set used in Johnson et al. (2008) 48 | #' 49 | #' 50 | #' @name northernFurSeal 51 | #' @docType data 52 | #' @format A data frame with 795 observations on the following 4 variables: 53 | #' 54 | #' \describe{ \item{GMT}{A POSIX time vector} 55 | #' 56 | #' \item{loc_class}{a factor with levels \code{3} \code{2} 57 | #' \code{1} \code{0} \code{A}.} 58 | #' 59 | #' \item{lat}{a numeric vector. Latitude for the locations} 60 | #' 61 | #' \item{long}{a numeric vector. Longitude for the locations} 62 | #' 63 | #' } 64 | #' @references Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) Continuous-time 65 | #' random walk model for animal telemetry data. Ecology 89:1208-1215. 66 | #' @source Marine Mammal Laboratory, Alaska 67 | #' Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 68 | #' Point Way NE Seattle, WA 98115 69 | #' @keywords datasets 70 | NULL 71 | 72 | #' Harbor seal location data set used in Johnson et al. (2008) 73 | #' 74 | #' 75 | #' @name harborSeal 76 | #' @docType data 77 | #' @format A data frame with 7059 observations on the following 5 variables. 78 | #' 79 | #' \describe{ \item{Time}{a numeric vector.} 80 | #' 81 | #' \item{latitude}{a numeric vector.} 82 | #' 83 | #' \item{longitude}{a numeric vector.} 84 | #' 85 | #' \item{DryTime}{a numeric vector.} 86 | #' 87 | #' \item{Argos_loc_class}{a factor with levels \code{0} \code{1} 88 | #' \code{2} \code{3} \code{A} \code{B}}.} 89 | #' @author Devin S. Johnson 90 | #' @references Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 91 | #' Continuous-time random walk model for animal telemetry data. Ecology 92 | #' 89:1208-1215. 93 | #' @source Marine Mammal Laboratory, Alaska 94 | #' Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 95 | #' Point Way NE Seattle, WA 98115 96 | #' @keywords datasets 97 | NULL 98 | 99 | #' Harbor seal location data updated since Johnson et al. (2008) 100 | #' 101 | #' The original location data used in Johnson et al. (2008) was geographic 102 | #' (latitude/longitude) (but not explicitly documented) and provided as a 103 | #' simple data frame. This data updates the data to a Simple Feature 104 | #' Collection (as part of the \href{https://r-spatial.github.io/sf/articles/}{sf} 105 | #' package) with the CRS explicitly set. 106 | #' 107 | #' @name harborSeal_sf 108 | #' @docType data 109 | #' @format A Simple Feature Collection with 7059 features and 3 fields. 110 | #' 111 | #' \describe{ 112 | #' \item{Time}{a numeric vector.} 113 | #' \item{DryTime}{a numeric vector.} 114 | #' \item{Argos_loc_class}{a factor with levels \code{0} \code{1} 115 | #' \code{2} \code{3} \code{A} \code{B}.} 116 | #' \item{geometry}{a list column with geometry data; CRS = EPSG:4326} 117 | #' } 118 | #' 119 | #' @author Josh M. London 120 | #' @references Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 121 | #' Continuous-time random walk model for animal telemetry data. Ecology 122 | #' 89:1208-1215. 123 | #' @source Marine Mammal Laboratory, Alaska 124 | #' Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 125 | #' Point Way NE Seattle, WA 98115 126 | #' @keywords data sets 127 | NULL 128 | 129 | #' Bearded Seal Location Data 130 | #' 131 | #' 132 | #' @name beardedSeals 133 | #' @docType data 134 | #' @format A data frame with 27,548 observations on 3 bearded seals in Alaska: 135 | #' 136 | #' \describe{ 137 | #' \item{deployid}{Unique animal ID} 138 | #' \item{ptt}{Hardware ID} 139 | #' \item{instr}{Hardware type} 140 | #' \item{date_time}{Time of location} 141 | #' \item{type}{Location type} 142 | #' \item{quality}{Argos location quality} 143 | #' \item{latitude}{Observed latitude} 144 | #' \item{longitude}{Observed longitude} 145 | #' \item{error_radius}{Argos error radius} 146 | #' \item{error_semimajor_axis}{Argos error ellipse major axis length} 147 | #' \item{error_semiminor_axis}{Argos error ellipse minor axis length} 148 | #' \item{error_ellipse_orientation}{Argos error ellipse degree orientation} 149 | #' } 150 | #' @source Marine Mammal Laboratory, Alaska 151 | #' Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 152 | #' Point Way NE Seattle, WA 98115 153 | #' @keywords datasets 154 | NULL 155 | 156 | 157 | 158 | 159 | .onAttach <- function(library, pkgname) 160 | { 161 | info <-utils::packageDescription(pkgname) 162 | package <- info$Package 163 | version <- info$Version 164 | date <- info$Date 165 | packageStartupMessage( 166 | paste(paste(package, version, paste("(",date, ")", sep=""), "\n"), 167 | "Demos and documentation can be found at our new GitHub repository:\n", 168 | "https://dsjohnson.github.io/crawl_examples/\n", 169 | "\n", 170 | "WARNING!!! v. 2.3.0 will be the last version of {crawl} hosted on CRAN.\n", 171 | "see 'https://github.com/NMML/crawl' for any future bug fixes." 172 | ) 173 | ) 174 | } 175 | 176 | # .onUnload <- function(libpath) 177 | # { 178 | # #library.dynam.unload("crawl", libpath) 179 | # cat("\nBye-Bye from crawl\n\n") 180 | # return(invisible()) 181 | # } 182 | 183 | #' @title fix_path function id depreciated. 184 | #' @param ... Any arguments are ignored. 185 | #' @export 186 | fix_path <- function(...){ 187 | stop("The 'fix_path()' function has been removed from {crawl}. Please use the {pathroutr} package instead: 'https://github.com/jmlondon/pathroutr'") 188 | } -------------------------------------------------------------------------------- /R/crw-methods.R: -------------------------------------------------------------------------------- 1 | #' Generic subset/bracket method for crwIS classes 2 | #' @param x crwIS object 3 | #' @param i elements to extract or replace. These are numeric or character or, 4 | #' empty or logical. Numeric values are coerced to integer as if by \code{as.integer} 5 | #' @param ... other arguments 6 | #' @param drop logical. If TRUE the result is coerced to the lowest possible 7 | #' dimension. 8 | #' @export 9 | 10 | "[.crwIS" <- function(x, i, ..., drop = TRUE) { 11 | x$alpha.sim <- x$alpha.sim[i,drop=drop] 12 | x$locType <- x$locType[i,drop=drop] 13 | x$TimeNum <- x$TimeNum[i,drop=drop] 14 | x[[attr(x, "Time.name")]] <- x[[attr(x, "Time.name")]][i,drop=drop] 15 | return(x) 16 | } 17 | -------------------------------------------------------------------------------- /R/crwN2ll.R: -------------------------------------------------------------------------------- 1 | #' -2 * log-likelihood for CTCRW models 2 | #' 3 | #' This function is designed for primary use within the \code{\link{crwMLE}} 4 | #' model fitting function. But, it can be accessed for advanced \code{R} and 5 | #' \code{crawl} users. Uses the state-space parameterization and Kalman filter 6 | #' method presented in Johnson et al. (2008). 7 | #' 8 | 9 | #' 10 | #' This function calls compiled C++ code which can be viewed in the 11 | #' \code{src} directory of the crawl source package. 12 | #' 13 | #' @param theta parameter values. 14 | #' @param fixPar values of parameters held fixed (contains \code{NA} for 15 | #' \code{theta} values). 16 | #' @param y N by 2 matrix of coordinates with the longitude coordinate in the first column. 17 | #' @param noObs vector with 1 for unobserved locations, and 0 for observed locations. 18 | #' @param delta time difference to next location. 19 | #' @param mov.mf Movement covariate data. 20 | #' @param err.mfX longitude error covariate data. 21 | #' @param err.mfY latitude error covariate data. 22 | #' @param rho A vector of known correlation coefficients for the error model, typically used for modern ARGOS data. 23 | #' @param activity Stopping covariate (= 0 if animal is not moving). 24 | #' @param n.errX number or longitude error parameters. 25 | #' @param n.errY number of latitude error parameters. 26 | #' @param n.mov number or movement parameters. 27 | #' @param driftMod Logical. indicates whether a drift model is specified. 28 | #' @param prior Function of theta that returns the log-density of the prior 29 | #' @param need.hess Whether or not the Hessian will need to be calculated from 30 | #' this call 31 | #' @param constr Named list giving the parameter constraints 32 | #' @return -2 * log-likelihood value for specified CTCRW model. 33 | #' @author Devin S. Johnson 34 | #' @seealso \code{\link{crwMLE}} 35 | #' @references Johnson, D., J. London, M. -A. Lea, and J. Durban. 2008. 36 | #' Continuous-time model for animal telemetry data. Ecology 89:1208-1215. 37 | #' @export 38 | 39 | crwN2ll = function(theta, fixPar, y, noObs, delta, #a, P, 40 | mov.mf, err.mfX, err.mfY, rho=NULL, activity=NULL, 41 | n.errX, n.errY, n.mov, driftMod, prior, need.hess, 42 | constr=list(lower=-Inf, upper=Inf)) 43 | { 44 | if(!need.hess & any(theta < constr$lower | theta > constr$upper)) return(Inf) 45 | N <- nrow(y) 46 | par <- fixPar 47 | par[is.na(fixPar)] <- theta 48 | y <- as.matrix(y) 49 | argslist = par2arglist(theta, fixPar, y, noObs, delta, 50 | mov.mf, err.mfX, err.mfY, rho=NULL, activity=NULL, 51 | n.errX, n.errY, n.mov, driftMod) 52 | 53 | if (driftMod) { 54 | ll <- CTCRWNLL_DRIFT(as.matrix(y), argslist$Hmat, argslist$b, argslist$b.drift, 55 | argslist$sig2, argslist$sig2.drift, delta, noObs, argslist$active, argslist$a, argslist$P)$ll 56 | } else { 57 | ll <- CTCRWNLL(as.matrix(y), argslist$Hmat, argslist$b, argslist$sig2, delta, noObs, argslist$active, argslist$a, argslist$P)$ll 58 | } 59 | 60 | if(is.null(prior)){ 61 | ll = -2 * ll 62 | } else { 63 | ll = -2 * (ll + prior(theta)) 64 | } 65 | return(ll) 66 | } 67 | -------------------------------------------------------------------------------- /R/crwPostIS.R: -------------------------------------------------------------------------------- 1 | #' Simulate a value from the posterior distribution of a CTCRW model 2 | #' 3 | 4 | #' 5 | #' The crwPostIS draws a set of states from the posterior distribution of a 6 | #' fitted CTCRW model. The draw is either conditioned on the fitted parameter 7 | #' values or "full" posterior draw with approximated parameter posterior 8 | #' 9 | 10 | #' 11 | #' The crwPostIS draws a posterior sample of the track state matrices. If 12 | #' fullPost was set to TRUE when the object.sim was build in 13 | #' \link{crwSimulator} then a pseudo-posterior draw will be made by first 14 | #' sampling a parameter value from a multivariate t distribution which 15 | #' approximates the marginal posterior distribution of the parameters. The 16 | #' covariance matrix from the fitted model object is used to scale the MVt 17 | #' approximation. In addition, the factor "scale" can be used to further adjust 18 | #' the approximation. Further, the parameter simulations are centered on the 19 | #' fitted values. 20 | #' 21 | #' To correct for the MVt approximation, the importance sampling weight is also 22 | #' supplied. When calculating averages of track functions for Bayes estimates 23 | #' one should use the importance sampling weights to calculate a weighted 24 | #' average (normalizing first, so the weights sum to 1). 25 | #' 26 | #' @param object.sim A crwSimulator object from \code{\link{crwSimulator}}. 27 | #' @param fullPost logical. Draw parameter values as well to simulate full 28 | #' posterior 29 | #' @param df degrees of freedom for multivariate t distribution approximation 30 | #' to parameter posterior 31 | #' @param scale Extra scaling factor for t distribution approximation 32 | #' @param thetaSamp If multiple parameter samples are available in object.sim, 33 | #' setting \code{thetaSamp=n} will use the nth sample. Defaults to the last. 34 | #' @return 35 | #' 36 | #' List with the following elements: 37 | #' 38 | #' \item{alpha.sim.y}{A matrix a simulated latitude state values} 39 | #' 40 | #' \item{alpha.sim.x}{Matrix of simulated longitude state values} 41 | #' 42 | #' \item{locType}{Indicates prediction types with a "p" or observation times 43 | #' with an "o"} \item{Time}{Initial state covariance for latitude} 44 | #' 45 | #' \item{loglik}{log likelihood of simulated parameter} 46 | #' 47 | #' \item{par}{Simulated parameter value} 48 | #' 49 | #' \item{log.isw}{non normalized log importance sampling weight} 50 | #' @author Devin S. Johnson 51 | #' @seealso See \code{demo(northernFurSealDemo)} for example. 52 | #' @export 53 | 54 | crwPostIS = function(object.sim, fullPost=TRUE, df=Inf, scale=1, thetaSamp=NULL) 55 | ################################################################################ 56 | ################################################################################ 57 | { 58 | if(!inherits(object.sim, 'crwSimulator')) stop("Argument needs to be of class 'crwSimulator'\nUse 'crwSimulator( )' to create") 59 | fixPar <- object.sim$fixPar 60 | Cmat <- object.sim$Cmat[is.na(fixPar),is.na(fixPar)] 61 | se <- sqrt(diag(Cmat)) 62 | err.mfX <- object.sim$err.mfX 63 | err.mfY <- object.sim$err.mfY 64 | par <- object.sim$par 65 | n2ll.mode <- -2*object.sim$loglik 66 | activity <- object.sim$activity 67 | driftMod <- object.sim$driftMod 68 | mov.mf <- object.sim$mov.mf 69 | y <- object.sim$y 70 | noObs = object.sim$noObs 71 | delta <- object.sim$delta 72 | n.errX <- object.sim$n.errX 73 | n.errY <- object.sim$n.errY 74 | rho = object.sim$rho 75 | n.mov <- object.sim$n.mov 76 | N <- object.sim$N 77 | lower <- object.sim$lower 78 | upper <- object.sim$upper 79 | prior <- object.sim$prior 80 | eInd <- is.na(fixPar) 81 | ts = object.sim$time.scale 82 | ### 83 | ### Sample parameter vector 84 | ### 85 | if(fullPost){ 86 | if(is.null(object.sim$thetaSampList)){ 87 | eps <- rmvtt(mu=rep(0,sum(eInd)), Sigma=scale*Cmat, df=df, lower-par[eInd], upper-par[eInd]) 88 | par[eInd] <- par[eInd] + eps 89 | if(df==Inf) dens <- dmvnorm(eps, sigma=scale*Cmat, log=TRUE) - dmvnorm(0.0*eps, sigma=scale*Cmat, log=TRUE) 90 | else dens <- dmvt(eps, sigma=scale*Cmat, df=df, log=TRUE) - dmvt(0.0*eps, sigma=scale*Cmat, df=df, log=TRUE) 91 | } else{ 92 | if(is.null(thetaSamp)) thetaSamp <- length(object.sim$thetaSampList) 93 | parRow <- sample(1:nrow(object.sim$thetaSampList[[thetaSamp]]), 1, prob=object.sim$thetaSampList[[thetaSamp]][,1]) 94 | par <- as.vector(object.sim$thetaSampList[[thetaSamp]][parRow,-c(1:3)]) 95 | } 96 | } 97 | 98 | ### 99 | ### Process parameters for C++ 100 | ### 101 | theta = object.sim$par[is.na(object.sim$fixPar)] 102 | argslist = par2arglist(theta, fixPar, y, noObs, delta, 103 | mov.mf, err.mfX, err.mfY, rho, activity, 104 | n.errX, n.errY, n.mov, driftMod) 105 | 106 | if (driftMod) { 107 | out=CTCRWSAMPLE_DRIFT(y, argslist$Hmat, argslist$b, argslist$b.drift, argslist$sig2, 108 | argslist$sig2.drift, delta, noObs, argslist$active, argslist$a, argslist$P) 109 | } else { 110 | out=CTCRWSAMPLE(y, argslist$Hmat, argslist$b, argslist$sig2, delta, noObs, argslist$active, argslist$a, argslist$P) 111 | } 112 | 113 | if(driftMod){ 114 | colnames(out$sim) <- apply(expand.grid(c("mu","theta","gamma"), c("x","y")), 1, paste, collapse=".") 115 | } else { 116 | colnames(out$sim) <- apply(expand.grid(c("mu","nu"), c("x","y")), 1, paste, collapse=".") 117 | } 118 | ln.prior = ifelse(!is.null(object.sim$prior), object.sim$prior(par[eInd]), 0) 119 | isw <- ifelse(is.null(object.sim$thetaSampList) & fullPost==TRUE, out$ll - object.sim$loglik - dens, 0) + ln.prior 120 | samp <- list(alpha.sim=out$sim, 121 | locType=object.sim$locType, TimeNum=object.sim$TimeNum, 122 | loglik=out$lly+out$llx, par=par, log.isw = isw) 123 | samp[[object.sim$Time.name]] = object.sim$TimeNum*ts 124 | if(object.sim$return_posix) samp[[object.sim$Time.name]] = lubridate::as_datetime(samp[[object.sim$Time.name]]) 125 | class(samp) <- c("crwIS","list") 126 | attr(samp, "Time.name") = object.sim$Time.name 127 | attr(samp, "time.scale") = object.sim$time.scale 128 | attr(samp,"coord") <- object.sim$coord 129 | attr(samp,"random.drift") <- object.sim$driftMod 130 | attr(samp,"activity.model") <- !is.null(object.sim$activity) 131 | attr(samp,"epsg") <- attr(object.sim,"epsg") 132 | attr(samp,"proj4") <- attr(object.sim,"proj4") 133 | return(samp) 134 | } 135 | 136 | -------------------------------------------------------------------------------- /R/crwPredict.R: -------------------------------------------------------------------------------- 1 | #' Predict animal locations and velocities using a fitted CTCRW model and 2 | #' calculate measurement error fit statistics 3 | #' 4 | 5 | #' 6 | #' The \code{crwMEfilter} function uses a fitted model object from 7 | #' \code{crwMLE} to predict animal locations (with estimated uncertainty) at 8 | #' times in the original data set and supplemented by times in \code{predTime}. 9 | #' If \code{speedEst} is set to \code{TRUE}, then animal log-speed is also 10 | #' estimated. In addition, the measurement error shock detection filter of de 11 | #' Jong and Penzer (1998) is also calculated to provide a measure for outlier 12 | #' detection. 13 | #' 14 | 15 | #' 16 | #' The requirements for \code{data} are the same as those for fitting the model 17 | #' in \code{\link{crwMLE}}. 18 | #' 19 | #' @param object.crwFit A model object from \code{\link{crwMLE}}. 20 | #' @param predTime vector of desired prediction times (numeric or POSIXct). Alternatively, a character vector specifying a time interval (see Details). 21 | #' @param return.type character. Should be one of \code{"minimal","flat","list"} (see Details). 22 | #' @param ... Additional arguments for testing new features 23 | #' 24 | #' @details \code{predTime} can be either passed as a separate vector of POSIXct or 25 | #' numeric values for all prediction times expected in the returned object. 26 | #' Note, previous versions of \code{crwPredict} would return both times 27 | #' specified via \code{predTime} as well as each original observed time. This is 28 | #' no longer the default (see \code{return.type}). If the original data were 29 | #' provided as a POSIXct type, then \code{crwPredict} can derive a sequence of 30 | #' regularly spaced prediction times from the original data. This is specified 31 | #' by providing a character string that corresponds to the \code{by} argument 32 | #' of the \code{seq.POSIXt} function (e.g. '1 hour', '30 mins'). 33 | #' \code{crwPredict} will round the first observed time up to the nearest unit 34 | #' (e.g. '1 hour' will round up to the nearest hour, '30 mins' will round up to 35 | #' the nearest minute) and start the sequence from there. The last observation 36 | #' time is truncated down to the nearest unit to specify the end time. 37 | #' 38 | #' @return 39 | #' 40 | #' There are three possible return types specified with \code{return.type}: 41 | #' 42 | #' \item{minimal}{a data.frame with a minimal set of columns: 43 | #' \code{date_time,mu.x,mu.y,se.mu.x,se.mu.y}} 44 | #' 45 | #' \item{flat}{a data set is returned with the 46 | #' columns of the original data plus the state estimates, standard errors (se), 47 | #' and speed estimates} 48 | #' 49 | #' \item{list}{List with the following elements:} 50 | #' 51 | #' \item{originalData}{A data.frame with \code{data} merged with 52 | #' \code{predTime}.} 53 | #' 54 | #' \item{alpha.hat}{Predicted state} 55 | #' 56 | #' \item{Var.hat}{array where \code{Var.hat[,,i]} is the prediction 57 | #' covariance matrix for \code{alpha.hat[,i]}.} 58 | #' 59 | #' 60 | #' @author Devin S. Johnson 61 | #' @references de Jong, P. and Penzer, J. (1998) Diagnosing shocks in time 62 | #' series. Journal of the American Statistical Association 93:796-806. 63 | #' @export 64 | 65 | crwPredict=function(object.crwFit, predTime=NULL, return.type="minimal", ...) 66 | { 67 | if(inherits(object.crwFit, "error")) stop("Model was not fit correctly, please revisit fitting stage!") 68 | data <- as.data.frame(object.crwFit$data) 69 | tn <- object.crwFit$Time.name 70 | driftMod <- object.crwFit$random.drift 71 | mov.mf <- object.crwFit$mov.mf 72 | activity <- object.crwFit$activity 73 | err.mfX <- object.crwFit$err.mfX 74 | err.mfY <- object.crwFit$err.mfY 75 | rho = object.crwFit$rho 76 | par <- object.crwFit$par 77 | n.errX <- object.crwFit$n.errX 78 | n.errY <- object.crwFit$n.errY 79 | n.mov <- object.crwFit$n.mov 80 | fixPar = object.crwFit$fixPar 81 | theta = object.crwFit$par[is.na(fixPar)] 82 | 83 | 84 | ## the typical expectation is for tn to be POSIXct. But, some users may decide 85 | ## to pass a numeric time vector. Here, we'll confirm numeric or POSIXct and 86 | ## set return_posix to TRUE unless the submitted values are numeric. In the 87 | ## case where the data values are one and the predTime values are another, we 88 | ## will convert to POSIXct and return POSIXct 89 | ## 90 | return_posix <- ifelse((inherits(predTime,"POSIXct") | inherits(predTime, "character")) & 91 | inherits(data[,tn],"POSIXct"), 92 | TRUE, FALSE) 93 | if(!return_posix) { 94 | # if(inherits(predTime,"numeric") && inherits(data[, tn],"numeric")) { 95 | # warning("numeric time values detected. numeric values will be returned.") 96 | # } 97 | if(inherits(predTime,"numeric") && inherits(data[, tn], "POSIXct")) { 98 | # warning("predTime provided as numeric. converting it to POSIXct.") 99 | stop("predTime provided as numeric and original time data was POSIX!") 100 | # predTime <- lubridate::as_datetime(predTime) 101 | } 102 | if(inherits(predTime,"POSIXct") && inherits(data[, tn], "numeric")) { 103 | # warning("input data time column provided as numeric. converting to POSIXct") 104 | stop("predTime provided as POSIX and original data was numeric!") 105 | # data[, tn] <- lubridate::as_datetime(data[, tn]) 106 | } 107 | } 108 | 109 | if(!is.null(predTime)){ 110 | 111 | if(inherits(predTime,"character")) { 112 | if(!inherits(data[,tn],"POSIXct")) stop("Character specification of predTime can only be used with POSIX times in the original data!") 113 | t_int <- unlist(strsplit(predTime, " ")) 114 | if(t_int[2] %in% c("sec","secs","min","mins","hour","hours","day","days")) { 115 | min_dt <- min(data[,tn],na.rm=TRUE) 116 | max_dt <- max(data[,tn],na.rm=TRUE) 117 | min_dt <- lubridate::ceiling_date(min_dt,t_int[2]) 118 | max_dt <- lubridate::floor_date(max_dt,t_int[2]) 119 | predTime <- seq(min_dt, max_dt, by = predTime) 120 | } else { 121 | stop("predTime not specified correctly. see documentation for seq.POSIXt") 122 | } 123 | } 124 | 125 | if(inherits(predTime, "POSIXct")){ 126 | ts = attr(object.crwFit, "time.scale") 127 | predTime = as.numeric(predTime)/ts 128 | } 129 | 130 | ## Data setup ## 131 | if(min(predTime) < min(data$TimeNum)) { 132 | warning("Predictions times given before first observation!\nOnly those after first observation will be used.") 133 | predTime <- predTime[predTime>=min(data$TimeNum)] 134 | } 135 | origTime <- data$TimeNum 136 | if (is.null(data$locType)) { 137 | data$locType <- "o" 138 | } 139 | predData <- data.frame(predTime, "p") 140 | names(predData) <- c("TimeNum", "locType") 141 | # predTime <- as.numeric(predTime) 142 | data <- merge(data, predData, 143 | by=c("TimeNum", "locType"), all=TRUE) 144 | dups <- duplicated(data$TimeNum) #& data[,"locType"]==1 145 | data <- data[!dups, ] 146 | mov.mf <- as.matrix(expandPred(x=mov.mf, Time=origTime, predTime=predTime)) 147 | if (!is.null(activity)) activity <- as.matrix(expandPred(x=activity, Time=origTime, predTime=predTime)) 148 | if (!is.null(err.mfX)) err.mfX <- as.matrix(expandPred(x=err.mfX, Time=origTime, predTime=predTime)) 149 | if (!is.null(err.mfY)) err.mfY <- as.matrix(expandPred(x=err.mfY, Time=origTime, predTime=predTime)) 150 | if (!is.null(rho)) rho <- as.matrix(expandPred(x=rho, Time=origTime, predTime=predTime)) 151 | data$locType[data$TimeNum%in%predTime] <- 'p' 152 | } else{ 153 | data$locType <- "o" 154 | } 155 | 156 | delta <- c(diff(data$TimeNum), 1) 157 | y = as.matrix(data[,object.crwFit$coord]) 158 | noObs <- as.numeric(is.na(y[,1]) | is.na(y[,2])) 159 | y[noObs==1,] = 0 160 | N = nrow(y) 161 | 162 | ### 163 | ### Process parameters for C++ 164 | ### 165 | argslist = par2arglist(theta, fixPar, y, noObs, delta, 166 | mov.mf, err.mfX, err.mfY, rho, activity, 167 | n.errX, n.errY, n.mov, driftMod) 168 | if (driftMod) { 169 | out = CTCRWPREDICT_DRIFT(y, argslist$Hmat, argslist$b, argslist$b.drift, argslist$sig2, 170 | argslist$sig2.drift, delta, noObs, argslist$active, argslist$a, argslist$P) 171 | } else { 172 | out=CTCRWPREDICT(y, argslist$Hmat, argslist$b, argslist$sig2, delta, noObs, argslist$active, argslist$a, argslist$P) 173 | } 174 | 175 | pred <- data.frame(t(out$pred)) 176 | if (driftMod) { 177 | names(pred) <- c("mu.x", "theta.x", "gamma.x","mu.y", "theta.y", "gamma.y") 178 | } else names(pred) <- c("mu.x", "nu.x", "mu.y","nu.y") 179 | var <- zapsmall(out$predVar) 180 | 181 | speed = sqrt(apply(as.matrix(pred[,2:(2+driftMod)]), 1, sum)^2 + 182 | apply(as.matrix(pred[,(4+driftMod):(4+2*driftMod)]), 1, sum)^2) 183 | 184 | obsFit <- data.frame(predObs.x=out$predObs[1,], 185 | predObs.y=out$predObs[2,]) 186 | obsFit$outlier.chisq <- as.vector(out$chisq) 187 | obsFit$naive.p.val <- 1 - pchisq(obsFit$outlier.chisq, 2) 188 | 189 | out <- list(originalData=fillCols(data), alpha.hat=pred, 190 | V.hat=var, speed=speed, loglik=out$ll) 191 | if(return_posix){ 192 | out$originalData[,tn] = lubridate::as_datetime(out$originalData$TimeNum*ts) 193 | } else out$originalData[,tn] = out$originalData$TimeNum 194 | 195 | # if(getUseAvail){ 196 | # idx <- data$locType=="p" 197 | # movMatsPred <- getQT(sig2[idx], b[idx], sig2.drift[idx], b.drift[idx], delta=c(diff(data[idx,tn]),1), driftMod) 198 | # TmatP <- movMatsPred$Tmat 199 | # QmatP <- movMatsPred$Qmat 200 | # avail <- t(sapply(1:(nrow(TmatP)-1), makeAvail, Tmat=TmatP, Qmat=QmatP, predx=predx[idx,], predy=predy[idx,], 201 | # vary=vary[,,idx], varx=varx[,,idx], driftMod=driftMod, lonadj=lonAdjVals[idx])) 202 | # avail <- cbind(data[idx,tn][-1], avail) 203 | # colnames(avail) <- c(tn, "meanAvail.x", "meanAvail.y", "varAvail.x", "varAvail.y") 204 | # use <- cbind(data[idx,tn], predx[idx,1], predy[idx,1], varx[1,1,idx], vary[1,1,idx])[-1,] 205 | # colnames(use) <- c(tn, "meanUse.x", "meanUse.y", "varUse.x", "varUse.y") 206 | # UseAvail.lst <- list(use=use, avail=avail) 207 | # } 208 | # else UseAvail.lst=NULL 209 | 210 | if (return.type == "flat") { 211 | out <- fillCols(crawl::flatten(out)) 212 | attr(out, "flat") <- TRUE 213 | attr(out, "coord") <- c(x=object.crwFit$coord[1], y=object.crwFit$coord[2]) 214 | attr(out, "random.drift") <- driftMod 215 | attr(out, "activity.model") <- !is.null(object.crwFit$activity) 216 | attr(out, "Time.name") <- tn 217 | attr(out, "time.scale") = ts 218 | attr(out,"epsg") <- attr(object.crwFit,"epsg") 219 | attr(out,"proj4") <- attr(object.crwFit,"proj4") 220 | } else if (return.type == "list") { 221 | out <- append(out, list(fit.test=obsFit)) 222 | attr(out, "flat") <- FALSE 223 | attr(out, "coord") <- c(x=object.crwFit$coord[1], y=object.crwFit$coord[2]) 224 | attr(out, "random.drift") <- driftMod 225 | attr(out, "activity.model") <- !is.null(object.crwFit$activity) 226 | attr(out, "Time.name") <- tn 227 | attr(out, "time.scale") = ts 228 | attr(out,"epsg") <- attr(object.crwFit,"epsg") 229 | attr(out,"proj4") <- attr(object.crwFit,"proj4") 230 | } else if (return.type == "minimal") { 231 | out <- fillCols(out$originalData) 232 | out <- cbind(out, pred) 233 | attr(out, "flat") <- TRUE 234 | attr(out, "coord") <- c(x=object.crwFit$coord[1], y=object.crwFit$coord[2]) 235 | attr(out, "random.drift") <- driftMod 236 | attr(out, "activity.model") <- !is.null(object.crwFit$activity) 237 | attr(out, "Time.name") <- tn 238 | attr(out, "time.scale") = ts 239 | attr(out,"epsg") <- attr(object.crwFit,"epsg") 240 | attr(out,"proj4") <- attr(object.crwFit,"proj4") 241 | } 242 | class(out) <- c(class(out),"crwPredict") 243 | return(out) 244 | } 245 | -------------------------------------------------------------------------------- /R/crwPredictPlot.R: -------------------------------------------------------------------------------- 1 | #' Plot CRW predicted object 2 | #' 3 | 4 | #' 5 | #' Creates 2 types of plots of a crwPredict object: a plot of both coordinate 6 | #' axes with prediction intervals and a plot of just observed locations and 7 | #' predicted locations. 8 | #' 9 | #' 10 | #' @param object \code{crwPredict} object. 11 | #' @param plotType type of plot has to be one of the following: \dQuote{map} or 12 | #' \dQuote{ll} (default). 13 | #' @param ... Further arguments passed to plotting commands. 14 | #' @return A plot. 15 | #' @author Devin S. Johnson and Sebastian Luque 16 | #' @seealso See \code{demo(northernFurSealDemo)} for additional examples. 17 | #' @importFrom graphics lines plot 18 | #' @export 19 | "crwPredictPlot" <- function(object, plotType="ll",...) 20 | { 21 | y.c <- attr(object, "coord")['y'] 22 | x.c <- attr(object, "coord")['x'] 23 | if (!attr(object, "flat")) { 24 | mu.xUp <- object$alpha.hat.x[, 1] + 1.96 * sqrt(object$V.hat.x[1, 1, ]) 25 | mu.xLo <- object$alpha.hat.x[, 1] - 1.96 * sqrt(object$V.hat.x[1, 1, ]) 26 | mu.yUp <- object$alpha.hat.y[, 1] + 1.96 * sqrt(object$V.hat.y[1, 1, ]) 27 | mu.yLo <- object$alpha.hat.y[, 1] - 1.96 * sqrt(object$V.hat.y[1, 1, ]) 28 | xvals <- object$originalData[, x.c] 29 | yvals <- object$originalData[, y.c] 30 | mu.x <- object$alpha.hat.x[, 1] 31 | mu.y <- object$alpha.hat.y[, 1] 32 | Time <- object$originalData[, attr(object, "Time.name")] 33 | } else { 34 | mu.xUp <- object$mu.x + 1.96 * object$se.mu.x 35 | mu.xLo <- object$mu.x - 1.96 * object$se.mu.x 36 | mu.yUp <- object$mu.y + 1.96 * object$se.mu.y 37 | mu.yLo <- object$mu.y - 1.96 * object$se.mu.y 38 | xvals <- object[, x.c] 39 | yvals <- object[, y.c] 40 | mu.x <- object$mu.x 41 | mu.y <- object$mu.y 42 | Time <- object[, attr(object, "Time.name")] 43 | } 44 | 45 | mu.y.mx <- max(pmax(mu.yUp, yvals, na.rm=TRUE)) 46 | mu.y.mn <- min(pmin(mu.yLo, yvals, na.rm=TRUE)) 47 | mu.x.mx <- max(pmax(mu.xUp, xvals, na.rm=TRUE)) 48 | mu.x.mn <- min(pmin(mu.xLo, xvals, na.rm=TRUE)) 49 | y.ylims <- c(mu.y.mn, mu.y.mx) 50 | x.ylims <- c(mu.x.mn, mu.x.mx) 51 | 52 | switch(plotType, 53 | map = { 54 | plot(xvals, yvals, pch=16, col="blue",xlim=x.ylims, ylim=y.ylims, cex=0.5,...) 55 | lines(mu.x, mu.y, col="red")}, 56 | ll = {layout(matrix(1:2, ncol=1)) 57 | plot(Time, xvals, pch=16, col="blue", xlab="time", ylab=x.c, 58 | ylim=x.ylims, cex=0.5,...) 59 | lines(Time, mu.x, col="red") 60 | lines(Time, mu.xUp, col="green", pch=16, cex=0.2) 61 | lines(Time, mu.xLo, col="green", pch=16, cex=0.2) 62 | plot(Time, yvals, pch=16, col="blue", xlab="time", ylab=y.c, 63 | ylim=y.ylims, cex=0.5,...) 64 | lines(Time, mu.y, col="red") 65 | lines(Time, mu.yUp, col="green", pch=16, cex=0.2) 66 | lines(Time,mu.yLo, col='green', pch=16, cex=0.2)}) 67 | } -------------------------------------------------------------------------------- /R/crwSamplePar.R: -------------------------------------------------------------------------------- 1 | #' Create a weighted importance sample for posterior predictive track 2 | #' simulation. 3 | #' 4 | 5 | #' 6 | #' The \code{crwSamplePar} function uses a fitted model object from 7 | #' \code{crwMLE} and a set of prediction times to construct a list from which 8 | #' \code{\link{crwPostIS}} will draw a sample from either the posterior 9 | #' distribution of the state vectors conditional on fitted parameters or a full 10 | #' posterior draw from an importance sample of the parameters. 11 | #' 12 | 13 | #' 14 | #' The crwSamplePar function uses the information in a 15 | #' \code{\link{crwSimulator}} object to create a set of weights for importance 16 | #' sample-resampling of parameters in a full posterior sample of parameters and 17 | #' locations using \code{\link{crwPostIS}}. This function is usually called 18 | #' from \code{\link{crwPostIS}}. The average user should have no need to call 19 | #' this function directly. 20 | #' 21 | #' @param object.sim A simulation object from \code{\link{crwSimulator}}. 22 | #' @param method Method for obtaining weights for movement parameter samples 23 | #' @param size Size of the parameter importance sample 24 | #' @param df Degrees of freedom for the t approximation to the parameter 25 | #' posterior 26 | #' @param grid.eps Grid size for \code{method="quadrature"} 27 | #' @param crit Criterion for deciding "significance" of quadrature points 28 | #' (difference in log-likelihood) 29 | #' @param scale Scale multiplier for the covariance matrix of the t 30 | #' approximation 31 | #' @param quad.ask Logical, for method='quadrature'. Whether or not the sampler 32 | #' should ask if quadrature sampling should take place. It is used to stop the 33 | #' sampling if the number of likelihood evaluations would be extreme. 34 | #' @param force.quad A logical indicating whether or not to force the execution 35 | #' of the quadrature method for large parameter vectors. 36 | #' @return 37 | #' 38 | #' List with the following elements: 39 | #' 40 | #' \item{x}{Longitude coordinate with NA at prediction times} 41 | #' 42 | #' \item{y}{Similar to above for latitude} 43 | #' 44 | #' \item{locType}{Indicates prediction types with a "p" or observation times 45 | #' with an "o"} \item{P1.y}{Initial state covariance for latitude} 46 | #' 47 | #' \item{P1.x}{Initial state covariance for longitude} 48 | #' 49 | #' \item{a1.y}{Initial latitude state} 50 | #' 51 | #' \item{a1.x}{Initial longitude state} 52 | #' 53 | #' \item{n.errX}{number of longitude error model parameters} 54 | #' 55 | #' \item{n.errY}{number of latitude error model parameters} 56 | #' 57 | #' \item{delta}{vector of time differences} 58 | #' 59 | #' \item{driftMod}{Logical. indicates random drift model} 60 | #' 61 | #' \item{stopMod}{Logical. Indicated stop model fitted} 62 | #' 63 | #' \item{stop.mf}{stop model design matrix} 64 | #' 65 | #' \item{err.mfX}{Longitude error model design matrix} 66 | #' 67 | #' \item{err.mfY}{Latitude error model design matrix} 68 | #' 69 | #' \item{mov.mf}{Movement model design matrix} 70 | #' 71 | #' \item{fixPar}{Fixed values for parameters in model fitting} 72 | #' 73 | #' \item{Cmat}{Covariance matrix for parameter sampling distribution} 74 | #' 75 | #' \item{Lmat}{Cholesky decomposition of Cmat} 76 | #' 77 | #' \item{par}{fitted parameter values} 78 | #' 79 | #' \item{N}{Total number of locations} 80 | #' 81 | #' \item{loglik}{log likelihood of the fitted model} 82 | #' 83 | #' \item{Time}{vector of observation times} 84 | #' 85 | #' \item{coord}{names of coordinate vectors in original data} 86 | #' 87 | #' \item{Time.name}{Name of the observation times vector in the original data} 88 | #' 89 | #' \item{thetaSampList}{A list containing a data frame of parameter vectors and 90 | #' their associated probabilities for a resample} 91 | #' @author Devin S. Johnson 92 | #' @seealso See \code{demo(northernFurSealDemo)} for example. 93 | #' @export 94 | #' @import mvtnorm 95 | crwSamplePar <- function(object.sim, method="IS", size=1000, df=Inf, grid.eps=1, crit=2.5, scale=1, quad.ask = T, force.quad) 96 | { 97 | if(!inherits(object.sim, 'crwSimulator')) 98 | stop("Argument needs to be of class 'crwSimulator'\nUse 'crwSimulator( )' to create") 99 | fixPar <- object.sim$fixPar 100 | Cmat <- as.matrix(object.sim$Cmat[is.na(fixPar),is.na(fixPar)]) 101 | se <- sqrt(diag(Cmat)) 102 | err.mfX <- object.sim$err.mfX 103 | err.mfY <- object.sim$err.mfY 104 | parMLE <- object.sim$par 105 | n2ll.mode <- -2*object.sim$loglik 106 | activity <- object.sim$activity 107 | driftMod <- object.sim$driftMod 108 | mov.mf <- object.sim$mov.mf 109 | y <- object.sim$y 110 | noObs <- object.sim$noObs 111 | delta <- object.sim$delta 112 | n.errX <- object.sim$n.errX 113 | n.errY <- object.sim$n.errY 114 | rho = object.sim$rho 115 | n.mov <- object.sim$n.mov 116 | N <- object.sim$N 117 | lower <- object.sim$lower 118 | upper <- object.sim$upper 119 | prior <- object.sim$prior 120 | if(missing(force.quad)) force.quad=FALSE 121 | message("Computing importance weights ...") 122 | if(method=="IS"){ 123 | thetaMat <- matrix(NA, size, length(fixPar)+3) 124 | for(i in 1:(size-1)){ 125 | par <- parMLE 126 | eInd <- is.na(fixPar) 127 | eps <- rmvtt(mu=rep(0,sum(eInd)), Sigma=scale*Cmat, df=df, lower-par[eInd], upper-par[eInd]) 128 | par[eInd] <- parMLE[eInd] + eps 129 | if(df==Inf) dens <- dmvnorm(eps, sigma=scale*Cmat, log=TRUE) - dmvnorm(0.0*eps, sigma=scale*Cmat, log=TRUE) 130 | else dens <- dmvt(eps, sigma=scale*Cmat, df=df, log=TRUE) - dmvt(0.0*eps, sigma=scale*Cmat, df=df, log=TRUE) 131 | ln.prior = ifelse(!is.null(prior), prior(par[eInd]), 0) 132 | n2ll.val <- crwN2ll(par[eInd], fixPar, y, noObs, delta, 133 | mov.mf, err.mfX, err.mfY, rho=rho, activity=activity, 134 | n.errX, n.errY, n.mov, driftMod, prior, need.hess=FALSE, 135 | constr=list(lower=lower, upper=upper)) + ln.prior 136 | thetaMat[i,] <- c(-n2ll.val/2 - dens, -n2ll.val/2, dens, par) 137 | } 138 | thetaMat[size,] <- c(object.sim$loglik, object.sim$loglik, 0, object.sim$par) 139 | thetaMat[,1] <- exp(thetaMat[,1]-max(thetaMat[,1]))/sum(exp(thetaMat[,1]-max(thetaMat[,1]))) 140 | } 141 | else if(method=="mcmc"){ 142 | 143 | } 144 | else if(method=="quadrature"){ 145 | npar=n.mov+n.errX+n.errY 146 | if(!force.quad & npar>6) stop( 147 | "Using method 'quadrature' when there are >6 parameters is not advised!\nIf you would still like to use it, add 'force.quad=TRUE' to the function arguments." 148 | ) 149 | Eigen.list <- eigen(Cmat, symmetric=TRUE) 150 | V <- Eigen.list$vectors 151 | D <- diag(sqrt(Eigen.list$values)) 152 | np <- sum(is.na(fixPar)) 153 | grid.list <- rep(list(0), np) 154 | eInd <- is.na(fixPar) 155 | thetaMat <- matrix(c(-n2ll.mode/2, -n2ll.mode/2, 0, parMLE), nrow=1) 156 | for(k in 1:np){ 157 | stop.grid <- TRUE 158 | z <- rep(0,np) 159 | while(stop.grid){ 160 | z[k] <- z[k] + grid.eps 161 | par <- parMLE 162 | par[eInd] <- parMLE[eInd] + V%*%D%*%z 163 | if(any(par[eInd]>upper) | any(par[eInd] crit) stop.grid <- FALSE 170 | else{ 171 | grid.list[[k]] <- c(grid.list[[k]],z[k]) 172 | thetaMat <- rbind(thetaMat, c(-n2ll.val/2, -n2ll.val/2, 0, par)) 173 | } 174 | } 175 | } 176 | stop.grid <- TRUE 177 | z <- rep(0,np) 178 | while(stop.grid){ 179 | z[k] <- z[k] - grid.eps 180 | par <- parMLE 181 | par[eInd] <- parMLE[eInd] + V%*%D%*%z 182 | if(any(par[eInd]>upper) | any(par[eInd] crit) stop.grid <- FALSE 189 | else{ 190 | grid.list[[k]] <- c(grid.list[[k]],z[k]) 191 | thetaMat <- rbind(thetaMat, c(-n2ll.val/2, -n2ll.val/2, 0, par)) 192 | } 193 | } 194 | } 195 | } 196 | grid.pts <- as.matrix(expand.grid(grid.list)) 197 | grid.pts <- grid.pts[apply(grid.pts==0, 1, sum) < np-1, ] 198 | numEvals <- nrow(grid.pts)+nrow(thetaMat) 199 | message("Evaluating ", nrow(grid.pts)+nrow(thetaMat), " quadrature points ...") 200 | if(quad.ask){ 201 | ans = toupper(readline(prompt="Proceed? [y/n]: ")) 202 | if(ans!="Y"){ 203 | message("Parameter sampling stopped") 204 | return(NULL) 205 | } 206 | } 207 | parFix <- ifelse(!eInd, parMLE, 0) 208 | for(i in 1:nrow(grid.pts)){ 209 | z <- grid.pts[i,] 210 | par <- parMLE 211 | par[eInd] <- parMLE[eInd] + V%*%D%*%z 212 | if(any(par[eInd]>upper) | any(par[eInd] crit) next 219 | else thetaMat <- rbind(thetaMat, c(-n2ll.val/2, -n2ll.val/2, 0, par)) 220 | } 221 | } 222 | thetaMat[,1] <- exp(thetaMat[,1]-max(thetaMat[,1]))/sum(exp(thetaMat[,1]-max(thetaMat[,1]))) 223 | } else { 224 | stop("\nIncorrect specification of parameter sampling method\n") 225 | } 226 | 227 | colnames(thetaMat) <- c("w", "lik", "prop.lik", object.sim$nms) 228 | attr(thetaMat,"effSamp") <- nrow(thetaMat)/(1+(sd(thetaMat[,"w"])/mean(thetaMat[,"w"]))^2) 229 | attr(thetaMat, "method") <- method 230 | attr(thetaMat, "numLikEval") <- ifelse(method=="quadrature", numEvals, size) 231 | if(is.null(object.sim$thetaSampList)) { 232 | object.sim$thetaSampList <- list(thetaMat) 233 | } else { 234 | object.sim$thetaSampList <- append(object.sim$thetaSampList, list(thetaMat)) 235 | } 236 | return(object.sim) 237 | } 238 | 239 | -------------------------------------------------------------------------------- /R/crwSimulator.R: -------------------------------------------------------------------------------- 1 | #' Construct a posterior simulation object for the CTCRW state vectors 2 | #' 3 | 4 | #' 5 | #' The \code{crwSimulator} function uses a fitted model object from 6 | #' \code{crwMLE} and a set of prediction times to construct a list from which 7 | #' \code{\link{crwPostIS}} will draw a sample from either the posterior 8 | #' distribution of the state vectors conditional on fitted parameters or a full 9 | #' posterior draw from an importance sample of the parameters. 10 | #' 11 | 12 | #' 13 | #' The crwSimulator function produces a list and preprocesses the necessary 14 | #' components for repeated track simulation from a fitted CTCRW model from 15 | #' \code{\link{crwMLE}}. The \code{method} argument can be one of \code{"IS"} 16 | #' or \code{"quadrature"}. If method="IS" is chosen standard importance 17 | #' sampling will be used to calculate the appropriate weights via t proposal 18 | #' with df degrees of freedom. If df=Inf (default) then a multivariate normal 19 | #' distribution is used to approximate the parameter posterior. If 20 | #' \code{method="quadrature"}, then a regular grid over the posterior is used 21 | #' to calculate the weights. The argument \code{grid.eps} controls the 22 | #' quadrature grid. The arguments are approximately the upper and lower limit 23 | #' in terms of standard deviations of the posterior. The default is 24 | #' \code{grid.eps}, in units of 1sd. If \code{object.crwFit} was fitted with 25 | #' \code{crwArgoFilter}, then the returned list will also include \code{p.out}, 26 | #' which is the approximate probability that the observation is an outlier. 27 | #' 28 | #' @param object.crwFit A model object from \code{\link{crwMLE}}. 29 | #' @param predTime vector of additional prediction times. 30 | #' @param method Method for obtaining weights for movement parameter samples 31 | #' @param parIS Size of the parameter importance sample 32 | #' @param df Degrees of freedom for the t approximation to the parameter 33 | #' posterior 34 | #' @param grid.eps Grid size for \code{method="quadrature"} 35 | #' @param crit Criterion for deciding "significance" of quadrature points 36 | #' (difference in log-likelihood) 37 | #' @param scale Scale multiplier for the covariance matrix of the t 38 | #' approximation 39 | #' @param quad.ask Logical, for method='quadrature'. Whether or not the sampler 40 | #' should ask if quadrature sampling should take place. It is used to stop the 41 | #' sampling if the number of likelihood evaluations would be extreme. 42 | #' @param force.quad A logical indicating whether or not to force the execution 43 | #' of the quadrature method for large parameter vectors. 44 | 45 | #' @return 46 | #' 47 | #' List with the following elements: 48 | #' 49 | #' \item{x}{Longitude coordinate with NA at prediction times} 50 | #' 51 | #' \item{y}{Similar to above for latitude} 52 | #' 53 | #' \item{locType}{Indicates prediction types with a "p" or observation times 54 | #' with an "o"} \item{P1.y}{Initial state covariance for latitude} 55 | #' 56 | #' \item{P1.x}{Initial state covariance for longitude} 57 | #' 58 | #' \item{a1.y}{Initial latitude state} 59 | #' 60 | #' \item{a1.x}{Initial longitude state} 61 | #' 62 | #' \item{n.errX}{number of longitude error model parameters} 63 | #' 64 | #' \item{n.errY}{number of latitude error model parameters} 65 | #' 66 | #' \item{delta}{vector of time differences} 67 | #' 68 | #' \item{driftMod}{Logical. indicates random drift model} 69 | #' 70 | #' \item{stopMod}{Logical. Indicated stop model fitted} 71 | #' 72 | #' \item{stop.mf}{stop model design matrix} 73 | #' 74 | #' \item{err.mfX}{Longitude error model design matrix} 75 | #' 76 | #' \item{err.mfY}{Latitude error model design matrix} 77 | #' 78 | #' \item{mov.mf}{Movement model design matrix} 79 | #' 80 | #' \item{fixPar}{Fixed values for parameters in model fitting} 81 | #' 82 | #' \item{Cmat}{Covaraince matrix for parameter sampling distribution} 83 | #' 84 | #' \item{Lmat}{Cholesky decomposition of Cmat} 85 | #' 86 | #' \item{par}{fitted parameter values} 87 | #' 88 | #' \item{N}{Total number of locations} 89 | #' 90 | #' \item{loglik}{log likelihood of the fitted model} 91 | #' 92 | #' \item{Time}{vector of observation times} 93 | #' 94 | #' \item{coord}{names of coordinate vectors in original data} 95 | #' 96 | #' \item{Time.name}{Name of the observation times vector in the original data} 97 | #' 98 | #' \item{thetaSampList}{A list containing a data frame of parameter vectors and 99 | #' their associated probabilities for a resample} 100 | #' @author Devin S. Johnson 101 | #' @seealso See \code{demo(northernFurSealDemo)} for example. 102 | #' @export 103 | crwSimulator = function( 104 | object.crwFit, 105 | predTime=NULL, 106 | method="IS", 107 | parIS=1000, 108 | df=Inf, 109 | grid.eps=1, 110 | crit=2.5, 111 | scale=1, quad.ask=TRUE, force.quad) { 112 | ## Model definition/parameters ## 113 | data <- as.data.frame(object.crwFit$data) 114 | driftMod <- object.crwFit$random.drift 115 | mov.mf <- object.crwFit$mov.mf 116 | activity <- object.crwFit$activity 117 | err.mfX <- object.crwFit$err.mfX 118 | err.mfY <- object.crwFit$err.mfY 119 | rho = object.crwFit$rho 120 | par <- object.crwFit$par 121 | n.errX <- object.crwFit$n.errX 122 | n.errY <- object.crwFit$n.errY 123 | n.mov <- object.crwFit$n.mov 124 | tn <- object.crwFit$Time.name 125 | ts = attr(object.crwFit, "time.scale") 126 | 127 | if (is.null(data$locType)) { 128 | data$locType <- "o" 129 | } 130 | 131 | return_posix <- ifelse( 132 | (inherits(predTime,"POSIXct") | inherits(predTime, "character") | is.null(predTime)) & inherits(data[,tn],"POSIXct"), 133 | TRUE, FALSE) 134 | if(!return_posix) { 135 | # if(inherits(predTime,"numeric") && inherits(data[, tn],"numeric")) { 136 | # warning("numeric time values detected. numeric values will be returned.") 137 | # } 138 | if(inherits(predTime,"numeric") && inherits(data[, tn], "POSIXct")) { 139 | # warning("predTime provided as numeric. converting it to POSIXct.") 140 | stop("predTime provided as numeric and original time data was POSIX!") 141 | # predTime <- lubridate::as_datetime(predTime) 142 | } 143 | if(inherits(predTime,"POSIXct") && inherits(data[, tn], "numeric")) { 144 | # warning("input data time column provided as numeric. converting to POSIXct") 145 | stop("predTime provided as POSIX and original data was numeric!") 146 | # data[, tn] <- lubridate::as_datetime(data[, tn]) 147 | } 148 | } 149 | 150 | if(!is.null(predTime)){ 151 | 152 | if(inherits(predTime,"character")) { 153 | if(!inherits(data[,tn],"POSIXct")) stop("Character specification of predTime can only be used with POSIX times in the original data!") 154 | t_int <- unlist(strsplit(predTime, " ")) 155 | if(t_int[2] %in% c("sec","secs","min","mins","hour","hours","day","days")) { 156 | min_dt <- min(data[,tn],na.rm=TRUE) 157 | max_dt <- max(data[,tn],na.rm=TRUE) 158 | min_dt <- lubridate::ceiling_date(min_dt,t_int[2]) 159 | max_dt <- lubridate::floor_date(max_dt,t_int[2]) 160 | predTime <- seq(min_dt, max_dt, by = predTime) 161 | } else { 162 | stop("predTime not specified correctly. see documentation for seq.POSIXt") 163 | } 164 | } 165 | 166 | if(inherits(predTime, "POSIXct")){ 167 | ts = attr(object.crwFit, "time.scale") 168 | predTime = as.numeric(predTime)/ts 169 | } 170 | 171 | ## Data setup ## 172 | if(min(predTime) < min(data$TimeNum)) { 173 | warning("Predictions times given before first observation!\nOnly those after first observation will be used.") 174 | predTime <- predTime[predTime>=min(data$TimeNum)] 175 | } 176 | origTime <- data$TimeNum 177 | predData <- data.frame(predTime, "p") 178 | names(predData) <- c("TimeNum", "locType") 179 | # predTime <- as.numeric(predTime) 180 | data <- merge(data, predData, 181 | by=c("TimeNum", "locType"), all=TRUE) 182 | dups <- duplicated(data$TimeNum) #& data[,"locType"]==1 183 | data <- data[!dups, ] 184 | mov.mf <- as.matrix(expandPred(x=mov.mf, Time=origTime, predTime=predTime)) 185 | if (!is.null(activity)) activity <- as.matrix(expandPred(x=activity, Time=origTime, predTime=predTime)) 186 | if (!is.null(err.mfX)) err.mfX <- as.matrix(expandPred(x=err.mfX, Time=origTime, predTime=predTime)) 187 | if (!is.null(err.mfY)) err.mfY <- as.matrix(expandPred(x=err.mfY, Time=origTime, predTime=predTime)) 188 | if (!is.null(rho)) rho <- as.matrix(expandPred(x=rho, Time=origTime, predTime=predTime)) 189 | } 190 | data$locType[data$TimeNum%in%predTime] <- 'p' 191 | delta <- c(diff(data$TimeNum), 1) 192 | y = as.matrix(data[,object.crwFit$coord]) 193 | noObs <- as.numeric(is.na(y[,1]) | is.na(y[,2])) 194 | y[noObs==1,] = 0 195 | N = nrow(y) 196 | out <- list(y=y, noObs=noObs, n.errX=n.errX, n.errY=n.errY, n.mov=n.mov, 197 | delta=delta, driftMod=driftMod, activity=activity, err.mfX=err.mfX, 198 | err.mfY=err.mfY, mov.mf=mov.mf, rho=rho, fixPar=object.crwFit$fixPar, 199 | Cmat=object.crwFit$Cmat, locType=data$locType, 200 | par=object.crwFit$par, nms=object.crwFit$nms, N=nrow(data), lower=object.crwFit$lower, 201 | upper=object.crwFit$upper, 202 | loglik=object.crwFit$loglik, TimeNum=data$TimeNum, Time.name=tn, return_posix=return_posix, 203 | coord=object.crwFit$coord, prior=object.crwFit$prior, time.scale=ts) 204 | class(out) <- 'crwSimulator' 205 | if(parIS>1 & object.crwFit$need.hess==TRUE) out <- crwSamplePar(out, method=method, size=parIS, df=df, grid.eps=grid.eps, crit=crit, scale=scale, quad.ask=quad.ask, force.quad = force.quad) 206 | if(!is.null(out)){ 207 | attr(out,"epsg") <- attr(object.crwFit,"epsg") 208 | attr(out,"proj4") <- attr(object.crwFit,"proj4") 209 | } 210 | return(out) 211 | } 212 | -------------------------------------------------------------------------------- /R/crwUseGrid.R: -------------------------------------------------------------------------------- 1 | # # TODO: Add comment 2 | # # 3 | # # Author: johnsond@afsc.noaa.gov 4 | # ############################################################################### 5 | # 6 | # 7 | # 8 | # #' Compute a spatial use grid from a crawl prediction 9 | # #' 10 | # #' This function take a SpatialPoints object and a spatial GridTopology 11 | # #' object from the 'sp' package and outputs the number of point locations 12 | # #' in each grid cell 13 | # #' 14 | # #' 15 | # #' @param object A 'SpatialPoints' object created with the \code{sp} package. T 16 | # #' @param grid A \code{GridTopology} object from the 'sp' package 17 | # #' @param subset An indicator of which times should be used for calculation of 18 | # #' the use grid. Can be a logical vector or a vector of integers, such as from 19 | # #' a call to \code{which} 20 | # #' @return A \code{SpatialGridDataFrame} with data column 'use' which gives the 21 | # #' count of locations within the grid cell 22 | # #' @author Devin S. Johnson 23 | # #' @export 24 | # #' @import sp 25 | # #' @import raster 26 | # crwUseGrid <- function(object, grid, subset=TRUE){ 27 | # object <- object[subset,] 28 | # useTemplate <- SpatialGrid(grid=grid, proj4string=CRS(proj4string(object))) 29 | # out <- as(rasterize(object, raster(useTemplate), fun=sum), "SpatialGridDataFrame") 30 | # names(out@data) <- "use" 31 | # return(out) 32 | # } 33 | # -------------------------------------------------------------------------------- /R/crw_coerce_sf.R: -------------------------------------------------------------------------------- 1 | #' Coerce to sf/sfc object 2 | #' 3 | #' Provides reliable conversion of \code{"crwIS"} and \code{"crwPredict"} objects 4 | #' into simple features objects supported in the \code{"sf"} package. Both 5 | #' \code{"sf"} objects with "POINT" geometry and \code{"sfc_LINESTRING"} objects 6 | #' are created. Coercion of \code{"crwPredict"} objects to \code{"sfc_LINESTRING"} 7 | #' has an option \code{"group"} argument when the \code{"crwPredict"} object 8 | #' includes predictions from multiple deployments. The grouping column will be 9 | #' used and a tibble of multiple \code{"sf_LINESTRING"} objects will be returned 10 | #' 11 | #' @param data an object of class \code{"crwIS"} or \code{"crwPredict"} 12 | #' @param ftype character of either "POINT" or "LINESTRING" specifying the feature type 13 | #' @param locType character vector of location points to include ("p","o") 14 | #' @param group (optional) character specifying the column to group by for multiple LINESTRING features 15 | #' @param ... Additional arguments that are ignored 16 | #' @export 17 | 18 | crw_as_sf <- function(data,ftype,locType,group) { 19 | UseMethod("crw_as_sf",data) 20 | } 21 | 22 | #' @describeIn crw_as_sf coerce crwIS object to sf (POINT or 23 | #' LINESTRING geometry) 24 | #' @export 25 | crw_as_sf.crwIS <- function(data, 26 | ftype, 27 | locType = c("p", "o", "f"), 28 | group = NULL, ...) { 29 | if (!is.null(group)) { 30 | warning("group argument not applicable to crwIS objects. ignorning") 31 | } 32 | stopifnot(!missing(ftype), ftype %in% c("POINT", "LINESTRING")) 33 | 34 | crw_crs <- attr(data, "epsg") 35 | if(is.null(crw_crs) || is.na(crw_crs)) crw_crs <- attr(data, "proj4") 36 | if (ftype == "POINT") { 37 | data <- crw_as_tibble(data) %>% 38 | dplyr::filter(.data$locType %in% {{ locType }}, 39 | !is.na(.data$mu.x), 40 | !is.na(.data$mu.y)) %>% 41 | sf::st_as_sf(coords = c("mu.x", "mu.y")) 42 | data = data %>% sf::st_set_crs(crw_crs) 43 | } 44 | if (ftype == "LINESTRING") { 45 | data <- crw_as_tibble(data) %>% 46 | dplyr::filter(.data$locType %in% {{ locType }}, 47 | !is.na(.data$mu.x), 48 | !is.na(.data$mu.y)) %>% 49 | sf::st_as_sf(coords = c("mu.x", "mu.y")) 50 | data = data %>% sf::st_set_crs(crw_crs) 51 | data = data %>% 52 | summarise(id = 1, do_union = FALSE) %>% 53 | sf::st_cast("LINESTRING") 54 | } 55 | return(data) 56 | } 57 | 58 | #' @describeIn crw_as_sf coerce crwPredict object to sf (POINT or 59 | #' LINESTRING geometry) 60 | #' @export 61 | crw_as_sf.crwPredict <- function(data,ftype, 62 | locType = c("p","o","f"), 63 | group = NULL, ...) { 64 | stopifnot(!missing(ftype), ftype %in% c("POINT","LINESTRING")) 65 | 66 | crw_crs <- attr(data, "epsg") 67 | if(is.null(crw_crs) || is.na(crw_crs)) crw_crs <- attr(data, "proj4") 68 | 69 | if(ftype == "POINT" && is.null(group)) { 70 | data <- crw_as_tibble(data) %>% 71 | dplyr::filter(.data$locType %in% {{ locType }} ) %>% 72 | dplyr::arrange(.data$TimeNum) %>% 73 | sf::st_as_sf(coords = c("mu.x","mu.y")) 74 | data = data %>% sf::st_set_crs(crw_crs) 75 | } 76 | if(ftype == "POINT" && !is.null(group)) { 77 | warning("group argument not applicable for 'POINT' type. ignoring") 78 | } 79 | if(ftype == "LINESTRING" && is.null(group)) { 80 | 81 | data <- crw_as_tibble(data) %>% 82 | dplyr::filter(.data$locType %in% {{ locType }} ) %>% 83 | dplyr::arrange(.data$TimeNum) %>% 84 | sf::st_as_sf(coords = c("mu.x","mu.y")) 85 | data = data %>% sf::st_set_crs(crw_crs) 86 | data = data %>% summarise(id=1,do_union = FALSE) %>% sf::st_cast("LINESTRING") 87 | } 88 | if(ftype == "LINESTRING" && !is.null(group)) { 89 | 90 | data <- crw_as_tibble(data) %>% 91 | dplyr::filter(.data$locType %in% {{ locType }} ) %>% 92 | dplyr::arrange(.data$TimeNum) %>% 93 | sf::st_as_sf(coords = c("mu.x","mu.y")) 94 | data = data %>% sf::st_set_crs(crw_crs) 95 | data = data %>% dplyr::group_by(group) %>% 96 | dplyr::summarise(do_union = FALSE) %>% 97 | sf::st_cast("LINESTRING") 98 | } 99 | return(data) 100 | } 101 | 102 | #' @describeIn crw_as_sf coerce list of crwIS objects to sf (LINESTRING or 103 | #' MULTILINESTRING geometry) 104 | #' @export 105 | crw_as_sf.list <- function(data,ftype, 106 | locType = c("p","o","f"), ...) { 107 | 108 | is_list_of_crwis <- data %>% 109 | purrr::modify_depth(1, ~purrr::map_lgl(.,inherits,"crwIS")) %>% 110 | purrr::map_lgl(all) %>% 111 | all() 112 | 113 | stopifnot(is_list_of_crwis) 114 | 115 | data <- data %>% 116 | purrr::modify_depth(1, ~ purrr::map(., crawl::crw_as_sf, 117 | ftype = "LINESTRING", 118 | locType = {{ locType }} )) 119 | 120 | if (ftype == "MULTILINESTRING") { 121 | make_mls <- function(ll) { 122 | do.call(rbind,ll) %>% 123 | dplyr::group_by(id) %>% 124 | dplyr::summarise(do_union = FALSE) 125 | } 126 | sf_list <- data %>% purrr::map(make_mls) 127 | } 128 | if (ftype == "LINESTRING") { 129 | make_mls <- function(ll) { 130 | do.call(rbind,ll) 131 | } 132 | sf_list <- data %>% purrr::map(make_mls) 133 | } 134 | 135 | return(sf_list) 136 | } 137 | #' @export 138 | crw_as_sf.sf <- function(data,ftype, 139 | locType = c("p","o","f"), 140 | group = NULL, ...) { 141 | message("No conversion between ftypes yet :-(") 142 | data 143 | } 144 | -------------------------------------------------------------------------------- /R/crw_coerce_tibble.R: -------------------------------------------------------------------------------- 1 | #' Coerce crawl objects (crwIS and crwPredict) to tibbles 2 | #' 3 | #' @author Josh M. London 4 | #' @param crw_object an object of class \code{"crwIS"} or \code{"crwPredict"} 5 | #' @param ... Additional arguments that are ignored 6 | #' @export 7 | 8 | crw_as_tibble <- function(crw_object, ...) { 9 | UseMethod("crw_as_tibble",crw_object) 10 | } 11 | 12 | #' @describeIn crw_as_tibble coerce crwIS object to tibble 13 | #' @export 14 | crw_as_tibble.crwIS <- function(crw_object, ...) { 15 | tn = attr(crw_object, "Time.name") 16 | out = data.frame(TimeNum=crw_object$TimeNum, locType =crw_object$locType, crw_object$alpha.sim) 17 | out[,tn] = crw_object[[tn]] 18 | out=tibble::as_tibble(out) %>% dplyr::arrange(.data$TimeNum) 19 | out 20 | } 21 | 22 | #' @describeIn crw_as_tibble coerce crwPredict object to tibble 23 | #' @export 24 | crw_as_tibble.crwPredict <- function(crw_object, ...) { 25 | if(inherits(crw_object,"list")){ 26 | crw_object = fillCols(crawl::flatten(crw_object)) 27 | } 28 | tibble::as_tibble(crw_object) 29 | } 30 | 31 | #' @describeIn crw_as_tibble 32 | #' @export 33 | crw_as_tibble.tbl <- function(crw_object, ...) { 34 | crw_object 35 | } 36 | -------------------------------------------------------------------------------- /R/detect_timescale.R: -------------------------------------------------------------------------------- 1 | #' Detect appropriate time scale for movement analysis 2 | #' 3 | #' This function examines the time vector and evaluates the median time 4 | #' interval. With this, we determine what the best time scale for the 5 | #' movement model is likely to be. 6 | #' 7 | #' @param time_vector a vector of class POSIXct 8 | #' 9 | #' @return character of either "seconds","minutes","hours","days","weeks" 10 | #' @export 11 | #' 12 | 13 | detect_timescale <- function(time_vector) { 14 | intervals <- difftime(time_vector[-length(time_vector)], 15 | time_vector[-1], units = "secs") 16 | median_int <- abs(median(intervals)) 17 | if (median_int < 31) { 18 | return("seconds") 19 | } 20 | if (median_int < 1801) { 21 | return("minutes") 22 | } 23 | if (median_int < 3600*12) { 24 | return("hours") 25 | } 26 | if (median_int < 3600*24*3.5) { 27 | return("days") 28 | } 29 | return("weeks") 30 | } 31 | -------------------------------------------------------------------------------- /R/displayPar.R: -------------------------------------------------------------------------------- 1 | #'Display the order of parameters along with fixed values and starting values 2 | #' 3 | #'This function takes the model specification arguments to the \code{\link{crwMLE}} function and displays a table 4 | #'with the parameter names in the order that \code{crwMLE} will use during model fitting. This is useful for specifying 5 | #'values for the \code{fixPar} or \code{theta} (starting values for free parameters) arguments. 6 | #' 7 | #'@param mov.model formula object specifying the time indexed covariates for 8 | #'movement parameters. 9 | #'@param err.model A 2-element list of formula objects specifying the time 10 | #'indexed covariates for location error parameters. 11 | #'@param activity formula object giving the covariate for the stopping 12 | #'portion of the model. 13 | #'@param drift logical indicating whether or not to include a random 14 | #'drift component. 15 | #'@param data data.frame object containing telemetry and covariate data. A 16 | #'\code{SpatialPointsDataFrame} object from the package 'sp' will also be accepted. 17 | #'@param Time.name character indicating name of the location time column 18 | #'@param theta starting values for parameter optimization. 19 | #'@param fixPar Values of parameters which are held fixed to the given value. 20 | #'@param ... Additional arguments (probably for testing new features.) 21 | #' 22 | #'@return A data frame with the following columns 23 | #' 24 | #'\item{ParNames}{The names of the parameters specified by the arguments.} 25 | #' 26 | #'\item{fixPar}{The values specified by the \code{fixPar} argument for fixed values of the parameters. In model fitting, 27 | #'these values will remain fixed and will not be estimated.} 28 | #' 29 | #'\item{thetaIndex}{This column provides the index of each element of the theta argument and to which parameter it corresponds.} 30 | #' 31 | #'\item{thetaStart}{If a value is given for the \code{theta} argument it will be placed in this column and its elements will 32 | #'correspond to the \code{thetaIdx} column.} 33 | #' 34 | #'@author Devin S. Johnson 35 | #'@seealso \code{demo(northernFurSealDemo)} for example. 36 | #' 37 | #'@export 38 | 39 | displayPar <- function(mov.model=~1, err.model=NULL, activity=NULL, drift=FALSE, data, Time.name, theta, fixPar, ...){ 40 | if(inherits(data, "trip")){ 41 | Time.name <- data@TOR.columns[1] 42 | } 43 | if(inherits(data, "SpatialPoints")) { 44 | if("+proj=longlat" %in% strsplit(sp::proj4string(data), " ")[[1]]) stop("Location data must be projected.") 45 | coordVals <- as.data.frame(sp::coordinates(data)) 46 | coord <- names(coordVals) 47 | data <- cbind(slot(data,"data"), coordVals) 48 | } 49 | if(inherits(data[,Time.name],"POSIXct")){ 50 | data$TimeNum <- as.numeric(data[,Time.name])#/3600 51 | Time.name <- "TimeNum" 52 | } 53 | 54 | 55 | ### Check for duplicate time records ### 56 | #if(any(diff(data[,Time.name])==0)) stop("There are duplicate time records for some data entries! Please remove before proceeding.") 57 | 58 | 59 | ## SET UP MODEL MATRICES AND PARAMETERS ## 60 | errMod <- !is.null(err.model) 61 | activeMod <- !is.null(activity) 62 | driftMod <- drift 63 | mov.mf <- model.matrix(mov.model, model.frame(mov.model, data, na.action=na.pass)) 64 | if (any(is.na(mov.mf))) stop("Missing values are not allowed in movement covariates!") 65 | n.mov <- ncol(mov.mf) 66 | if (errMod) { 67 | err.mfX <- model.matrix(err.model$x,model.frame(err.model$x, data, na.action=na.pass)) 68 | err.mfX <- ifelse(is.na(err.mfX), 0, err.mfX) 69 | n.errX <- ncol(err.mfX) 70 | if (!is.null(err.model$y)) { 71 | err.mfY <- model.matrix(err.model$y,model.frame(err.model$y, data, na.action=na.pass)) 72 | err.mfY <- ifelse(is.na(err.mfY), 0, err.mfY) 73 | n.errY <- ncol(err.mfY) 74 | } else { 75 | err.mfY <- NULL 76 | n.errY <- 0 77 | } 78 | if(!is.null(err.model$rho)){ 79 | rho = model.matrix(err.model$rho,model.frame(err.model$rho, data, na.action=na.pass))[,-1] 80 | if(any(rho > 1 | rho < -1, na.rm=TRUE)) stop("Error model correlation outside of the range (-1, 1).") 81 | } else rho = NULL 82 | } else { 83 | n.errY <- n.errX <- 0 84 | err.mfX <- err.mfY <- rho <- NULL 85 | } 86 | if (activeMod) { 87 | #stop.model 88 | activity <- model.matrix(activity, model.frame(activity, data, na.action=na.pass)) 89 | if (ncol(activity) > 2) stop("There can only be one activity variable.") 90 | activity <- as.double(activity[,2]) 91 | if (any(activity < 0) | any(activity > 1)) stop("'activity' variable must be >=0 and <=1.") 92 | if (any(is.na(activity))) stop("Missing values are not allowed in the activity variable.") 93 | } else activity <- NULL 94 | n.drift <- as.integer(driftMod) 95 | n.activ <- as.integer(activeMod) 96 | b.nms <- paste("ln beta ", colnames(mov.mf), sep="") 97 | sig.nms <- paste("ln sigma ", colnames(mov.mf), sep="") 98 | if (errMod) { 99 | if (!is.null(err.model$y)) { 100 | tau.nms <- c(paste("ln tau.x ", colnames(err.mfX), sep=""), 101 | paste("ln tau.y ", colnames(err.mfY), sep="")) 102 | } else tau.nms <- paste("ln tau ", colnames(err.mfX), sep="") 103 | } else tau.nms <- NULL 104 | if (activeMod){ 105 | active.nms <- "ln phi" 106 | } else active.nms <- NULL 107 | if (driftMod) { 108 | drift.nms <- c("ln sigma.drift/sigma", "ln psi-1") 109 | } else drift.nms <- NULL 110 | nms <- c(tau.nms, sig.nms, b.nms, active.nms, drift.nms) 111 | n.par <- length(nms) 112 | if (missing(fixPar)) fixPar <- rep(NA, n.par) 113 | if (length(fixPar)!=n.par) stop("'fixPar' argument is not the right length! The number of parameters in the model is ", n.par, "\n") 114 | if (!missing(theta)) if(length(theta) != sum(is.na(fixPar))) stop("\nWrong number of parameters specified in start value.\n") 115 | thetaIdx <- fixPar 116 | thetaIdx[is.na(fixPar)] <- 1:sum(is.na(fixPar)) 117 | thetaIdx[!is.na(fixPar)] <- NA 118 | out <- data.frame(ParNames=nms, fixPar=fixPar, thetaIdx=thetaIdx) 119 | if(!missing(theta)){ 120 | thetaStart <- thetaIdx 121 | thetaStart[!is.na(thetaStart)] <- theta 122 | out <- cbind(out, thetaStart=thetaStart) 123 | } 124 | return(out) 125 | } -------------------------------------------------------------------------------- /R/expandPred.R: -------------------------------------------------------------------------------- 1 | #' Expand a time indexed data set with additional prediction times 2 | #' 3 | 4 | #' 5 | #' Expands a covariate data frame (or vector) that has a separate time index by 6 | #' inserting prediction times and duplicating the covariate values for all 7 | #' prediction time between subsequent data times. 8 | #' 9 | #' 10 | #' @param x Data to be expanded. 11 | #' @param Time Either a character naming the column which contains original 12 | #' time values, or a numeric vector of original times 13 | #' @param predTime prediction times to expand data 14 | #' @param time.col Logical value indicating whether to attach the new times to 15 | #' the expanded data 16 | #' @return data.frame expanded by \code{predTime} 17 | #' @author Devin S. Johnson 18 | #' @examples 19 | #' 20 | #' #library(crawl) 21 | #' origTime <- c(1:10) 22 | #' x <- cbind(rnorm(10), c(21:30)) 23 | #' predTime <- seq(1,10, by=0.25) 24 | #' expandPred(x, Time=origTime, predTime, time.col=TRUE) 25 | #' 26 | #' @export 27 | "expandPred" <- function(x, Time='Time', predTime, time.col=FALSE) 28 | { 29 | if(is.character(Time)) { 30 | Time.name <- Time 31 | if(!Time.name%in%colnames(x)) stop(paste(Time.name, 'is not in x. PLease specify correct time indicator')) 32 | } 33 | else if(is.numeric(Time) & length(Time)==nrow(as.matrix(x))) { 34 | x <- cbind(Time=Time, x) 35 | Time.name <- 'Time' 36 | } 37 | else stop("Value given for 'Time' is not a recognized format. See crawl documentation") 38 | predData <- data.frame(predTime) 39 | colnames(predData) <- Time.name 40 | newx <- merge(as.data.frame(x), predData, 41 | by=c(Time.name), all=TRUE) 42 | for(i in 1:ncol(newx)) { 43 | vec <- newx[,i] 44 | newx[,i] <- vec[!is.na(vec)][cumsum(!is.na(vec))] 45 | } 46 | 47 | if(time.col) return(newx[!duplicated(newx[,Time.name]),]) 48 | else return(newx[!duplicated(newx[,Time.name]),!colnames(newx)%in%Time.name]) 49 | } 50 | -------------------------------------------------------------------------------- /R/fillCols.R: -------------------------------------------------------------------------------- 1 | #' Fill missing values in data set (or matrix) columns for which there is a 2 | #' single unique value 3 | #' 4 | 5 | #' 6 | #' Looks for columns in a data set that have a single unique non-missing value 7 | #' and fills in all \code{NA} with that value 8 | #' 9 | #' 10 | #' @param data data.frame 11 | #' @return data.frame 12 | #' @author Devin S. Johnson 13 | #' @examples 14 | #' 15 | #' #library(crawl) 16 | #' data1 <- data.frame(constVals=rep(c(1,NA),5), vals=1:10) 17 | #' data1[5,2] <- NA 18 | #' data1 19 | #' data2 <- fillCols(data1) 20 | #' data2 21 | #' 22 | #' mat1 <- matrix(c(rep(c(1,NA),5), 1:10), ncol=2) 23 | #' mat1[5,2] <- NA 24 | #' mat1 25 | #' mat2 <- fillCols(mat1) 26 | #' mat2 27 | #' @export 28 | "fillCols" <- function(data) { 29 | nc <- ncol(data) 30 | getConst <- function(vec) { 31 | vals <- unique(vec) 32 | return(length(vals[!is.na(vals)])==1) 33 | } 34 | constCol <- apply(data, 2, getConst) 35 | data[,constCol] <- data[1,constCol] 36 | return(data) 37 | } 38 | -------------------------------------------------------------------------------- /R/getQ.R: -------------------------------------------------------------------------------- 1 | 2 | getQT <- function(sig2, b, sig2.drift, b.drift, delta, driftMod) 3 | { 4 | Qmat <- matrix(0, length(b), 3+2*driftMod) 5 | Tmat <- matrix(0, length(b), 2+2*driftMod) 6 | delta.sd <- max(getSD(delta), 16) 7 | if(!driftMod){ 8 | idx <- (b<=0.1) 9 | psig2 <- sig2 #exp(log(sig2)-2*log(b)) 10 | # 11 | 12 | Qmat[idx,1] <- sig2[idx]*ps1a(delta[idx],b[idx]) 13 | Qmat[!idx,1] <- psig2[!idx]*(delta[!idx] - 2*exp(pexp(delta[!idx],b[!idx],,TRUE)-log(b[!idx])) + 14 | exp(pexp(delta[!idx],2*b[!idx],,TRUE)-log(2*b[!idx]))) 15 | 16 | # 17 | Qmat[idx,2] <- sig2[idx]*ps2a(delta[idx],b[idx])/2 18 | Qmat[!idx,2] <- psig2[!idx]*((1-2*exp(-b[!idx]*delta[!idx])+exp(-2*b[!idx]*delta[!idx]))/2) 19 | 20 | # 21 | Qmat[idx,3] <- sig2[idx]*ps3a(delta[idx],b[idx]) 22 | #Qmat[!idx,3] <- sig2[!idx]*exp(pexp(delta[!idx],2*b[!idx],,TRUE)-log(2*b[!idx])) 23 | Qmat[!idx,3] <- sig2[!idx]*exp(log(b[!idx]) + pexp(delta[!idx],2*b[!idx],,TRUE))/2 24 | 25 | # 26 | Tmat[,1] <- exp(pexp(delta,b,,TRUE)-log(b)) 27 | Tmat[,2] <- exp(-b*delta) 28 | 29 | # 30 | 31 | # print(zapsmall(data.frame(v1=v1,v2=v2, Q=Qmat, xxx1, xxx2, xxx3, b))) 32 | # cat(sum(Qmat[,1] - Qmat[,2]^2/Qmat[,3]<0), " bad values\n") 33 | # cat(min(b),"\n") 34 | # return(list(Qmat=Qmat, Tmat=Tmat)) 35 | } 36 | else{ 37 | psig2 <- sig2 #exp(log(sig2)-2*log(b)) 38 | psig2.drift <- sig2.drift #exp(log(sig2.drift)-2*log(b.drift)) 39 | V1 <- rep(0,length(b)) 40 | V2 <- rep(0,length(b)) 41 | idx <- (b<=0.01) 42 | idx2 <- (b.drift<=0.01) 43 | # 44 | V1[idx] <- sig2[idx]*ps1a(delta[idx],b[idx]) 45 | V1[!idx] <- psig2[!idx]*(delta[!idx] - 2*exp(pexp(delta[!idx],b[!idx],,TRUE)-log(b[!idx])) + 46 | exp(pexp(delta[!idx],2*b[!idx],,TRUE)-log(2*b[!idx]))) 47 | # 48 | V2[idx2] <- sig2.drift[idx2]*ps1a(delta[idx2],b.drift[idx2]) 49 | V2[!idx2] <- psig2.drift[!idx2]*(delta[!idx2] - 2*exp(pexp(delta[!idx2],b.drift[!idx2],,TRUE)-log(b.drift[!idx2])) + 50 | exp(pexp(delta[!idx2],2*b.drift[!idx2],,TRUE)-log(2*b.drift[!idx2]))) 51 | # 52 | Qmat[,1] <- V1 + V2 53 | 54 | # 55 | Qmat[idx,2] <- sig2[idx]*ps2a(delta[idx],b[idx])/2 56 | Qmat[!idx,2] <- psig2[!idx]*((1-2*exp(-b[!idx]*delta[!idx])+exp(-2*b[!idx]*delta[!idx]))/2) 57 | # 58 | Qmat[idx2,3] <- sig2.drift[idx2]*ps2a(delta[idx2],b.drift[idx2])/2 59 | Qmat[!idx2,3] <- psig2.drift[!idx2]*((1-2*exp(-b.drift[!idx2]*delta[!idx2])+exp(-2*b.drift[!idx2]*delta[!idx2]))/2) 60 | # 61 | Qmat[idx,4] <- sig2[idx]*ps3a(delta[idx],b[idx]) 62 | #Qmat[!idx,4] <- sig2[!idx]*exp(pexp(delta[!idx],2*b[!idx],,TRUE)-log(2*b[!idx])) 63 | Qmat[!idx,4] <- sig2[!idx]*exp(log(b[!idx]) + pexp(delta[!idx],2*b[!idx],,TRUE))/2 64 | # 65 | Qmat[idx2,5] <- sig2.drift[idx2]*ps3a(delta[idx2],b.drift[idx2]) 66 | #Qmat[!idx2,5] <- sig2.drift[!idx2]*exp(pexp(delta[!idx2],2*b.drift[!idx2],,TRUE)-log(2*b.drift[!idx2])) 67 | Qmat[!idx2,5] <- sig2.drift[!idx2]*exp(log(b.drift[!idx]) + pexp(delta[!idx],2*b.drift[!idx],,TRUE))/2 68 | ## 69 | ## 70 | Tmat[idx,1] <- ps4(delta[idx],b[idx]) 71 | Tmat[!idx,1] <- exp(pexp(delta[!idx],b[!idx],,TRUE)-log(b[!idx])) 72 | # 73 | Tmat[,2] <- exp(-b*delta) 74 | # 75 | Tmat[idx2,3] <- ps4(delta[idx2],b.drift[idx2]) 76 | Tmat[!idx2,3] <- exp(pexp(delta[!idx2],b.drift[!idx2],,TRUE)-log(b.drift[!idx2])) 77 | # 78 | Tmat[,4] <- exp(-b.drift*delta) 79 | } 80 | Qmat <- round(Qmat,delta.sd) 81 | Tmat <- round(Tmat, delta.sd) 82 | return(list(Qmat=Qmat, Tmat=Tmat)) 83 | } 84 | 85 | ps1 <- function(d,x){ 86 | # Expansion of (d - 2*(1-exp(-d*x))/x + (1-exp(-2*d*x))/(2*x))/(x^2) 87 | d^3/3 - (d^4 * x)/4 + (7 * d^5 * x^2)/60 - (d^6 * x^3)/24 + (31 * d^7 * x^4)/2520 - 88 | (d^8 * x^5)/320 + (127 * d^9 * x^6)/181440 - (17 * d^10 * x^7)/120960 + 89 | (73 * d^11 * x^8)/2851200 - (31 * d^12 * x^9)/7257600 + (2047 * d^13 * x^10)/3113510400 90 | } 91 | 92 | ps1a <- function(d,x){ 93 | # Expansion of d - 2*(1-exp(-d*x))/x + (1-exp(-2*d*x))/(2*x) 94 | (d^3 * x^2)/3 - (d^4 * x^3)/4 + (7 * d^5 * x^4)/60 - (d^6 * x^5)/24 + (31 * d^7 * x^6)/2520 - 95 | (d^8 * x^7)/320 + (127 * d^9 * x^8)/181440 - (17 * d^10 * x^9)/120960 + (73 * d^11 * x^10)/2851200 96 | } 97 | 98 | 99 | ps2 <- function(d,x){ 100 | # Expansion of (1 - 2*exp(-d*x) + exp(-2*d*x))/(x^2) 101 | d^2 - (d^3 * x) + (7 * d^4 * x^2)/12 - (d^5 * x^3)/4 + (31 * d^6 * x^4)/360 - 102 | (d^7 * x^5)/40 + (127 * d^8 * x^6)/20160 - (17 * d^9 * x^7)/12096 + (73 * d^10 * x^8)/259200 - 103 | (31 * d^11 * x^9)/604800 + (2047 * d^12 * x^10)/239500800 104 | } 105 | 106 | ps2a <- function(d,x){ 107 | # Expansion of 1 - 2*exp(-d*x) + exp(-2*d*x) 108 | (d^2 * x^2) - (d^3 * x^3) + (7 * d^4 * x^4)/12 - (d^5 * x^5)/4 + (31 * d^6 * x^6)/360 - (d^7 * x^7)/40 + 109 | (127 * d^8 * x^8)/20160 - (17 * d^9 * x^9)/12096 + (73 * d^10 * x^10)/259200 110 | } 111 | 112 | ps3 <- function(d,x){ 113 | # Expansion of (1-exp(-2*d*x))/(2*x) 114 | d - (d^2 * x) + (2 * d^3 * x^2)/3 - (d^4 * x^3)/3 + (2 * d^5 * x^4)/15 - (2 * d^6 * x^5)/45 + 115 | (4 * d^7 * x^6)/315 - (d^8 * x^7)/315 + (2 * d^9 * x^8)/2835 - (2 * d^10 * x^9)/14175 + 116 | (4 * d^11 * x^10)/155925 - (2 * d^12 * x^11)/467775 + (4 * d^13 * x^12)/6081075 117 | } 118 | 119 | ps3a <- function(d,x){ 120 | # Expansion of x*(1-exp(-2*d*x))/2 121 | (d * x^2) - (d^2 * x^3) + (2 * d^3 * x^4)/3 - (d^4 * x^5)/3 + (2 * d^5 * x^6)/15 - (2 * d^6 * x^7)/45 + 122 | (4 * d^7 * x^8)/315 - (d^8 * x^9)/315 + (2 * d^9 * x^10)/2835 123 | } 124 | 125 | ps4 <- function(d,x){ 126 | #Expansion of (1-exp(-d*b))/b 127 | d-(d^2 * x)/2+(d^3 * x^2)/6-(d^4 * x^3)/24+(d^5 * x^4)/120- 128 | (d^6 * x^5)/720+(d^7 * x^6)/5040-(d^8 * x^7)/40320+(d^9 * x^8)/362880-(d^10 * x^9)/3628800+ 129 | (d^11 * x^10)/39916800-(d^12 * x^11)/479001600+(d^13 * x^12)/6227020800 130 | } 131 | -------------------------------------------------------------------------------- /R/intToPOSIX.R: -------------------------------------------------------------------------------- 1 | #' Reverse as.numeric command that is performed on a vector of type POSIXct 2 | #' 3 | #' Takes integer value produced by \code{as.numeric(x)}, where \code{x} is a 4 | #' POSIXct vector and returns it to a POSIXct vector 5 | #' 6 | #' @aliases intToPOSIX 7 | #' @param timeVector A vector of integers produced by as.numeric applied to a 8 | #' PSIXct vector 9 | #' @param tz Time zone of the vector (see \code{\link{as.POSIXct}}). 10 | #' @return POSIXct vector 11 | #' @note There is no check that as.numeric applied to a POSIX vector produced 12 | #' \code{timeVector}. So, caution is required in using this function. It was 13 | #' included simply because I have found it useful 14 | #' @author Devin S. Johnson 15 | #' @examples 16 | #' 17 | #' #library(crawl) 18 | #' timeVector <- as.numeric(Sys.time()) 19 | #' timeVector 20 | #' intToPOSIX(timeVector, tz="") 21 | #' @export 22 | `intToPOSIX` <- 23 | function(timeVector, tz='GMT') 24 | ################################################################################ 25 | # Convert integer time to POSIX 26 | # timeVector = integer time in seconds 27 | # tz = time zone code 28 | ################################################################################ 29 | { 30 | Epoch = as.POSIXct(strptime("1970-01-01 00:00:00", "%Y-%m-%d %H:%M:%S",tz=tz),tz=tz) 31 | Epoch+timeVector 32 | } 33 | 34 | -------------------------------------------------------------------------------- /R/mergeTrackStop.R: -------------------------------------------------------------------------------- 1 | #' Merge a location data set with a dry time (or other stopping) covariate 2 | #' 3 | #' 4 | #' The function merges a location data set with a stopping variable data set. 5 | #' 6 | #' 7 | #' Simply merges the data frames and interpolates based on the chosen method. 8 | #' Both data frames have to use the same name for the time variable. Also 9 | #' contains \code{stopType} which = "o" if observed or "p" for interpolated. 10 | #' 11 | #' The merged data is truncated to the first and last time in the location data 12 | #' set. Missing values in the stopping variable data set can be interpolated by 13 | #' replacing them with zeros (full movement) or first replacing with zeros then 14 | #' using a moving average to smooth the data. Only the missing values are then 15 | #' replace with this smoothed data. This allows a smooth transition to full 16 | #' movement. 17 | #' 18 | #' @param data Location data. 19 | #' @param stopData stopping variable data set. 20 | #' @param Time.name character naming time index variable in both data sets 21 | #' @param interp method of interpolation. 22 | #' @param win window for "ma0" interpolation method. 23 | #' @param constCol columns in \code{data} for which the user would like to be 24 | #' constant, such as id or sex. 25 | #' @return 26 | #' 27 | #' Merged data.frame with new column from \code{stopData}. Missing values in 28 | #' the stopping variable will be interpolated 29 | #' @author Devin S. Johnson 30 | #' @examples 31 | #' 32 | #' 33 | #' track <- data.frame(TimeVar=sort(runif(20,0,20)), x=1:20, y=20:1) 34 | #' track 35 | #' stopData <- data.frame(TimeVar=0:29, stopVar=round(runif(30))) 36 | #' stopData 37 | #' mergeTrackStop(track, stopData, Time.name="TimeVar") 38 | #' 39 | #' @export 40 | "mergeTrackStop" <- function(data, stopData, Time.name="Time", 41 | interp=c('zeros','ma0'), win=2, constCol) 42 | { 43 | interp <- interp[1] 44 | nmsStop <- names(stopData)[!names(stopData) %in% Time.name] 45 | if (length(nmsStop) > 1) stop("You can only merge 1 stopping variable at a time") 46 | stopData <- stopData[order(stopData[, Time.name], stopData[, nmsStop]), ] 47 | stopData <- stopData[!duplicated(stopData[, Time.name]), ] 48 | stopStart <- min(stopData[, Time.name][!is.na(stopData[, nmsStop])]) 49 | stopEnd <- max(stopData[, Time.name]) 50 | trackStart <- min(data[, Time.name]) 51 | trackEnd <- max(data[, Time.name]) 52 | Start <- max(stopStart, trackStart) 53 | End <- min(stopEnd, trackEnd) 54 | if (!missing(constCol)) constVal <- data[1, constCol] 55 | mergeData <- data.frame(seq(floor(Start), ceiling(End), 1)) 56 | names(mergeData) <- Time.name 57 | stopData <- merge(stopData, mergeData, by=Time.name, all=TRUE) 58 | stopData$stopType <- ifelse(is.na(stopData[, nmsStop]), "p", "o") 59 | dtTmp <- ifelse(is.na(stopData[, nmsStop]), 0, stopData[, nmsStop]) 60 | if (interp == "ma0") { 61 | stopTimeAvg <- filter(dtTmp, rep(1 / (2 * win + 1), 2 * win + 1), 62 | "convolution", sides=2) 63 | dtTmp <- ifelse(is.na(stopData[, nmsStop]), stopTimeAvg, stopData[, nmsStop]) 64 | } 65 | stopData[, paste(nmsStop, "Orig", sep="")] <- stopData[, nmsStop] 66 | stopData[, nmsStop] <- ifelse(is.na(dtTmp), 0, dtTmp) 67 | stopData$locType <- "p" 68 | data$locType <- "o" 69 | data <- merge(data, stopData, all=TRUE) 70 | data <- data[order(data[, Time.name]), ] 71 | data <- data[!duplicated(data[, Time.name]), ] 72 | data[, nmsStop] <- round(approx(data[, Time.name], data[, nmsStop], 73 | xout=data[, Time.name], method="constant")$y, digits=3) 74 | pind <- ifelse(data$stopType == "p", 1, 0) 75 | pind <- approx(pind, xout=1:length(pind), method="constant", rule=2)$y 76 | data$stopType <- ifelse(pind == 1, "p", "o") 77 | if (!missing(constCol)) { 78 | for (l in 1:length(constCol)) { 79 | data[, constCol[l]] <- constVal[l] 80 | } 81 | } 82 | out <- data[(data[, Time.name] >= trackStart & data[, Time.name] <= trackEnd), ] 83 | return(out) 84 | } 85 | -------------------------------------------------------------------------------- /R/par2arglist.R: -------------------------------------------------------------------------------- 1 | 2 | #' @author Devin Johnson 3 | #' @importFrom stats var 4 | #' @importFrom utils tail 5 | 6 | par2arglist = function(theta, fixPar, y, noObs, delta, 7 | mov.mf, err.mfX, err.mfY, rho, activity, 8 | n.errX, n.errY, n.mov, driftMod){ 9 | y <- as.matrix(y) 10 | N <- nrow(y) 11 | par <- fixPar 12 | par[is.na(fixPar)] <- theta 13 | 14 | out = vector("list",8) 15 | names(out) = c("Hmat", "b", "sig2", "active", "b.drift", "sig2.drift", "a", "P") 16 | 17 | # Hmat 18 | if (!is.null(err.mfX)) { 19 | theta.errX <- par[1:n.errX] 20 | Hmat <- exp(2 * err.mfX %*% theta.errX) 21 | } else Hmat <- rep(0.0, N) 22 | if (!is.null(err.mfY)) { 23 | theta.errY <- par[(n.errX + 1):(n.errX + n.errY)] 24 | Hmat <- cbind(Hmat,exp(2 * err.mfY %*% theta.errY)) 25 | } else Hmat <- cbind(Hmat, Hmat) 26 | if(!is.null(rho)){ 27 | Hmat = cbind(Hmat, exp(log(Hmat[,1])/2 + log(Hmat[,2])/2)*rho) 28 | } else {Hmat = cbind(Hmat, rep(0,N))} 29 | Hmat[noObs==1,] = 0 30 | out$Hmat = Hmat 31 | 32 | # b, sig2, active 33 | theta.mov <- par[(n.errX + n.errY + 1):(n.errX + n.errY + 2 * n.mov)] 34 | out$sig2 <- exp(2 * (mov.mf %*% theta.mov[1:n.mov])) 35 | out$b <- exp(mov.mf %*% theta.mov[(n.mov + 1):(2 * n.mov)]) 36 | if (!is.null(activity)) { 37 | theta.stop <- par[(n.errX + n.errY + 2 * n.mov + 1)] 38 | out$b <- out$b / ((activity) ^ exp(theta.stop)) 39 | out$sig2 = out$sig2 * ((activity) ^ exp(theta.stop)) 40 | out$active <- ifelse(out$b==Inf, 0, 1) 41 | out$b <- ifelse(out$b==Inf, 0, out$b) 42 | } else { 43 | out$active=rep(1,N) 44 | } 45 | 46 | # b.drift, sig2.drift, a, and P 47 | if (driftMod) { 48 | theta.drift <- par[(n.errX + n.errY + 2 * n.mov + 1): 49 | (n.errX + n.errY + 2 * n.mov + 2)] 50 | out$b.drift <- exp(log(out$b) - log(1+exp(theta.drift[2]))) 51 | out$sig2.drift <- exp(log(out$sig2) + 2 * theta.drift[1]) 52 | out$a = c(y[1,1], 0, 0, y[1,2],0, 0) 53 | out$P = diag(c(var(y[noObs==0,1], na.rm=T), out$sig2[1]*out$b[1]/2, out$sig2.drift[1]*out$b.drift[1]/2, 54 | var(y[noObs==0,2],na.rm=T), out$sig2[1]*out$b[1]/2, out$sig2.drift[1]*out$b.drift[1]/2)) 55 | } else { 56 | out$b.drift = NULL 57 | out$sig2.drift = NULL 58 | out$a = c(y[1,1], 0, y[1,2],0) 59 | out$P = diag(c(var(y[noObs==0,1], na.rm=T), out$sig2[1]*out$b[1]/2, var(y[noObs==0,2],na.rm=T), out$sig2[1]*out$b[1]/2)) 60 | } 61 | return(out) 62 | } -------------------------------------------------------------------------------- /R/print.crwFit.R: -------------------------------------------------------------------------------- 1 | #' @method print crwFit 2 | #' @export 3 | print.crwFit <- function(x, ...) 4 | { 5 | fit <- x 6 | cat("\n\n") 7 | cat("Continuous-Time Correlated Random Walk fit\n\n") 8 | cat('Models:\n') 9 | cat("--------\n") 10 | cat("Movement "); cat(as.character(fit$mov.model)); cat("\n") 11 | cat("Error "); cat(as.character(fit$err.model)); cat("\n") 12 | if (fit$random.drift | !is.null(fit$stop.model)) cat("with ") 13 | if (fit$random.drift) cat("Random Drift") 14 | if (fit$random.drift & !is.null(fit$stop.model)) cat(" and ") 15 | if (!is.null(fit$stop.model)) cat("Movement Stops") 16 | cat("\n\n") 17 | out <- as.data.frame(round(cbind(fit$par, fit$se, fit$ci[, 1], fit$ci[, 2]), 3)) 18 | colnames(out) <- c("Parameter Est.", "St. Err.", "95% Lower", "95% Upper") 19 | rownames(out) <- fit$nms 20 | out[!is.na(fit$fixPar), 2:4] <- "." 21 | print(out) 22 | cat("\n\n") 23 | cat(paste("Log Likelihood =", round(fit$loglik, 3),"\n", collapse="")) 24 | cat(paste("AIC =", round(fit$aic, 3),"\n", collapse="")) 25 | cat("\n\n\n") 26 | } 27 | 28 | -------------------------------------------------------------------------------- /R/run_shiny_apps.R: -------------------------------------------------------------------------------- 1 | # #' @title Start a shiny app to check data stored in a .csv file for model fitting with \code{crwMLE} function. 2 | # #' @description Users can start a beta version of Shiny app that allows for data checking and basic location projection. 3 | # #' @export 4 | # #' @importFrom shiny runApp 5 | # check_csv = function(){ 6 | # appDir <- system.file("shiny_apps", "check_project_data", package = "crawl") 7 | # if (appDir == "") stop("Could not find shiny app directory. Try re-installing `crawl`.", call. = FALSE) 8 | # shiny::runApp(appDir, display.mode = "normal") 9 | # } -------------------------------------------------------------------------------- /R/tidy_crwFit.R: -------------------------------------------------------------------------------- 1 | #' @title tidy-like method for crwFit object 2 | #' 3 | #' @description this function mimics the approach taken by \code{broom::tidy} 4 | #' to present model output parameters in a tidy, data frame structure. 5 | #' @param fit \code{crwFit} object from \code{crawl::crwMLE} 6 | #' @export 7 | tidy_crwFit <- function(fit) { 8 | terms <- data.frame(term = fit$nms) 9 | out <- as.data.frame(round(cbind( 10 | fit$par, fit$se, fit$ci[, 1], fit$ci[, 2]), 3) 11 | ) 12 | 13 | colnames(out) <- c("estimate", 14 | "std.error", 15 | "conf.low", 16 | "conf.high") 17 | out <- cbind(terms,out) 18 | 19 | out <- rbind(out, 20 | data.frame( 21 | term = "logLik", 22 | estimate = fit$loglik, 23 | std.error = NA, 24 | conf.low = NA, 25 | conf.high = NA 26 | ), 27 | data.frame( 28 | term = "AIC", 29 | estimate = fit$aic, 30 | std.error = NA, 31 | conf.low = NA, 32 | conf.high = NA 33 | )) 34 | out 35 | } 36 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: markdown_github 5 | --- 6 | 7 | 8 | 9 | ```{r, echo = FALSE} 10 | knitr::opts_chunk$set( 11 | collapse = TRUE, 12 | comment = "#>", 13 | fig.path = "README-" 14 | ) 15 | ``` 16 | 17 | 18 | [![crawl status badge](https://dsjohnson.r-universe.dev/badges/crawl)](https://dsjohnson.r-universe.dev) 19 | [![R-CMD-check](https://github.com/NMML/crawl/workflows/R-CMD-check/badge.svg)](https://github.com/NMML/crawl/actions) 20 | [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-green.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 21 | 22 | 23 | ## Correlated RAndom Walk Library of R functions 24 |

25 | 26 |     27 | 28 |

29 | 30 | 31 | The [C]orrelated [RA]ndom [W]alk [L]ibrary of R functions was designed for fitting 32 | continuous-time correlated random walk (CTCRW) models with time indexed 33 | covariates. The model is fit using the Kalman-Filter on a state space version of 34 | the continuous-time stochastic movement process. The use case in the estimation 35 | of animal movement paths where the observed locations are determined from 36 | Argos or FastLoc enabled bio-loggers. In addition to the continuous-time 37 | component, `{crawl}` was specifically developed to incorporate the measurement 38 | error often associated with these observed locations. Lastly, `{crawl}` 39 | provides a framework for multiple imputation workflows for incorporation of 40 | model uncertainty. 41 | 42 | ## The Future of crawl 43 | 44 | The original code base and concepts for `{crawl}` were developed almost 15 years 45 | ago. Much has changed in the world of movement ecology, spatial statistics, 46 | R, bio-logging, and many other fields. In some cases, we've done a fairly good 47 | job keeping pace; in other cases, we've fallen behind. We feel it is time for 48 | a new approach and will, from now on, be focusing our development efforts on 49 | other packages and methods. We will continue to maintain `{crawl}`, improve the documentation, 50 | and ensure compatibility with dependent packages. 51 | 52 | ## Installation 53 | 54 | ## Install via CRAN 55 | 56 | `{crawl}` is currently available on CRAN and R >= 4.0 is highly recommended. 57 | 58 | ```{r, eval = FALSE} 59 | # install latest version of crawl from CRAN 60 | install.packages("crawl") 61 | ``` 62 | 63 | However, should `{crawl}` v 2.3.0 fail to pass CRAN checks it will be archived 64 | on CRAN and all future bug and check fixes will only be available on this 65 | repository and the R-universe repository described in the next section. So, if 66 | you cannot find `{crawl}` on CRAN, this has probably happened. 67 | 68 | 69 | ### Install via R-Universe 70 | 71 | The latest version of `{crawl}` is also available via R-Universe. 72 | 73 | ```{r, eval = FALSE} 74 | # Install crawl from my R-Universe repository 75 | # Enable repository from dsjohnson 76 | 77 | options(repos = c( 78 | dsjohnson = 'https://dsjohnson.r-universe.dev', 79 | CRAN = 'https://cloud.r-project.org')) 80 | 81 | # Download and install crawl in R 82 | install.packages('crawl') 83 | 84 | # Browse the crawl manual pages 85 | help(package = 'crawl') 86 | ``` 87 | 88 | You can also add the repository to your local list of repositories in your 89 | *.Rprofile* and this will ensure `update.packages()` pulls any new releases 90 | of `{crawl}` from R-Universe 91 | 92 | ```{r, eval = FALSE} 93 | #install.packages("usethis") 94 | usethis::edit_r_profile() 95 | 96 | # add the following text or replace existing repos option 97 | 98 | options(repos = c(dsjohnson = 'https://dsjohnson.r-universe.dev', 99 | CRAN = 'https://cloud.r-project.org')) 100 | ``` 101 | 102 | ### Install via Github 103 | 104 | A development version of `{crawl}` is also available from 105 | [GitHub](https://github.com/NMML/crawl). This version should be used with 106 | caution and only after consulting with package authors. 107 | 108 | ```{r, eval = FALSE} 109 | # install.packages("remotes") 110 | remotes::install_github("NMML/crawl@devel") 111 | ``` 112 | 113 | ### Disclaimer 114 | This repository is a scientific product and is not official communication of the 115 | National Oceanic and Atmospheric Administration, or the United States Department 116 | of Commerce. All NOAA GitHub project code is provided on an ‘as is’ basis and 117 | the user assumes responsibility for its use. NOAA and DOC have relinquished 118 | control of the information and no longer has responsibility to protect the 119 | integrity, confidentiality, or availability of the information. Any claims 120 | against the Department of Commerce or Department of Commerce bureaus stemming 121 | from the use of this GitHub project will be governed by all applicable Federal 122 | law. Any reference to specific commercial products, processes, or services by 123 | service mark, trademark, manufacturer, or otherwise, does not constitute or 124 | imply their endorsement, recommendation or favoring by the Department of 125 | Commerce. The Department of Commerce seal and logo, or the seal and logo of a 126 | DOC bureau, shall not be used in any manner to imply endorsement of any 127 | commercial product or activity by DOC or the United States Government. 128 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | [![crawl status 5 | badge](https://dsjohnson.r-universe.dev/badges/crawl)](https://dsjohnson.r-universe.dev) 6 | [![R-CMD-check](https://github.com/NMML/crawl/workflows/R-CMD-check/badge.svg)](https://github.com/NMML/crawl/actions) 7 | [![Lifecycle: 8 | stable](https://img.shields.io/badge/lifecycle-stable-green.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 9 | 10 | 11 | ## Correlated RAndom Walk Library of R functions 12 | 13 |

14 |     15 | 16 |

17 | 18 | The \[C\]orrelated \[RA\]ndom \[W\]alk \[L\]ibrary of R functions was 19 | designed for fitting continuous-time correlated random walk (CTCRW) 20 | models with time indexed covariates. The model is fit using the 21 | Kalman-Filter on a state space version of the continuous-time stochastic 22 | movement process. The use case in the estimation of animal movement 23 | paths where the observed locations are determined from Argos or FastLoc 24 | enabled bio-loggers. In addition to the continuous-time component, 25 | `{crawl}` was specifically developed to incorporate the measurement 26 | error often associated with these observed locations. Lastly, `{crawl}` 27 | provides a framework for multiple imputation workflows for incorporation 28 | of model uncertainty. 29 | 30 | ## The Future of crawl 31 | 32 | The original code base and concepts for `{crawl}` were developed almost 33 | 15 years ago. Much has changed in the world of movement ecology, spatial 34 | statistics, R, bio-logging, and many other fields. In some cases, we’ve 35 | done a fairly good job keeping pace; in other cases, we’ve fallen 36 | behind. We feel it is time for a new approach and will, from now on, be 37 | focusing our development efforts on other packages and methods. We will 38 | continue to maintain `{crawl}`, improve the documentation, and ensure 39 | compatibility with dependent packages. 40 | 41 | ## Installation 42 | 43 | ## Install via CRAN 44 | 45 | `{crawl}` is currently available on CRAN and R \>= 4.0 is highly 46 | recommended. 47 | 48 | ``` r 49 | # install latest version of crawl from CRAN 50 | install.packages("crawl") 51 | ``` 52 | 53 | However, should `{crawl}` v 2.3.0 fail to pass CRAN checks it will be 54 | archived on CRAN and all future bug and check fixes will only be 55 | available on this repository and the R-universe repository described in 56 | the next section. So, if you cannot find `{crawl}` on CRAN, this has 57 | probably happened. 58 | 59 | ### Install via R-Universe 60 | 61 | The latest version of `{crawl}` is also available via R-Universe. 62 | 63 | ``` r 64 | # Install crawl from my R-Universe repository 65 | # Enable repository from dsjohnson 66 | 67 | options(repos = c( 68 | dsjohnson = 'https://dsjohnson.r-universe.dev', 69 | CRAN = 'https://cloud.r-project.org')) 70 | 71 | # Download and install crawl in R 72 | install.packages('crawl') 73 | 74 | # Browse the crawl manual pages 75 | help(package = 'crawl') 76 | ``` 77 | 78 | You can also add the repository to your local list of repositories in 79 | your *.Rprofile* and this will ensure `update.packages()` pulls any new 80 | releases of `{crawl}` from R-Universe 81 | 82 | ``` r 83 | #install.packages("usethis") 84 | usethis::edit_r_profile() 85 | 86 | # add the following text or replace existing repos option 87 | 88 | options(repos = c(dsjohnson = 'https://dsjohnson.r-universe.dev', 89 | CRAN = 'https://cloud.r-project.org')) 90 | ``` 91 | 92 | ### Install via Github 93 | 94 | A development version of `{crawl}` is also available from 95 | [GitHub](https://github.com/NMML/crawl). This version should be used 96 | with caution and only after consulting with package authors. 97 | 98 | ``` r 99 | # install.packages("remotes") 100 | remotes::install_github("NMML/crawl@devel") 101 | ``` 102 | 103 | ### Disclaimer 104 | 105 | This repository is a scientific product and is not official 106 | communication of the National Oceanic and Atmospheric Administration, or 107 | the United States Department of Commerce. All NOAA GitHub project code 108 | is provided on an ‘as is’ basis and the user assumes responsibility for 109 | its use. NOAA and DOC have relinquished control of the information and 110 | no longer has responsibility to protect the integrity, confidentiality, 111 | or availability of the information. Any claims against the Department of 112 | Commerce or Department of Commerce bureaus stemming from the use of this 113 | GitHub project will be governed by all applicable Federal law. Any 114 | reference to specific commercial products, processes, or services by 115 | service mark, trademark, manufacturer, or otherwise, does not constitute 116 | or imply their endorsement, recommendation or favoring by the Department 117 | of Commerce. The Department of Commerce seal and logo, or the seal and 118 | logo of a DOC bureau, shall not be used in any manner to imply 119 | endorsement of any commercial product or activity by DOC or the United 120 | States Government. 121 | -------------------------------------------------------------------------------- /data/beardedSeals.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/data/beardedSeals.rda -------------------------------------------------------------------------------- /data/harborSeal.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/data/harborSeal.rda -------------------------------------------------------------------------------- /data/harborSeal_sf.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/data/harborSeal_sf.rda -------------------------------------------------------------------------------- /data/northernFurSeal.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/data/northernFurSeal.rda -------------------------------------------------------------------------------- /hex_sticker/crawl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/hex_sticker/crawl.png -------------------------------------------------------------------------------- /hex_sticker/crocodile_1f40a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/hex_sticker/crocodile_1f40a.png -------------------------------------------------------------------------------- /hex_sticker/hex_sticker.R: -------------------------------------------------------------------------------- 1 | library(hexSticker) 2 | library(magick) 3 | library(sysfonts) 4 | library(tidyverse) 5 | library(here) 6 | 7 | setwd(here("hex_sticker")) 8 | 9 | ally <- image_read("mean_gator.png") 10 | 11 | # font_add_google("Fira Code", "firacode") 12 | font_add_google("Knewave", "knewave") 13 | 14 | sticker( 15 | subplot=ally, 16 | package="crawl", 17 | p_y = 1.4, 18 | p_size = 32, 19 | p_color = "khaki2", 20 | p_family = "knewave", 21 | s_x=1, 22 | s_y=1, 23 | s_width=1.4, 24 | s_height=1.4, 25 | h_fill="skyblue2", 26 | h_color="darkslategray4", 27 | dpi=300 28 | ) 29 | -------------------------------------------------------------------------------- /hex_sticker/mean_gator.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/hex_sticker/mean_gator.png -------------------------------------------------------------------------------- /hex_sticker/noaa.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/NMML/crawl/89ad099738123592b3f98ee1c888d7cf3ae194dc/hex_sticker/noaa.png -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite crawl in publications:") 2 | 3 | citEntry(entry = "article", 4 | title = "Continuous-time correlated random walk model for animal telemetry data", 5 | author = personList(as.person("Devin S. Johnson"), 6 | as.person("Josh M. London"), 7 | as.person("Mary-Anne Lea"), 8 | as.person("John W. Durban")), 9 | journal = "Ecology", 10 | year = "2008", 11 | volume = "89", 12 | number = "5", 13 | pages = "1208-1215", 14 | doi = "10.1890/07-1032.1", 15 | textVersion = 16 | paste("Johnson, D. S., London, J. M., Lea, M.-A. and Durban, J. W. (2008)", 17 | "Continuous-time correlated random walk model for animal telemetry data.", 18 | "Ecology, 89: 1208-1215.") 19 | ) 20 | 21 | citEntry(entry = "misc", 22 | title = "crawl: an R package for fitting continuous-time correlated 23 | random walk models to animal movement data", 24 | author = personList(as.person("Devin S. Johnson"), 25 | as.person("Josh M. London")), 26 | year = "2018", 27 | doi = "10.5281/zenodo.596464", 28 | url = "https://doi.org/10.5281/zenodo.596464", 29 | textVersion = 30 | paste("Devin S. Johnson and Josh M. London (2018).", 31 | "crawl: an R package for fitting continuous-time correlated 32 | random walk models to animal movement data.", 33 | "Zenodo. https://doi.org/10.5281/zenodo.596464") 34 | ) 35 | -------------------------------------------------------------------------------- /man/aic.crw.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aic.crw.R 3 | \name{aic.crw} 4 | \alias{aic.crw} 5 | \title{Calculates AIC for all objects of class crwFit listed as arguments} 6 | \usage{ 7 | aic.crw(...) 8 | } 9 | \arguments{ 10 | \item{\dots}{a series of crwFit objects} 11 | } 12 | \value{ 13 | A table, sorted from lowest AIC value to highest. 14 | } 15 | \description{ 16 | AIC, delta AIC, and Akaike weights for all models listed as arguments. 17 | } 18 | \details{ 19 | The function can either be executed with a series of 'crwFit' objects (see 20 | \code{\link{crwMLE}}) without the '.crwFit' suffix or the function can be 21 | called without any arguments and it will search out all 'crwFit' objects in 22 | the current workspace and produce the model selection table for all 'crwFit' 23 | objects in the workspace. Caution should be used when executing the function 24 | in this way. ALL 'crwFit' objects will be included whether or not the same 25 | locations are used! For all of the models listed as arguments (or in the 26 | workspace), AIC, delta AIC, and Akaike weights will be calculated. 27 | } 28 | \author{ 29 | Devin S. Johnson 30 | } 31 | -------------------------------------------------------------------------------- /man/argosDiag2Cov.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/argosDiag2Cov.R 3 | \name{argosDiag2Cov} 4 | \alias{argosDiag2Cov} 5 | \title{Transform Argos diagnostic data to covariance matrix form} 6 | \usage{ 7 | argosDiag2Cov(Major, Minor, Orientation) 8 | } 9 | \arguments{ 10 | \item{Major}{A vector containing the major axis information for each observation (na values are ok)} 11 | 12 | \item{Minor}{A vector containing the minor axis information for each observation (na values are ok)} 13 | 14 | \item{Orientation}{A vector containing the angle orientation of the Major axis from North (na values are ok)} 15 | } 16 | \value{ 17 | A \code{data.frame} with the following columns 18 | \item{ln.sd.x}{The log standard deviation of the location error in the x coordinate} 19 | \item{ln.sd.y}{The log standard deviation of the location error in the x coordinate} 20 | \item{rho}{The correlation of the bivariate location error ellipse} 21 | } 22 | \description{ 23 | Using this function the user can transform the Argos diagnostic data for location 24 | error into a form usable as a covariance matrix to approximate the location error with a 25 | bivariate Gaussian distribution. The resulting data.frame should be attached back to the data 26 | with \code{cbind} to use with the \code{crwMLE} function. 27 | } 28 | \author{ 29 | Devin S. Johnson 30 | } 31 | -------------------------------------------------------------------------------- /man/as.flat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllMethod.R 3 | \name{as.flat} 4 | \alias{as.flat} 5 | \title{'Flattening' a list-form crwPredict object into a data.frame} 6 | \usage{ 7 | as.flat(predObj) 8 | } 9 | \arguments{ 10 | \item{predObj}{A crwPredict object} 11 | } 12 | \value{ 13 | a \code{\link{data.frame}} version of a crwPredict list with columns 14 | for the state standard errors 15 | } 16 | \description{ 17 | \dQuote{Flattens} a list form \code{\link{crwPredict}} object into a flat 18 | data.frame. 19 | } 20 | \seealso{ 21 | \code{\link{northernFurSeal}} for use example 22 | } 23 | \author{ 24 | Devin S. Johnson 25 | } 26 | -------------------------------------------------------------------------------- /man/beardedSeals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \docType{data} 4 | \name{beardedSeals} 5 | \alias{beardedSeals} 6 | \title{Bearded Seal Location Data} 7 | \format{ 8 | A data frame with 27,548 observations on 3 bearded seals in Alaska: 9 | 10 | \describe{ 11 | \item{deployid}{Unique animal ID} 12 | \item{ptt}{Hardware ID} 13 | \item{instr}{Hardware type} 14 | \item{date_time}{Time of location} 15 | \item{type}{Location type} 16 | \item{quality}{Argos location quality} 17 | \item{latitude}{Observed latitude} 18 | \item{longitude}{Observed longitude} 19 | \item{error_radius}{Argos error radius} 20 | \item{error_semimajor_axis}{Argos error ellipse major axis length} 21 | \item{error_semiminor_axis}{Argos error ellipse minor axis length} 22 | \item{error_ellipse_orientation}{Argos error ellipse degree orientation} 23 | } 24 | } 25 | \source{ 26 | Marine Mammal Laboratory, Alaska 27 | Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 28 | Point Way NE Seattle, WA 98115 29 | } 30 | \description{ 31 | Bearded Seal Location Data 32 | } 33 | \keyword{datasets} 34 | -------------------------------------------------------------------------------- /man/crawl-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \docType{package} 4 | \name{crawl-package} 5 | \alias{crawl-package} 6 | \alias{crawl} 7 | \title{Fit Continuous-Time Correlated Random Walk Models to Animal Movement Data} 8 | \description{ 9 | The [C]orrelated [RA]ndom [W]alk [L]ibrary (I know it is not an R library, 10 | but, "crawp" did not sound as good) of R functions was designed for fitting 11 | continuous-time correlated random walk (CTCRW) models with time indexed 12 | covariates. The model is fit using the Kalman-Filter on a state space 13 | version of the continuous-time stochastic movement process. 14 | 15 | \tabular{ll}{ 16 | Package: \tab crawl\cr 17 | Type: \tab Package\cr 18 | Version: \tab 2.3.1\cr 19 | Date: \tab October 3, 2024\cr 20 | License: \tab CC0 \cr 21 | LazyLoad: \tab yes\cr 22 | } 23 | } 24 | \note{ 25 | This software package is developed and maintained by scientists at the NOAA Fisheries Alaska 26 | Fisheries Science Center and should be considered a fundamental research communication. 27 | The recommendations and conclusions presented here are those of 28 | the authors and this software should not be construed as official communication by NMFS, NOAA, 29 | or the U.S. Dept. of Commerce. In addition, reference to trade names does not imply endorsement by the 30 | National Marine Fisheries Service, NOAA. While the best efforts have been made to insure the 31 | highest quality, tools such as this are under constant development and are subject to change. 32 | } 33 | \references{ 34 | Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 35 | Continuous-time correlated random walk model for animal telemetry data. 36 | Ecology 89(5) 1208-1215. 37 | } 38 | \seealso{ 39 | Useful links: 40 | \itemize{ 41 | \item \url{https://github.com/NMML/crawl} 42 | \item Report bugs at \url{https://github.com/NMML/crawl/issues} 43 | } 44 | 45 | } 46 | \author{ 47 | Josh London and Devin S. Johnson 48 | 49 | Maintainer: Devin S. Johnson 50 | } 51 | -------------------------------------------------------------------------------- /man/crwMLE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwMLE.R 3 | \name{crwMLE} 4 | \alias{crwMLE} 5 | \alias{crwMLE.default} 6 | \alias{crwMLE.SpatialPoints} 7 | \alias{crwMLE.sf} 8 | \title{Fit Continuous-Time Correlated Random Walk Models to Animal Telemetry Data} 9 | \usage{ 10 | crwMLE(data, ...) 11 | 12 | \method{crwMLE}{default}( 13 | data, 14 | mov.model = ~1, 15 | err.model = NULL, 16 | activity = NULL, 17 | drift = FALSE, 18 | coord = c("x", "y"), 19 | proj = NULL, 20 | Time.name = "time", 21 | time.scale = NULL, 22 | theta = NULL, 23 | fixPar = NULL, 24 | method = "Nelder-Mead", 25 | control = NULL, 26 | constr = list(lower = -Inf, upper = Inf), 27 | prior = NULL, 28 | need.hess = TRUE, 29 | initialSANN = list(maxit = 200), 30 | attempts = 1, 31 | retrySD = 1, 32 | skip_check = FALSE, 33 | ... 34 | ) 35 | 36 | \method{crwMLE}{SpatialPoints}( 37 | data, 38 | mov.model = ~1, 39 | err.model = NULL, 40 | activity = NULL, 41 | drift = FALSE, 42 | Time.name = "time", 43 | time.scale = NULL, 44 | theta = NULL, 45 | fixPar = NULL, 46 | method = "Nelder-Mead", 47 | control = NULL, 48 | constr = list(lower = -Inf, upper = Inf), 49 | prior = NULL, 50 | need.hess = TRUE, 51 | initialSANN = list(maxit = 200), 52 | attempts = 1, 53 | retrySD = 1, 54 | skip_check = FALSE, 55 | coord = NULL, 56 | ... 57 | ) 58 | 59 | \method{crwMLE}{sf}( 60 | data, 61 | mov.model = ~1, 62 | err.model = NULL, 63 | activity = NULL, 64 | drift = FALSE, 65 | Time.name = "time", 66 | time.scale = NULL, 67 | theta = NULL, 68 | fixPar = NULL, 69 | method = "Nelder-Mead", 70 | control = NULL, 71 | constr = list(lower = -Inf, upper = Inf), 72 | prior = NULL, 73 | need.hess = TRUE, 74 | initialSANN = list(maxit = 200), 75 | attempts = 1, 76 | retrySD = 1, 77 | skip_check = FALSE, 78 | ... 79 | ) 80 | } 81 | \arguments{ 82 | \item{data}{a data set of location observations as a data.frame, tibble, 83 | SpatialPointsDataFrame ('sp' package), or a data.frame of class 'sf' that 84 | contains a geometry column of type \code{sfc_POINT}} 85 | 86 | \item{...}{further arguments passed to or from other methods} 87 | 88 | \item{mov.model}{formula object specifying the time indexed covariates for 89 | movement parameters.} 90 | 91 | \item{err.model}{A 2-element list of formula objects specifying the time 92 | indexed covariates for location error parameters.} 93 | 94 | \item{activity}{formula object giving the covariate for the activity (i.e., stopped or fully moving) 95 | portion of the model.} 96 | 97 | \item{drift}{logical indicating whether or not to include a random 98 | drift component. For most data this is usually not necessary. See \code{\link{northernFurSeal}} for an example 99 | using a drift model.} 100 | 101 | \item{coord}{A 2-vector of character values giving the names of the "X" and 102 | "Y" coordinates in \code{data}. Ignored if \code{data} inherits class 103 | 'sf' or 'sp'.} 104 | 105 | \item{proj}{A valid epsg integer code or proj4string for \code{data} that does not 106 | inherit either 'sf' or 'sp'. A valid 'crs' list is also accepted. Otherwise, ignored.} 107 | 108 | \item{Time.name}{character indicating name of the location time column. It is 109 | strongly preferred that this column be of type POSIXct and in UTC.} 110 | 111 | \item{time.scale}{character. Scale for conversion of POSIX time to numeric 112 | for modeling. Defaults to "hours" and most users will not need to change this.} 113 | 114 | \item{theta}{starting values for parameter optimization.} 115 | 116 | \item{fixPar}{Values of parameters which are held fixed to the given value.} 117 | 118 | \item{method}{Optimization method that is passed to \code{\link{optim}}.} 119 | 120 | \item{control}{Control list which is passed to \code{\link{optim}}.} 121 | 122 | \item{constr}{Named list with elements \code{lower} and \code{upper} that 123 | are vectors the same length as theta giving the box constraints for the 124 | parameters} 125 | 126 | \item{prior}{A function returning the log-density function of the parameter 127 | prior distribution. THIS MUST BE A FUNCTION OF ONLY THE FREE PARAMETERS. Any 128 | fixed parameters should not be included.} 129 | 130 | \item{need.hess}{A logical value which decides whether or not to evaluate 131 | the Hessian for parameter standard errors} 132 | 133 | \item{initialSANN}{Control list for \code{\link{optim}} when simulated 134 | annealing is used for obtaining start values. See details} 135 | 136 | \item{attempts}{The number of times likelihood optimization will be 137 | attempted in cases where the fit does not converge or is otherwise non-valid} 138 | 139 | \item{retrySD}{optional user-provided standard deviation for adjusting 140 | starting values when attempts > 1. Default value is 1.} 141 | 142 | \item{skip_check}{Skip the likelihood optimization check and return the fitted values. 143 | Can be useful for debugging problem fits.} 144 | } 145 | \value{ 146 | A list with the following elements: 147 | \item{par}{Parameter maximum likelihood estimates (including fixed parameters)} 148 | \item{estPar}{MLE without fixed parameters} 149 | \item{se}{Standard error of MLE} 150 | \item{ci}{95\% confidence intervals for parameters} 151 | \item{Cmat}{Parameter covariance matrix} 152 | \item{loglik}{Maximized log-likelihood value} 153 | \item{aic}{Model AIC value} 154 | \item{coord}{Coordinate names provided for fitting} 155 | \item{fixPar}{Fixed parameter values provided} 156 | \item{convergence}{Indicator of convergence (0 = converged)} 157 | \item{message}{Messages given by \code{optim} during parameter optimization} 158 | \item{activity}{Model provided for stopping variable} 159 | \item{drift}{Logical value indicating random drift model} 160 | \item{mov.model}{Model description for movement component} 161 | \item{err.model}{Model description for location error component} 162 | \item{n.par}{number of parameters} 163 | \item{nms}{parameter names} 164 | \item{n.mov}{number of movement parameters} 165 | \item{n.errX}{number or location error parameters for ``longitude'' error model} 166 | \item{n.errY}{number or location error parameters for ``latitude'' error model} 167 | \item{stop.mf}{covariate for stop indication in stopping models} 168 | \item{polar.coord}{Logical indicating coordinates are polar latitude and longitude} 169 | \item{init}{Initial values for parameter optimization} 170 | \item{data}{Original data.frame used to fit the model} 171 | \item{lower}{The lower parameter bounds} 172 | \item{upper}{The upper parameter bounds} 173 | \item{need.hess}{Logical value} 174 | \item{runTime}{Time used to fit model} 175 | } 176 | \description{ 177 | The function uses the Kalman filter to estimate movement parameters in a 178 | state-space version of the continuous-time movement model. Separate models 179 | are specified for movement portion and the location error portion. Each 180 | model can depend on time indexed covariates. A \dQuote{haul out} model where 181 | movement is allowed to completely stop, as well as, a random drift model can 182 | be fit with this function. 183 | } 184 | \details{ 185 | \itemize{ 186 | \item A full model specification involves 4 components: a movement model, an 187 | activity model, 2 location error models, and a drift indication. The 188 | movement model (\code{mov.model}) specifies how the movement parameters 189 | should vary over time. This is a function of specified, time-indexed, 190 | covariates. The movement parameters (sigma for velocity variation and beta 191 | for velocity autocorrelation) are both modeled with a log link as par = 192 | exp(eta), where eta is the linear predictor based on the covariates. The 193 | \code{err.model} specification is a list of 2 such models, one for 194 | \dQuote{X (longitude)} and one for \dQuote{Y (latitude)} (in that order) location 195 | error. If only one location error model is given, it is used for both 196 | coordinates (parameter values as well). If \code{drift.model} is set to 197 | \code{TRUE}, then, 2 additional parameters are estimated for the drift 198 | process, a drift variance and a beta multiplier. 199 | 200 | \item \code{theta} and \code{fixPar} are vectors with the appropriate number or 201 | parameters. \code{theta} contains only those parameters which are to be 202 | estimated, while \code{fixPar} contains all parameter values with \code{NA} 203 | for parameters which are to be estimated. 204 | 205 | \item The data set specified by \code{data} must contain a numeric or POSIXct column which is 206 | used as the time index for analysis. The column name is specified by the 207 | \code{Time.name} argument and it is strongly suggested that this column be of 208 | POSIXct type and in UTC. If a POSIXct column is used it is internally converted to a 209 | numeric vector with units of \code{time.scale}. \code{time.scale} defaults to 210 | NULL and an appropriate option will be chosen ("seconds","minutes","days","weeks") 211 | based on the median time interval. The user can override this by specifying one 212 | of those time intervals directly. If a numeric time vector is used, then 213 | the \code{time.scale} is ignored and there 214 | is no adjustment to the data. Also, for activity models, the 215 | activity covariate must be between 0 and 1 inclusive, with 0 representing complete stop 216 | of the animal (no true movement, however, location error can still occur) and 1 217 | represent unhindered movement. The coordinate location should have \code{NA} where no 218 | location is recorded, but there is a change in the movement covariates. 219 | 220 | \item The CTCRW models can be difficult to provide good initial values for 221 | optimization. If \code{initialSANN} is specified then simulated annealing is 222 | used first to obtain starting values for the specified optimization method. 223 | If simulated annealing is used first, then the returned \code{init} list of 224 | the crwFit object will be a list with the results of the simulated annealing 225 | optimization. 226 | 227 | \item The \code{attempts} argument instructs \code{crwMLE} to attempt a fit 228 | multiple times. Each time, the fit is inspected for convergence, whether 229 | the covariance matrix could be calculated, negative values in the diag 230 | of the covariance matrix, or NA values in the standard errors. If, after 231 | n attempts, the fit is still not valid a \code{simpleError} object is 232 | returned. Users should consider increasing the number of attempts OR 233 | adjusting the standard deviation value for each attempt by setting 234 | \code{retrySD}. The default value for \code{retrySD} is 1, but users may 235 | need to increase or decrease to find a valid fit. Adjusting other 236 | model parameters may also be required. 237 | } 238 | } 239 | \author{ 240 | Devin S. Johnson, Josh M. London 241 | } 242 | -------------------------------------------------------------------------------- /man/crwN2ll.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwN2ll.R 3 | \name{crwN2ll} 4 | \alias{crwN2ll} 5 | \title{-2 * log-likelihood for CTCRW models} 6 | \usage{ 7 | crwN2ll( 8 | theta, 9 | fixPar, 10 | y, 11 | noObs, 12 | delta, 13 | mov.mf, 14 | err.mfX, 15 | err.mfY, 16 | rho = NULL, 17 | activity = NULL, 18 | n.errX, 19 | n.errY, 20 | n.mov, 21 | driftMod, 22 | prior, 23 | need.hess, 24 | constr = list(lower = -Inf, upper = Inf) 25 | ) 26 | } 27 | \arguments{ 28 | \item{theta}{parameter values.} 29 | 30 | \item{fixPar}{values of parameters held fixed (contains \code{NA} for 31 | \code{theta} values).} 32 | 33 | \item{y}{N by 2 matrix of coordinates with the longitude coordinate in the first column.} 34 | 35 | \item{noObs}{vector with 1 for unobserved locations, and 0 for observed locations.} 36 | 37 | \item{delta}{time difference to next location.} 38 | 39 | \item{mov.mf}{Movement covariate data.} 40 | 41 | \item{err.mfX}{longitude error covariate data.} 42 | 43 | \item{err.mfY}{latitude error covariate data.} 44 | 45 | \item{rho}{A vector of known correlation coefficients for the error model, typically used for modern ARGOS data.} 46 | 47 | \item{activity}{Stopping covariate (= 0 if animal is not moving).} 48 | 49 | \item{n.errX}{number or longitude error parameters.} 50 | 51 | \item{n.errY}{number of latitude error parameters.} 52 | 53 | \item{n.mov}{number or movement parameters.} 54 | 55 | \item{driftMod}{Logical. indicates whether a drift model is specified.} 56 | 57 | \item{prior}{Function of theta that returns the log-density of the prior} 58 | 59 | \item{need.hess}{Whether or not the Hessian will need to be calculated from 60 | this call} 61 | 62 | \item{constr}{Named list giving the parameter constraints} 63 | } 64 | \value{ 65 | -2 * log-likelihood value for specified CTCRW model. 66 | } 67 | \description{ 68 | This function is designed for primary use within the \code{\link{crwMLE}} 69 | model fitting function. But, it can be accessed for advanced \code{R} and 70 | \code{crawl} users. Uses the state-space parameterization and Kalman filter 71 | method presented in Johnson et al. (2008). 72 | } 73 | \details{ 74 | This function calls compiled C++ code which can be viewed in the 75 | \code{src} directory of the crawl source package. 76 | } 77 | \references{ 78 | Johnson, D., J. London, M. -A. Lea, and J. Durban. 2008. 79 | Continuous-time model for animal telemetry data. Ecology 89:1208-1215. 80 | } 81 | \seealso{ 82 | \code{\link{crwMLE}} 83 | } 84 | \author{ 85 | Devin S. Johnson 86 | } 87 | -------------------------------------------------------------------------------- /man/crwPostIS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwPostIS.R 3 | \name{crwPostIS} 4 | \alias{crwPostIS} 5 | \title{Simulate a value from the posterior distribution of a CTCRW model} 6 | \usage{ 7 | crwPostIS(object.sim, fullPost = TRUE, df = Inf, scale = 1, thetaSamp = NULL) 8 | } 9 | \arguments{ 10 | \item{object.sim}{A crwSimulator object from \code{\link{crwSimulator}}.} 11 | 12 | \item{fullPost}{logical. Draw parameter values as well to simulate full 13 | posterior} 14 | 15 | \item{df}{degrees of freedom for multivariate t distribution approximation 16 | to parameter posterior} 17 | 18 | \item{scale}{Extra scaling factor for t distribution approximation} 19 | 20 | \item{thetaSamp}{If multiple parameter samples are available in object.sim, 21 | setting \code{thetaSamp=n} will use the nth sample. Defaults to the last.} 22 | } 23 | \value{ 24 | List with the following elements: 25 | 26 | \item{alpha.sim.y}{A matrix a simulated latitude state values} 27 | 28 | \item{alpha.sim.x}{Matrix of simulated longitude state values} 29 | 30 | \item{locType}{Indicates prediction types with a "p" or observation times 31 | with an "o"} \item{Time}{Initial state covariance for latitude} 32 | 33 | \item{loglik}{log likelihood of simulated parameter} 34 | 35 | \item{par}{Simulated parameter value} 36 | 37 | \item{log.isw}{non normalized log importance sampling weight} 38 | } 39 | \description{ 40 | The crwPostIS draws a set of states from the posterior distribution of a 41 | fitted CTCRW model. The draw is either conditioned on the fitted parameter 42 | values or "full" posterior draw with approximated parameter posterior 43 | } 44 | \details{ 45 | The crwPostIS draws a posterior sample of the track state matrices. If 46 | fullPost was set to TRUE when the object.sim was build in 47 | \link{crwSimulator} then a pseudo-posterior draw will be made by first 48 | sampling a parameter value from a multivariate t distribution which 49 | approximates the marginal posterior distribution of the parameters. The 50 | covariance matrix from the fitted model object is used to scale the MVt 51 | approximation. In addition, the factor "scale" can be used to further adjust 52 | the approximation. Further, the parameter simulations are centered on the 53 | fitted values. 54 | 55 | To correct for the MVt approximation, the importance sampling weight is also 56 | supplied. When calculating averages of track functions for Bayes estimates 57 | one should use the importance sampling weights to calculate a weighted 58 | average (normalizing first, so the weights sum to 1). 59 | } 60 | \seealso{ 61 | See \code{demo(northernFurSealDemo)} for example. 62 | } 63 | \author{ 64 | Devin S. Johnson 65 | } 66 | -------------------------------------------------------------------------------- /man/crwPredict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwPredict.R 3 | \name{crwPredict} 4 | \alias{crwPredict} 5 | \title{Predict animal locations and velocities using a fitted CTCRW model and 6 | calculate measurement error fit statistics} 7 | \usage{ 8 | crwPredict(object.crwFit, predTime = NULL, return.type = "minimal", ...) 9 | } 10 | \arguments{ 11 | \item{object.crwFit}{A model object from \code{\link{crwMLE}}.} 12 | 13 | \item{predTime}{vector of desired prediction times (numeric or POSIXct). Alternatively, a character vector specifying a time interval (see Details).} 14 | 15 | \item{return.type}{character. Should be one of \code{"minimal","flat","list"} (see Details).} 16 | 17 | \item{...}{Additional arguments for testing new features} 18 | } 19 | \value{ 20 | There are three possible return types specified with \code{return.type}: 21 | 22 | \item{minimal}{a data.frame with a minimal set of columns: 23 | \code{date_time,mu.x,mu.y,se.mu.x,se.mu.y}} 24 | 25 | \item{flat}{a data set is returned with the 26 | columns of the original data plus the state estimates, standard errors (se), 27 | and speed estimates} 28 | 29 | \item{list}{List with the following elements:} 30 | 31 | \item{originalData}{A data.frame with \code{data} merged with 32 | \code{predTime}.} 33 | 34 | \item{alpha.hat}{Predicted state} 35 | 36 | \item{Var.hat}{array where \code{Var.hat[,,i]} is the prediction 37 | covariance matrix for \code{alpha.hat[,i]}.} 38 | } 39 | \description{ 40 | The \code{crwMEfilter} function uses a fitted model object from 41 | \code{crwMLE} to predict animal locations (with estimated uncertainty) at 42 | times in the original data set and supplemented by times in \code{predTime}. 43 | If \code{speedEst} is set to \code{TRUE}, then animal log-speed is also 44 | estimated. In addition, the measurement error shock detection filter of de 45 | Jong and Penzer (1998) is also calculated to provide a measure for outlier 46 | detection. 47 | } 48 | \details{ 49 | The requirements for \code{data} are the same as those for fitting the model 50 | in \code{\link{crwMLE}}. 51 | 52 | \code{predTime} can be either passed as a separate vector of POSIXct or 53 | numeric values for all prediction times expected in the returned object. 54 | Note, previous versions of \code{crwPredict} would return both times 55 | specified via \code{predTime} as well as each original observed time. This is 56 | no longer the default (see \code{return.type}). If the original data were 57 | provided as a POSIXct type, then \code{crwPredict} can derive a sequence of 58 | regularly spaced prediction times from the original data. This is specified 59 | by providing a character string that corresponds to the \code{by} argument 60 | of the \code{seq.POSIXt} function (e.g. '1 hour', '30 mins'). 61 | \code{crwPredict} will round the first observed time up to the nearest unit 62 | (e.g. '1 hour' will round up to the nearest hour, '30 mins' will round up to 63 | the nearest minute) and start the sequence from there. The last observation 64 | time is truncated down to the nearest unit to specify the end time. 65 | } 66 | \references{ 67 | de Jong, P. and Penzer, J. (1998) Diagnosing shocks in time 68 | series. Journal of the American Statistical Association 93:796-806. 69 | } 70 | \author{ 71 | Devin S. Johnson 72 | } 73 | -------------------------------------------------------------------------------- /man/crwPredictPlot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwPredictPlot.R 3 | \name{crwPredictPlot} 4 | \alias{crwPredictPlot} 5 | \title{Plot CRW predicted object} 6 | \usage{ 7 | crwPredictPlot(object, plotType = "ll", ...) 8 | } 9 | \arguments{ 10 | \item{object}{\code{crwPredict} object.} 11 | 12 | \item{plotType}{type of plot has to be one of the following: \dQuote{map} or 13 | \dQuote{ll} (default).} 14 | 15 | \item{...}{Further arguments passed to plotting commands.} 16 | } 17 | \value{ 18 | A plot. 19 | } 20 | \description{ 21 | Creates 2 types of plots of a crwPredict object: a plot of both coordinate 22 | axes with prediction intervals and a plot of just observed locations and 23 | predicted locations. 24 | } 25 | \seealso{ 26 | See \code{demo(northernFurSealDemo)} for additional examples. 27 | } 28 | \author{ 29 | Devin S. Johnson and Sebastian Luque 30 | } 31 | -------------------------------------------------------------------------------- /man/crwSamplePar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwSamplePar.R 3 | \name{crwSamplePar} 4 | \alias{crwSamplePar} 5 | \title{Create a weighted importance sample for posterior predictive track 6 | simulation.} 7 | \usage{ 8 | crwSamplePar( 9 | object.sim, 10 | method = "IS", 11 | size = 1000, 12 | df = Inf, 13 | grid.eps = 1, 14 | crit = 2.5, 15 | scale = 1, 16 | quad.ask = T, 17 | force.quad 18 | ) 19 | } 20 | \arguments{ 21 | \item{object.sim}{A simulation object from \code{\link{crwSimulator}}.} 22 | 23 | \item{method}{Method for obtaining weights for movement parameter samples} 24 | 25 | \item{size}{Size of the parameter importance sample} 26 | 27 | \item{df}{Degrees of freedom for the t approximation to the parameter 28 | posterior} 29 | 30 | \item{grid.eps}{Grid size for \code{method="quadrature"}} 31 | 32 | \item{crit}{Criterion for deciding "significance" of quadrature points 33 | (difference in log-likelihood)} 34 | 35 | \item{scale}{Scale multiplier for the covariance matrix of the t 36 | approximation} 37 | 38 | \item{quad.ask}{Logical, for method='quadrature'. Whether or not the sampler 39 | should ask if quadrature sampling should take place. It is used to stop the 40 | sampling if the number of likelihood evaluations would be extreme.} 41 | 42 | \item{force.quad}{A logical indicating whether or not to force the execution 43 | of the quadrature method for large parameter vectors.} 44 | } 45 | \value{ 46 | List with the following elements: 47 | 48 | \item{x}{Longitude coordinate with NA at prediction times} 49 | 50 | \item{y}{Similar to above for latitude} 51 | 52 | \item{locType}{Indicates prediction types with a "p" or observation times 53 | with an "o"} \item{P1.y}{Initial state covariance for latitude} 54 | 55 | \item{P1.x}{Initial state covariance for longitude} 56 | 57 | \item{a1.y}{Initial latitude state} 58 | 59 | \item{a1.x}{Initial longitude state} 60 | 61 | \item{n.errX}{number of longitude error model parameters} 62 | 63 | \item{n.errY}{number of latitude error model parameters} 64 | 65 | \item{delta}{vector of time differences} 66 | 67 | \item{driftMod}{Logical. indicates random drift model} 68 | 69 | \item{stopMod}{Logical. Indicated stop model fitted} 70 | 71 | \item{stop.mf}{stop model design matrix} 72 | 73 | \item{err.mfX}{Longitude error model design matrix} 74 | 75 | \item{err.mfY}{Latitude error model design matrix} 76 | 77 | \item{mov.mf}{Movement model design matrix} 78 | 79 | \item{fixPar}{Fixed values for parameters in model fitting} 80 | 81 | \item{Cmat}{Covariance matrix for parameter sampling distribution} 82 | 83 | \item{Lmat}{Cholesky decomposition of Cmat} 84 | 85 | \item{par}{fitted parameter values} 86 | 87 | \item{N}{Total number of locations} 88 | 89 | \item{loglik}{log likelihood of the fitted model} 90 | 91 | \item{Time}{vector of observation times} 92 | 93 | \item{coord}{names of coordinate vectors in original data} 94 | 95 | \item{Time.name}{Name of the observation times vector in the original data} 96 | 97 | \item{thetaSampList}{A list containing a data frame of parameter vectors and 98 | their associated probabilities for a resample} 99 | } 100 | \description{ 101 | The \code{crwSamplePar} function uses a fitted model object from 102 | \code{crwMLE} and a set of prediction times to construct a list from which 103 | \code{\link{crwPostIS}} will draw a sample from either the posterior 104 | distribution of the state vectors conditional on fitted parameters or a full 105 | posterior draw from an importance sample of the parameters. 106 | } 107 | \details{ 108 | The crwSamplePar function uses the information in a 109 | \code{\link{crwSimulator}} object to create a set of weights for importance 110 | sample-resampling of parameters in a full posterior sample of parameters and 111 | locations using \code{\link{crwPostIS}}. This function is usually called 112 | from \code{\link{crwPostIS}}. The average user should have no need to call 113 | this function directly. 114 | } 115 | \seealso{ 116 | See \code{demo(northernFurSealDemo)} for example. 117 | } 118 | \author{ 119 | Devin S. Johnson 120 | } 121 | -------------------------------------------------------------------------------- /man/crwSimulator.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crwSimulator.R 3 | \name{crwSimulator} 4 | \alias{crwSimulator} 5 | \title{Construct a posterior simulation object for the CTCRW state vectors} 6 | \usage{ 7 | crwSimulator( 8 | object.crwFit, 9 | predTime = NULL, 10 | method = "IS", 11 | parIS = 1000, 12 | df = Inf, 13 | grid.eps = 1, 14 | crit = 2.5, 15 | scale = 1, 16 | quad.ask = TRUE, 17 | force.quad 18 | ) 19 | } 20 | \arguments{ 21 | \item{object.crwFit}{A model object from \code{\link{crwMLE}}.} 22 | 23 | \item{predTime}{vector of additional prediction times.} 24 | 25 | \item{method}{Method for obtaining weights for movement parameter samples} 26 | 27 | \item{parIS}{Size of the parameter importance sample} 28 | 29 | \item{df}{Degrees of freedom for the t approximation to the parameter 30 | posterior} 31 | 32 | \item{grid.eps}{Grid size for \code{method="quadrature"}} 33 | 34 | \item{crit}{Criterion for deciding "significance" of quadrature points 35 | (difference in log-likelihood)} 36 | 37 | \item{scale}{Scale multiplier for the covariance matrix of the t 38 | approximation} 39 | 40 | \item{quad.ask}{Logical, for method='quadrature'. Whether or not the sampler 41 | should ask if quadrature sampling should take place. It is used to stop the 42 | sampling if the number of likelihood evaluations would be extreme.} 43 | 44 | \item{force.quad}{A logical indicating whether or not to force the execution 45 | of the quadrature method for large parameter vectors.} 46 | } 47 | \value{ 48 | List with the following elements: 49 | 50 | \item{x}{Longitude coordinate with NA at prediction times} 51 | 52 | \item{y}{Similar to above for latitude} 53 | 54 | \item{locType}{Indicates prediction types with a "p" or observation times 55 | with an "o"} \item{P1.y}{Initial state covariance for latitude} 56 | 57 | \item{P1.x}{Initial state covariance for longitude} 58 | 59 | \item{a1.y}{Initial latitude state} 60 | 61 | \item{a1.x}{Initial longitude state} 62 | 63 | \item{n.errX}{number of longitude error model parameters} 64 | 65 | \item{n.errY}{number of latitude error model parameters} 66 | 67 | \item{delta}{vector of time differences} 68 | 69 | \item{driftMod}{Logical. indicates random drift model} 70 | 71 | \item{stopMod}{Logical. Indicated stop model fitted} 72 | 73 | \item{stop.mf}{stop model design matrix} 74 | 75 | \item{err.mfX}{Longitude error model design matrix} 76 | 77 | \item{err.mfY}{Latitude error model design matrix} 78 | 79 | \item{mov.mf}{Movement model design matrix} 80 | 81 | \item{fixPar}{Fixed values for parameters in model fitting} 82 | 83 | \item{Cmat}{Covaraince matrix for parameter sampling distribution} 84 | 85 | \item{Lmat}{Cholesky decomposition of Cmat} 86 | 87 | \item{par}{fitted parameter values} 88 | 89 | \item{N}{Total number of locations} 90 | 91 | \item{loglik}{log likelihood of the fitted model} 92 | 93 | \item{Time}{vector of observation times} 94 | 95 | \item{coord}{names of coordinate vectors in original data} 96 | 97 | \item{Time.name}{Name of the observation times vector in the original data} 98 | 99 | \item{thetaSampList}{A list containing a data frame of parameter vectors and 100 | their associated probabilities for a resample} 101 | } 102 | \description{ 103 | The \code{crwSimulator} function uses a fitted model object from 104 | \code{crwMLE} and a set of prediction times to construct a list from which 105 | \code{\link{crwPostIS}} will draw a sample from either the posterior 106 | distribution of the state vectors conditional on fitted parameters or a full 107 | posterior draw from an importance sample of the parameters. 108 | } 109 | \details{ 110 | The crwSimulator function produces a list and preprocesses the necessary 111 | components for repeated track simulation from a fitted CTCRW model from 112 | \code{\link{crwMLE}}. The \code{method} argument can be one of \code{"IS"} 113 | or \code{"quadrature"}. If method="IS" is chosen standard importance 114 | sampling will be used to calculate the appropriate weights via t proposal 115 | with df degrees of freedom. If df=Inf (default) then a multivariate normal 116 | distribution is used to approximate the parameter posterior. If 117 | \code{method="quadrature"}, then a regular grid over the posterior is used 118 | to calculate the weights. The argument \code{grid.eps} controls the 119 | quadrature grid. The arguments are approximately the upper and lower limit 120 | in terms of standard deviations of the posterior. The default is 121 | \code{grid.eps}, in units of 1sd. If \code{object.crwFit} was fitted with 122 | \code{crwArgoFilter}, then the returned list will also include \code{p.out}, 123 | which is the approximate probability that the observation is an outlier. 124 | } 125 | \seealso{ 126 | See \code{demo(northernFurSealDemo)} for example. 127 | } 128 | \author{ 129 | Devin S. Johnson 130 | } 131 | -------------------------------------------------------------------------------- /man/crw_as_sf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crw_coerce_sf.R 3 | \name{crw_as_sf} 4 | \alias{crw_as_sf} 5 | \alias{crw_as_sf.crwIS} 6 | \alias{crw_as_sf.crwPredict} 7 | \alias{crw_as_sf.list} 8 | \title{Coerce to sf/sfc object} 9 | \usage{ 10 | crw_as_sf(data, ftype, locType, group) 11 | 12 | \method{crw_as_sf}{crwIS}(data, ftype, locType = c("p", "o", "f"), group = NULL, ...) 13 | 14 | \method{crw_as_sf}{crwPredict}(data, ftype, locType = c("p", "o", "f"), group = NULL, ...) 15 | 16 | \method{crw_as_sf}{list}(data, ftype, locType = c("p", "o", "f"), ...) 17 | } 18 | \arguments{ 19 | \item{data}{an object of class \code{"crwIS"} or \code{"crwPredict"}} 20 | 21 | \item{ftype}{character of either "POINT" or "LINESTRING" specifying the feature type} 22 | 23 | \item{locType}{character vector of location points to include ("p","o")} 24 | 25 | \item{group}{(optional) character specifying the column to group by for multiple LINESTRING features} 26 | 27 | \item{...}{Additional arguments that are ignored} 28 | } 29 | \description{ 30 | Provides reliable conversion of \code{"crwIS"} and \code{"crwPredict"} objects 31 | into simple features objects supported in the \code{"sf"} package. Both 32 | \code{"sf"} objects with "POINT" geometry and \code{"sfc_LINESTRING"} objects 33 | are created. Coercion of \code{"crwPredict"} objects to \code{"sfc_LINESTRING"} 34 | has an option \code{"group"} argument when the \code{"crwPredict"} object 35 | includes predictions from multiple deployments. The grouping column will be 36 | used and a tibble of multiple \code{"sf_LINESTRING"} objects will be returned 37 | } 38 | \section{Methods (by class)}{ 39 | \itemize{ 40 | \item \code{crw_as_sf(crwIS)}: coerce crwIS object to sf (POINT or 41 | LINESTRING geometry) 42 | 43 | \item \code{crw_as_sf(crwPredict)}: coerce crwPredict object to sf (POINT or 44 | LINESTRING geometry) 45 | 46 | \item \code{crw_as_sf(list)}: coerce list of crwIS objects to sf (LINESTRING or 47 | MULTILINESTRING geometry) 48 | 49 | }} 50 | -------------------------------------------------------------------------------- /man/crw_as_tibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crw_coerce_tibble.R 3 | \name{crw_as_tibble} 4 | \alias{crw_as_tibble} 5 | \alias{crw_as_tibble.crwIS} 6 | \alias{crw_as_tibble.crwPredict} 7 | \alias{crw_as_tibble.tbl} 8 | \title{Coerce crawl objects (crwIS and crwPredict) to tibbles} 9 | \usage{ 10 | crw_as_tibble(crw_object, ...) 11 | 12 | \method{crw_as_tibble}{crwIS}(crw_object, ...) 13 | 14 | \method{crw_as_tibble}{crwPredict}(crw_object, ...) 15 | 16 | \method{crw_as_tibble}{tbl}(crw_object, ...) 17 | } 18 | \arguments{ 19 | \item{crw_object}{an object of class \code{"crwIS"} or \code{"crwPredict"}} 20 | 21 | \item{...}{Additional arguments that are ignored} 22 | } 23 | \description{ 24 | Coerce crawl objects (crwIS and crwPredict) to tibbles 25 | } 26 | \section{Methods (by class)}{ 27 | \itemize{ 28 | \item \code{crw_as_tibble(crwIS)}: coerce crwIS object to tibble 29 | 30 | \item \code{crw_as_tibble(crwPredict)}: coerce crwPredict object to tibble 31 | 32 | \item \code{crw_as_tibble(tbl)}: 33 | 34 | }} 35 | \author{ 36 | Josh M. London 37 | } 38 | -------------------------------------------------------------------------------- /man/detect_timescale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/detect_timescale.R 3 | \name{detect_timescale} 4 | \alias{detect_timescale} 5 | \title{Detect appropriate time scale for movement analysis} 6 | \usage{ 7 | detect_timescale(time_vector) 8 | } 9 | \arguments{ 10 | \item{time_vector}{a vector of class POSIXct} 11 | } 12 | \value{ 13 | character of either "seconds","minutes","hours","days","weeks" 14 | } 15 | \description{ 16 | This function examines the time vector and evaluates the median time 17 | interval. With this, we determine what the best time scale for the 18 | movement model is likely to be. 19 | } 20 | -------------------------------------------------------------------------------- /man/displayPar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/displayPar.R 3 | \name{displayPar} 4 | \alias{displayPar} 5 | \title{Display the order of parameters along with fixed values and starting values} 6 | \usage{ 7 | displayPar( 8 | mov.model = ~1, 9 | err.model = NULL, 10 | activity = NULL, 11 | drift = FALSE, 12 | data, 13 | Time.name, 14 | theta, 15 | fixPar, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{mov.model}{formula object specifying the time indexed covariates for 21 | movement parameters.} 22 | 23 | \item{err.model}{A 2-element list of formula objects specifying the time 24 | indexed covariates for location error parameters.} 25 | 26 | \item{activity}{formula object giving the covariate for the stopping 27 | portion of the model.} 28 | 29 | \item{drift}{logical indicating whether or not to include a random 30 | drift component.} 31 | 32 | \item{data}{data.frame object containing telemetry and covariate data. A 33 | \code{SpatialPointsDataFrame} object from the package 'sp' will also be accepted.} 34 | 35 | \item{Time.name}{character indicating name of the location time column} 36 | 37 | \item{theta}{starting values for parameter optimization.} 38 | 39 | \item{fixPar}{Values of parameters which are held fixed to the given value.} 40 | 41 | \item{...}{Additional arguments (probably for testing new features.)} 42 | } 43 | \value{ 44 | A data frame with the following columns 45 | 46 | \item{ParNames}{The names of the parameters specified by the arguments.} 47 | 48 | \item{fixPar}{The values specified by the \code{fixPar} argument for fixed values of the parameters. In model fitting, 49 | these values will remain fixed and will not be estimated.} 50 | 51 | \item{thetaIndex}{This column provides the index of each element of the theta argument and to which parameter it corresponds.} 52 | 53 | \item{thetaStart}{If a value is given for the \code{theta} argument it will be placed in this column and its elements will 54 | correspond to the \code{thetaIdx} column.} 55 | } 56 | \description{ 57 | This function takes the model specification arguments to the \code{\link{crwMLE}} function and displays a table 58 | with the parameter names in the order that \code{crwMLE} will use during model fitting. This is useful for specifying 59 | values for the \code{fixPar} or \code{theta} (starting values for free parameters) arguments. 60 | } 61 | \seealso{ 62 | \code{demo(northernFurSealDemo)} for example. 63 | } 64 | \author{ 65 | Devin S. Johnson 66 | } 67 | -------------------------------------------------------------------------------- /man/expandPred.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/expandPred.R 3 | \name{expandPred} 4 | \alias{expandPred} 5 | \title{Expand a time indexed data set with additional prediction times} 6 | \usage{ 7 | expandPred(x, Time = "Time", predTime, time.col = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{Data to be expanded.} 11 | 12 | \item{Time}{Either a character naming the column which contains original 13 | time values, or a numeric vector of original times} 14 | 15 | \item{predTime}{prediction times to expand data} 16 | 17 | \item{time.col}{Logical value indicating whether to attach the new times to 18 | the expanded data} 19 | } 20 | \value{ 21 | data.frame expanded by \code{predTime} 22 | } 23 | \description{ 24 | Expands a covariate data frame (or vector) that has a separate time index by 25 | inserting prediction times and duplicating the covariate values for all 26 | prediction time between subsequent data times. 27 | } 28 | \examples{ 29 | 30 | #library(crawl) 31 | origTime <- c(1:10) 32 | x <- cbind(rnorm(10), c(21:30)) 33 | predTime <- seq(1,10, by=0.25) 34 | expandPred(x, Time=origTime, predTime, time.col=TRUE) 35 | 36 | } 37 | \author{ 38 | Devin S. Johnson 39 | } 40 | -------------------------------------------------------------------------------- /man/fillCols.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fillCols.R 3 | \name{fillCols} 4 | \alias{fillCols} 5 | \title{Fill missing values in data set (or matrix) columns for which there is a 6 | single unique value} 7 | \usage{ 8 | fillCols(data) 9 | } 10 | \arguments{ 11 | \item{data}{data.frame} 12 | } 13 | \value{ 14 | data.frame 15 | } 16 | \description{ 17 | Looks for columns in a data set that have a single unique non-missing value 18 | and fills in all \code{NA} with that value 19 | } 20 | \examples{ 21 | 22 | #library(crawl) 23 | data1 <- data.frame(constVals=rep(c(1,NA),5), vals=1:10) 24 | data1[5,2] <- NA 25 | data1 26 | data2 <- fillCols(data1) 27 | data2 28 | 29 | mat1 <- matrix(c(rep(c(1,NA),5), 1:10), ncol=2) 30 | mat1[5,2] <- NA 31 | mat1 32 | mat2 <- fillCols(mat1) 33 | mat2 34 | } 35 | \author{ 36 | Devin S. Johnson 37 | } 38 | -------------------------------------------------------------------------------- /man/fix_path.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \name{fix_path} 4 | \alias{fix_path} 5 | \title{fix_path function id depreciated.} 6 | \usage{ 7 | fix_path(...) 8 | } 9 | \arguments{ 10 | \item{...}{Any arguments are ignored.} 11 | } 12 | \description{ 13 | fix_path function id depreciated. 14 | } 15 | -------------------------------------------------------------------------------- /man/flatten.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllMethod.R 3 | \name{flatten} 4 | \alias{flatten} 5 | \title{'Flattening' a list-form crwPredict object into a data.frame} 6 | \usage{ 7 | flatten(predObj) 8 | } 9 | \arguments{ 10 | \item{predObj}{A crwPredict object} 11 | } 12 | \value{ 13 | a \code{\link{data.frame}} version of a crwPredict list with columns 14 | for the state standard errors 15 | } 16 | \description{ 17 | \dQuote{Flattens} a list form \code{\link{crwPredict}} object into a flat 18 | data.frame. 19 | } 20 | \seealso{ 21 | \code{\link{northernFurSeal}} for use example 22 | } 23 | \author{ 24 | Devin S. Johnson 25 | } 26 | -------------------------------------------------------------------------------- /man/harborSeal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \docType{data} 4 | \name{harborSeal} 5 | \alias{harborSeal} 6 | \title{Harbor seal location data set used in Johnson et al. (2008)} 7 | \format{ 8 | A data frame with 7059 observations on the following 5 variables. 9 | 10 | \describe{ \item{Time}{a numeric vector.} 11 | 12 | \item{latitude}{a numeric vector.} 13 | 14 | \item{longitude}{a numeric vector.} 15 | 16 | \item{DryTime}{a numeric vector.} 17 | 18 | \item{Argos_loc_class}{a factor with levels \code{0} \code{1} 19 | \code{2} \code{3} \code{A} \code{B}}.} 20 | } 21 | \source{ 22 | Marine Mammal Laboratory, Alaska 23 | Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 24 | Point Way NE Seattle, WA 98115 25 | } 26 | \description{ 27 | Harbor seal location data set used in Johnson et al. (2008) 28 | } 29 | \references{ 30 | Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 31 | Continuous-time random walk model for animal telemetry data. Ecology 32 | 89:1208-1215. 33 | } 34 | \author{ 35 | Devin S. Johnson 36 | } 37 | \keyword{datasets} 38 | -------------------------------------------------------------------------------- /man/harborSeal_sf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \docType{data} 4 | \name{harborSeal_sf} 5 | \alias{harborSeal_sf} 6 | \title{Harbor seal location data updated since Johnson et al. (2008)} 7 | \format{ 8 | A Simple Feature Collection with 7059 features and 3 fields. 9 | 10 | \describe{ 11 | \item{Time}{a numeric vector.} 12 | \item{DryTime}{a numeric vector.} 13 | \item{Argos_loc_class}{a factor with levels \code{0} \code{1} 14 | \code{2} \code{3} \code{A} \code{B}.} 15 | \item{geometry}{a list column with geometry data; CRS = EPSG:4326} 16 | } 17 | } 18 | \source{ 19 | Marine Mammal Laboratory, Alaska 20 | Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 21 | Point Way NE Seattle, WA 98115 22 | } 23 | \description{ 24 | The original location data used in Johnson et al. (2008) was geographic 25 | (latitude/longitude) (but not explicitly documented) and provided as a 26 | simple data frame. This data updates the data to a Simple Feature 27 | Collection (as part of the \href{https://r-spatial.github.io/sf/articles/}{sf} 28 | package) with the CRS explicitly set. 29 | } 30 | \references{ 31 | Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) 32 | Continuous-time random walk model for animal telemetry data. Ecology 33 | 89:1208-1215. 34 | } 35 | \author{ 36 | Josh M. London 37 | } 38 | \keyword{data} 39 | \keyword{sets} 40 | -------------------------------------------------------------------------------- /man/intToPOSIX.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/intToPOSIX.R 3 | \name{intToPOSIX} 4 | \alias{intToPOSIX} 5 | \title{Reverse as.numeric command that is performed on a vector of type POSIXct} 6 | \usage{ 7 | intToPOSIX(timeVector, tz = "GMT") 8 | } 9 | \arguments{ 10 | \item{timeVector}{A vector of integers produced by as.numeric applied to a 11 | PSIXct vector} 12 | 13 | \item{tz}{Time zone of the vector (see \code{\link{as.POSIXct}}).} 14 | } 15 | \value{ 16 | POSIXct vector 17 | } 18 | \description{ 19 | Takes integer value produced by \code{as.numeric(x)}, where \code{x} is a 20 | POSIXct vector and returns it to a POSIXct vector 21 | } 22 | \note{ 23 | There is no check that as.numeric applied to a POSIX vector produced 24 | \code{timeVector}. So, caution is required in using this function. It was 25 | included simply because I have found it useful 26 | } 27 | \examples{ 28 | 29 | #library(crawl) 30 | timeVector <- as.numeric(Sys.time()) 31 | timeVector 32 | intToPOSIX(timeVector, tz="") 33 | } 34 | \author{ 35 | Devin S. Johnson 36 | } 37 | -------------------------------------------------------------------------------- /man/mergeTrackStop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mergeTrackStop.R 3 | \name{mergeTrackStop} 4 | \alias{mergeTrackStop} 5 | \title{Merge a location data set with a dry time (or other stopping) covariate} 6 | \usage{ 7 | mergeTrackStop( 8 | data, 9 | stopData, 10 | Time.name = "Time", 11 | interp = c("zeros", "ma0"), 12 | win = 2, 13 | constCol 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{Location data.} 18 | 19 | \item{stopData}{stopping variable data set.} 20 | 21 | \item{Time.name}{character naming time index variable in both data sets} 22 | 23 | \item{interp}{method of interpolation.} 24 | 25 | \item{win}{window for "ma0" interpolation method.} 26 | 27 | \item{constCol}{columns in \code{data} for which the user would like to be 28 | constant, such as id or sex.} 29 | } 30 | \value{ 31 | Merged data.frame with new column from \code{stopData}. Missing values in 32 | the stopping variable will be interpolated 33 | } 34 | \description{ 35 | The function merges a location data set with a stopping variable data set. 36 | } 37 | \details{ 38 | Simply merges the data frames and interpolates based on the chosen method. 39 | Both data frames have to use the same name for the time variable. Also 40 | contains \code{stopType} which = "o" if observed or "p" for interpolated. 41 | 42 | The merged data is truncated to the first and last time in the location data 43 | set. Missing values in the stopping variable data set can be interpolated by 44 | replacing them with zeros (full movement) or first replacing with zeros then 45 | using a moving average to smooth the data. Only the missing values are then 46 | replace with this smoothed data. This allows a smooth transition to full 47 | movement. 48 | } 49 | \examples{ 50 | 51 | 52 | track <- data.frame(TimeVar=sort(runif(20,0,20)), x=1:20, y=20:1) 53 | track 54 | stopData <- data.frame(TimeVar=0:29, stopVar=round(runif(30))) 55 | stopData 56 | mergeTrackStop(track, stopData, Time.name="TimeVar") 57 | 58 | } 59 | \author{ 60 | Devin S. Johnson 61 | } 62 | -------------------------------------------------------------------------------- /man/northernFurSeal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crawl-package.R 3 | \docType{data} 4 | \name{northernFurSeal} 5 | \alias{northernFurSeal} 6 | \title{Northern fur seal pup relocation data set used in Johnson et al. (2008)} 7 | \format{ 8 | A data frame with 795 observations on the following 4 variables: 9 | 10 | \describe{ \item{GMT}{A POSIX time vector} 11 | 12 | \item{loc_class}{a factor with levels \code{3} \code{2} 13 | \code{1} \code{0} \code{A}.} 14 | 15 | \item{lat}{a numeric vector. Latitude for the locations} 16 | 17 | \item{long}{a numeric vector. Longitude for the locations} 18 | 19 | } 20 | } 21 | \source{ 22 | Marine Mammal Laboratory, Alaska 23 | Fisheries Science Center, National Marine Fisheries Service, NOAA 7600 Sand 24 | Point Way NE Seattle, WA 98115 25 | } 26 | \description{ 27 | Northern fur seal pup relocation data set used in Johnson et al. (2008) 28 | } 29 | \references{ 30 | Johnson, D., J. London, M. -A. Lea, and J. Durban (2008) Continuous-time 31 | random walk model for animal telemetry data. Ecology 89:1208-1215. 32 | } 33 | \keyword{datasets} 34 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/sub-.crwIS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crw-methods.R 3 | \name{[.crwIS} 4 | \alias{[.crwIS} 5 | \title{Generic subset/bracket method for crwIS classes} 6 | \usage{ 7 | \method{[}{crwIS}(x, i, ..., drop = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{crwIS object} 11 | 12 | \item{i}{elements to extract or replace. These are numeric or character or, 13 | empty or logical. Numeric values are coerced to integer as if by \code{as.integer}} 14 | 15 | \item{...}{other arguments} 16 | 17 | \item{drop}{logical. If TRUE the result is coerced to the lowest possible 18 | dimension.} 19 | } 20 | \description{ 21 | Generic subset/bracket method for crwIS classes 22 | } 23 | -------------------------------------------------------------------------------- /man/tidy_crwFit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tidy_crwFit.R 3 | \name{tidy_crwFit} 4 | \alias{tidy_crwFit} 5 | \title{tidy-like method for crwFit object} 6 | \usage{ 7 | tidy_crwFit(fit) 8 | } 9 | \arguments{ 10 | \item{fit}{\code{crwFit} object from \code{crawl::crwMLE}} 11 | } 12 | \description{ 13 | this function mimics the approach taken by \code{broom::tidy} 14 | to present model output parameters in a tidy, data frame structure. 15 | } 16 | -------------------------------------------------------------------------------- /src/CTCRWN2LL.cpp: -------------------------------------------------------------------------------- 1 | // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 2 | #include "RcppArmadillo.h" 3 | // [[Rcpp::depends(RcppArmadillo)]] 4 | using namespace Rcpp; 5 | using namespace arma; 6 | 7 | // Function prototypes 8 | arma::mat makeQ(const double& b, const double& sig2, const double& delta, const double& active); 9 | arma::mat makeT(const double& b, const double& delta, const double& active); 10 | 11 | // [[Rcpp::export]] 12 | Rcpp::List CTCRWNLL(const arma::mat& y, const arma::mat& Hmat, 13 | const arma::vec& beta, const arma::vec& sig2, const arma::vec& delta, 14 | const arma::vec& noObs,const arma::vec& active, const arma::colvec& a, 15 | const arma::mat& P) 16 | { 17 | // Define fixed matrices 18 | int N = y.n_rows; 19 | double detF; 20 | arma::mat Z(2,4, fill::zeros); 21 | Z(0,0) = 1; Z(1,2) = 1; 22 | arma::mat T(4,4); 23 | arma::mat Q(4,4); 24 | arma::mat F(2,2, fill::zeros); 25 | arma::mat H(2,2, fill::zeros); 26 | arma::mat K(4,2, fill::zeros); 27 | arma::mat L(4,4, fill::zeros); 28 | arma::colvec v(2, fill::zeros); 29 | arma::colvec aest(4); 30 | aest=a; 31 | arma::mat Pest(4,4); 32 | Pest=P; 33 | double ll=0; 34 | //Begin Kalman filter 35 | for(int i=0; i0; j--){ 65 | if(noObs(j-1)==1 || F.slice(j-1)(0,0)*F.slice(j-1)(1,1)==0){ 66 | r = L.slice(j-1).t() * r; 67 | N = L.slice(j-1).t() * N * L.slice(j-1); 68 | } else{ 69 | u.col(j-1) = solve(F.slice(j-1),v.col(j-1))-K.slice(j-1).t()*r; 70 | M.slice(j-1) = F.slice(j-1).i() + K.slice(j-1).t()*N*K.slice(j-1); 71 | chisq(j-1) = dot(u.col(j-1),solve(M.slice(j-1),u.col(j-1))); 72 | jk.col(j-1) = y.row(j-1).t() - solve(M.slice(j-1),u.col(j-1)); 73 | r = Z.t()*solve(F.slice(j-1),v.col(j-1)) + L.slice(j-1).t() * r; 74 | N = Z.t() * solve(F.slice(j-1),Z) + L.slice(j-1).t()*N*L.slice(j-1); 75 | } 76 | pred.col(j-1) = aest.col(j-1) + Pest.slice(j-1)*r; 77 | predVar.slice(j-1) = Pest.slice(j-1) - Pest.slice(j-1)*N*Pest.slice(j-1); 78 | } 79 | return Rcpp::List::create( 80 | Rcpp::Named("ll") = ll, 81 | Rcpp::Named("pred") = pred, Rcpp::Named("predVar")=predVar, 82 | Rcpp::Named("chisq")=chisq, Rcpp::Named("predObs")=jk 83 | ); 84 | } 85 | -------------------------------------------------------------------------------- /src/CTCRWPREDICT_DRIFT.cpp: -------------------------------------------------------------------------------- 1 | // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 2 | #include "RcppArmadillo.h" 3 | // [[Rcpp::depends(RcppArmadillo)]] 4 | using namespace Rcpp; 5 | using namespace arma; 6 | 7 | // Function prototypes 8 | arma::mat makeT_drift(const double& b, const double& b_drift, const double& delta, const double& active); 9 | arma::mat makeQ_drift(const double& b, const double& b_drift, const double& sig2, const double& sig2_drift, 10 | const double& delta, const double& active); 11 | 12 | // [[Rcpp::export]] 13 | Rcpp::List CTCRWPREDICT_DRIFT(const arma::mat& y, const arma::mat& Hmat, 14 | const arma::vec& beta, const arma::vec& beta_drift, const arma::vec& sig2, 15 | const arma::vec& sig2_drift, const arma::vec& delta, 16 | const arma::vec& noObs,const arma::vec& active, const arma::colvec& a, 17 | const arma::mat& P) 18 | { 19 | int I = y.n_rows; 20 | arma::mat u(2,I, fill::zeros); 21 | arma::mat jk(2,I, fill::zeros); 22 | arma::cube M(2,2,I, fill::zeros); 23 | arma::mat pred(6,I, fill::zeros); 24 | arma::cube predVar(6,6,I, fill::zeros); 25 | arma::mat Z(2,6, fill::zeros); Z(0,0) = 1; Z(1,3) = 1; 26 | arma::mat T(6,6, fill::zeros); 27 | arma::mat Q(6,6, fill::zeros); 28 | arma::cube F(2,2,I, fill::zeros); 29 | arma::mat H(2,2, fill::zeros); 30 | arma::cube K(6,2,I, fill::zeros); 31 | arma::cube L(6,6,I, fill::zeros); 32 | arma::mat v(2,I, fill::zeros); 33 | arma::mat aest(6,I+1, fill::zeros); 34 | aest.col(0)=a; 35 | arma::cube Pest(6,6,I+1, fill::zeros); 36 | Pest.slice(0)=P; 37 | arma::colvec r(6, fill::zeros); 38 | arma::mat N(6,6, fill::zeros); 39 | arma::vec chisq(I, fill::zeros); 40 | 41 | double ll=0; 42 | //Forward filter 43 | for(int i=0; i0; j--){ 67 | if(noObs(j-1)==1 || F.slice(j-1)(0,0)*F.slice(j-1)(1,1)==0){ 68 | r = L.slice(j-1).t() * r; 69 | N = L.slice(j-1).t() * N * L.slice(j-1); 70 | } else{ 71 | u.col(j-1) = solve(F.slice(j-1),v.col(j-1))-K.slice(j-1).t()*r; 72 | M.slice(j-1) = F.slice(j-1).i() + K.slice(j-1).t()*N*K.slice(j-1); 73 | chisq(j-1) = dot(u.col(j-1),solve(M.slice(j-1),u.col(j-1))); 74 | jk.col(j-1) = y.row(j-1).t() - solve(M.slice(j-1),u.col(j-1)); 75 | r = Z.t()*solve(F.slice(j-1),v.col(j-1)) + L.slice(j-1).t() * r; 76 | N = Z.t() * solve(F.slice(j-1),Z) + L.slice(j-1).t()*N*L.slice(j-1); 77 | } 78 | pred.col(j-1) = aest.col(j-1) + Pest.slice(j-1)*r; 79 | predVar.slice(j-1) = Pest.slice(j-1) - Pest.slice(j-1)*N*Pest.slice(j-1); 80 | } 81 | return Rcpp::List::create( 82 | Rcpp::Named("ll") = ll, 83 | Rcpp::Named("pred") = pred, Rcpp::Named("predVar")=predVar, 84 | Rcpp::Named("chisq")=chisq, Rcpp::Named("predObs")=jk 85 | ); 86 | } 87 | -------------------------------------------------------------------------------- /src/CTCRWSAMPLE.cpp: -------------------------------------------------------------------------------- 1 | // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 2 | #include "RcppArmadillo.h" 3 | // [[Rcpp::depends(RcppArmadillo)]] 4 | using namespace Rcpp; 5 | using namespace arma; 6 | 7 | // Function prototypes 8 | arma::mat makeQ(const double& beta, const double& sig2, const double& delta, const double& active); 9 | arma::mat makeT(const double& beta, const double& delta, const double& active); 10 | arma::vec mvn(const arma::vec& mu, const arma::mat& V); 11 | 12 | 13 | 14 | // [[Rcpp::export]] 15 | Rcpp::List CTCRWSAMPLE(const arma::mat& y, const arma::mat& Hmat, 16 | const arma::vec& beta, const arma::vec& sig2, const arma::vec& delta, 17 | const arma::vec& noObs,const arma::vec& active, const arma::colvec& a, 18 | const arma::mat& P) 19 | { 20 | int I = y.n_rows; 21 | // SIMULATION RELATED MATRICES 22 | arma::mat y_plus(I, 2); 23 | arma::mat alpha_plus(4,I+1, fill::zeros); 24 | alpha_plus.col(0) = mvn(a,P); 25 | arma::mat alpha_plus_hat(4,I+1, fill::zeros); 26 | alpha_plus_hat.col(0) = a; 27 | arma::mat v_plus(2,I, fill::zeros); 28 | arma::colvec r_plus(4, fill::zeros); 29 | arma::mat sim(I,4); 30 | // KFS MATRICES FOR DATA INFORMED PART 31 | arma::mat Z(2,4, fill::zeros); Z(0,0) = 1; Z(1,2) = 1; 32 | arma::mat T(4,4, fill::zeros); T(0,0) = 1; T(2,2) = 1; 33 | arma::mat Q(4,4, fill::zeros); 34 | arma::cube F(2,2,I, fill::zeros); 35 | arma::mat H(2,2, fill::zeros); 36 | arma::cube K(4,2,I, fill::zeros); 37 | arma::cube L(4,4,I, fill::zeros); 38 | arma::mat v(2,I, fill::zeros); 39 | arma::mat alpha_hat(4,I+1, fill::zeros); 40 | alpha_hat.col(0) = a; 41 | arma::cube P_hat(4,4,I+1, fill::zeros); 42 | P_hat.slice(0)=P; 43 | arma::colvec r(4, fill::zeros); 44 | 45 | double ll=0; 46 | //Forward filter and simulation 47 | for(int i=0; i0; j--){ 83 | if(noObs(j-1)==1 || F.slice(j-1)(0,0)*F.slice(j-1)(1,1)==0){ 84 | r = L.slice(j-1).t() * r; 85 | r_plus = L.slice(j-1).t() * r_plus; 86 | } else{ 87 | r = Z.t()*solve(F.slice(j-1),v.col(j-1)) + L.slice(j-1).t() * r; 88 | r_plus = Z.t()*solve(F.slice(j-1),v_plus.col(j-1)) + L.slice(j-1).t() * r_plus; 89 | } 90 | alpha_hat.col(j-1) += P_hat.slice(j-1)*r; 91 | alpha_plus_hat.col(j-1) += P_hat.slice(j-1)*r_plus; 92 | } 93 | sim = (alpha_hat.cols(0,I-1) - (alpha_plus.cols(0,I-1)-alpha_plus_hat.cols(0,I-1))).t(); 94 | return Rcpp::List::create( 95 | Rcpp::Named("ll") = ll, 96 | Rcpp::Named("sim") = sim 97 | ); 98 | } 99 | -------------------------------------------------------------------------------- /src/CTCRWSAMPLE_DRIFT.cpp: -------------------------------------------------------------------------------- 1 | // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 2 | #include "RcppArmadillo.h" 3 | // [[Rcpp::depends(RcppArmadillo)]] 4 | using namespace Rcpp; 5 | using namespace arma; 6 | 7 | // Function prototypes 8 | arma::mat makeT_drift(const double& b, const double& b_drift, const double& delta, const double& active); 9 | arma::mat makeQ_drift(const double& b, const double& b_drift, const double& sig2, const double& sig2_drift, 10 | const double& delta, const double& active); 11 | arma::vec mvn(const arma::vec& mu, const arma::mat& V); 12 | 13 | 14 | // [[Rcpp::export]] 15 | Rcpp::List CTCRWSAMPLE_DRIFT(const arma::mat& y, const arma::mat& Hmat, 16 | const arma::vec& beta, const arma::vec& beta_drift, const arma::vec& sig2, 17 | const arma::vec& sig2_drift, const arma::vec& delta, 18 | const arma::vec& noObs,const arma::vec& active, const arma::colvec& a, 19 | const arma::mat& P) 20 | { 21 | int I = y.n_rows; 22 | // SIMULATION RELATED MATRICES 23 | arma::mat y_plus(I, 2); 24 | arma::mat alpha_plus(6,I+1, fill::zeros); 25 | alpha_plus.col(0) = mvn(a,P); 26 | arma::mat alpha_plus_hat(6,I+1, fill::zeros); 27 | alpha_plus_hat.col(0) = a; 28 | arma::mat v_plus(2,I, fill::zeros); 29 | arma::colvec r_plus(6, fill::zeros); 30 | arma::mat sim(I,6); 31 | // KFS MATRICES FOR DATA INFORMED PART 32 | arma::mat Z(2,6, fill::zeros); Z(0,0) = 1; Z(1,3) = 1; 33 | arma::mat T(6,6, fill::zeros); 34 | arma::mat Q(6,6, fill::zeros); 35 | arma::cube F(2,2,I, fill::zeros); 36 | arma::mat H(2,2, fill::zeros); 37 | arma::cube K(6,2,I, fill::zeros); 38 | arma::cube L(6,6,I, fill::zeros); 39 | arma::mat v(2,I, fill::zeros); 40 | arma::mat alpha_hat(6,I+1, fill::zeros); 41 | alpha_hat.col(0) = a; 42 | arma::cube P_hat(6,6,I+1, fill::zeros); 43 | P_hat.slice(0)=P; 44 | arma::colvec r(6, fill::zeros); 45 | 46 | double ll=0; 47 | //Forward filter and simulation 48 | for(int i=0; i0; j--){ 84 | if(noObs(j-1)==1 || F.slice(j-1)(0,0)*F.slice(j-1)(1,1)==0){ 85 | r = L.slice(j-1).t() * r; 86 | r_plus = L.slice(j-1).t() * r_plus; 87 | } else{ 88 | r = Z.t()*solve(F.slice(j-1),v.col(j-1)) + L.slice(j-1).t() * r; 89 | r_plus = Z.t()*solve(F.slice(j-1),v_plus.col(j-1)) + L.slice(j-1).t() * r_plus; 90 | } 91 | alpha_hat.col(j-1) += P_hat.slice(j-1)*r; 92 | alpha_plus_hat.col(j-1) += P_hat.slice(j-1)*r_plus; 93 | } 94 | sim = (alpha_hat.cols(0,I-1) - (alpha_plus.cols(0,I-1)-alpha_plus_hat.cols(0,I-1))).t(); 95 | return Rcpp::List::create( 96 | Rcpp::Named("ll") = ll, 97 | Rcpp::Named("sim") = sim 98 | ); 99 | } 100 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | 2 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 3 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | #include 6 | 7 | using namespace Rcpp; 8 | 9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 12 | #endif 13 | 14 | // CTCRWNLL 15 | Rcpp::List CTCRWNLL(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& sig2, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 16 | RcppExport SEXP _crawl_CTCRWNLL(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP sig2SEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 17 | BEGIN_RCPP 18 | Rcpp::RObject rcpp_result_gen; 19 | Rcpp::RNGScope rcpp_rngScope_gen; 20 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 21 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 22 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 23 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 24 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 25 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 26 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 27 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 28 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 29 | rcpp_result_gen = Rcpp::wrap(CTCRWNLL(y, Hmat, beta, sig2, delta, noObs, active, a, P)); 30 | return rcpp_result_gen; 31 | END_RCPP 32 | } 33 | // CTCRWNLL_DRIFT 34 | Rcpp::List CTCRWNLL_DRIFT(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& beta_drift, const arma::vec& sig2, const arma::vec& sig2_drift, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 35 | RcppExport SEXP _crawl_CTCRWNLL_DRIFT(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP beta_driftSEXP, SEXP sig2SEXP, SEXP sig2_driftSEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 36 | BEGIN_RCPP 37 | Rcpp::RObject rcpp_result_gen; 38 | Rcpp::RNGScope rcpp_rngScope_gen; 39 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 40 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 41 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 42 | Rcpp::traits::input_parameter< const arma::vec& >::type beta_drift(beta_driftSEXP); 43 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 44 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2_drift(sig2_driftSEXP); 45 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 46 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 47 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 48 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 49 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 50 | rcpp_result_gen = Rcpp::wrap(CTCRWNLL_DRIFT(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P)); 51 | return rcpp_result_gen; 52 | END_RCPP 53 | } 54 | // CTCRWPREDICT 55 | Rcpp::List CTCRWPREDICT(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& sig2, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 56 | RcppExport SEXP _crawl_CTCRWPREDICT(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP sig2SEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 57 | BEGIN_RCPP 58 | Rcpp::RObject rcpp_result_gen; 59 | Rcpp::RNGScope rcpp_rngScope_gen; 60 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 61 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 62 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 63 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 64 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 65 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 66 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 67 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 68 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 69 | rcpp_result_gen = Rcpp::wrap(CTCRWPREDICT(y, Hmat, beta, sig2, delta, noObs, active, a, P)); 70 | return rcpp_result_gen; 71 | END_RCPP 72 | } 73 | // CTCRWPREDICT_DRIFT 74 | Rcpp::List CTCRWPREDICT_DRIFT(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& beta_drift, const arma::vec& sig2, const arma::vec& sig2_drift, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 75 | RcppExport SEXP _crawl_CTCRWPREDICT_DRIFT(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP beta_driftSEXP, SEXP sig2SEXP, SEXP sig2_driftSEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 76 | BEGIN_RCPP 77 | Rcpp::RObject rcpp_result_gen; 78 | Rcpp::RNGScope rcpp_rngScope_gen; 79 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 80 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 81 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 82 | Rcpp::traits::input_parameter< const arma::vec& >::type beta_drift(beta_driftSEXP); 83 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 84 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2_drift(sig2_driftSEXP); 85 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 86 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 87 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 88 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 89 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 90 | rcpp_result_gen = Rcpp::wrap(CTCRWPREDICT_DRIFT(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P)); 91 | return rcpp_result_gen; 92 | END_RCPP 93 | } 94 | // CTCRWSAMPLE 95 | Rcpp::List CTCRWSAMPLE(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& sig2, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 96 | RcppExport SEXP _crawl_CTCRWSAMPLE(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP sig2SEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 97 | BEGIN_RCPP 98 | Rcpp::RObject rcpp_result_gen; 99 | Rcpp::RNGScope rcpp_rngScope_gen; 100 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 101 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 102 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 103 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 104 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 105 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 106 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 107 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 108 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 109 | rcpp_result_gen = Rcpp::wrap(CTCRWSAMPLE(y, Hmat, beta, sig2, delta, noObs, active, a, P)); 110 | return rcpp_result_gen; 111 | END_RCPP 112 | } 113 | // CTCRWSAMPLE_DRIFT 114 | Rcpp::List CTCRWSAMPLE_DRIFT(const arma::mat& y, const arma::mat& Hmat, const arma::vec& beta, const arma::vec& beta_drift, const arma::vec& sig2, const arma::vec& sig2_drift, const arma::vec& delta, const arma::vec& noObs, const arma::vec& active, const arma::colvec& a, const arma::mat& P); 115 | RcppExport SEXP _crawl_CTCRWSAMPLE_DRIFT(SEXP ySEXP, SEXP HmatSEXP, SEXP betaSEXP, SEXP beta_driftSEXP, SEXP sig2SEXP, SEXP sig2_driftSEXP, SEXP deltaSEXP, SEXP noObsSEXP, SEXP activeSEXP, SEXP aSEXP, SEXP PSEXP) { 116 | BEGIN_RCPP 117 | Rcpp::RObject rcpp_result_gen; 118 | Rcpp::RNGScope rcpp_rngScope_gen; 119 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP); 120 | Rcpp::traits::input_parameter< const arma::mat& >::type Hmat(HmatSEXP); 121 | Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); 122 | Rcpp::traits::input_parameter< const arma::vec& >::type beta_drift(beta_driftSEXP); 123 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2(sig2SEXP); 124 | Rcpp::traits::input_parameter< const arma::vec& >::type sig2_drift(sig2_driftSEXP); 125 | Rcpp::traits::input_parameter< const arma::vec& >::type delta(deltaSEXP); 126 | Rcpp::traits::input_parameter< const arma::vec& >::type noObs(noObsSEXP); 127 | Rcpp::traits::input_parameter< const arma::vec& >::type active(activeSEXP); 128 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP); 129 | Rcpp::traits::input_parameter< const arma::mat& >::type P(PSEXP); 130 | rcpp_result_gen = Rcpp::wrap(CTCRWSAMPLE_DRIFT(y, Hmat, beta, beta_drift, sig2, sig2_drift, delta, noObs, active, a, P)); 131 | return rcpp_result_gen; 132 | END_RCPP 133 | } 134 | // makeT 135 | arma::mat makeT(const double& b, const double& delta, const double& active); 136 | RcppExport SEXP _crawl_makeT(SEXP bSEXP, SEXP deltaSEXP, SEXP activeSEXP) { 137 | BEGIN_RCPP 138 | Rcpp::RObject rcpp_result_gen; 139 | Rcpp::RNGScope rcpp_rngScope_gen; 140 | Rcpp::traits::input_parameter< const double& >::type b(bSEXP); 141 | Rcpp::traits::input_parameter< const double& >::type delta(deltaSEXP); 142 | Rcpp::traits::input_parameter< const double& >::type active(activeSEXP); 143 | rcpp_result_gen = Rcpp::wrap(makeT(b, delta, active)); 144 | return rcpp_result_gen; 145 | END_RCPP 146 | } 147 | // makeQ 148 | arma::mat makeQ(const double& b, const double& sig2, const double& delta, const double& active); 149 | RcppExport SEXP _crawl_makeQ(SEXP bSEXP, SEXP sig2SEXP, SEXP deltaSEXP, SEXP activeSEXP) { 150 | BEGIN_RCPP 151 | Rcpp::RObject rcpp_result_gen; 152 | Rcpp::RNGScope rcpp_rngScope_gen; 153 | Rcpp::traits::input_parameter< const double& >::type b(bSEXP); 154 | Rcpp::traits::input_parameter< const double& >::type sig2(sig2SEXP); 155 | Rcpp::traits::input_parameter< const double& >::type delta(deltaSEXP); 156 | Rcpp::traits::input_parameter< const double& >::type active(activeSEXP); 157 | rcpp_result_gen = Rcpp::wrap(makeQ(b, sig2, delta, active)); 158 | return rcpp_result_gen; 159 | END_RCPP 160 | } 161 | // makeT_drift 162 | arma::mat makeT_drift(const double& b, const double& b_drift, const double& delta, const double& active); 163 | RcppExport SEXP _crawl_makeT_drift(SEXP bSEXP, SEXP b_driftSEXP, SEXP deltaSEXP, SEXP activeSEXP) { 164 | BEGIN_RCPP 165 | Rcpp::RObject rcpp_result_gen; 166 | Rcpp::RNGScope rcpp_rngScope_gen; 167 | Rcpp::traits::input_parameter< const double& >::type b(bSEXP); 168 | Rcpp::traits::input_parameter< const double& >::type b_drift(b_driftSEXP); 169 | Rcpp::traits::input_parameter< const double& >::type delta(deltaSEXP); 170 | Rcpp::traits::input_parameter< const double& >::type active(activeSEXP); 171 | rcpp_result_gen = Rcpp::wrap(makeT_drift(b, b_drift, delta, active)); 172 | return rcpp_result_gen; 173 | END_RCPP 174 | } 175 | // makeQ_drift 176 | arma::mat makeQ_drift(const double& b, const double& b_drift, const double& sig2, const double& sig2_drift, const double& delta, const double& active); 177 | RcppExport SEXP _crawl_makeQ_drift(SEXP bSEXP, SEXP b_driftSEXP, SEXP sig2SEXP, SEXP sig2_driftSEXP, SEXP deltaSEXP, SEXP activeSEXP) { 178 | BEGIN_RCPP 179 | Rcpp::RObject rcpp_result_gen; 180 | Rcpp::RNGScope rcpp_rngScope_gen; 181 | Rcpp::traits::input_parameter< const double& >::type b(bSEXP); 182 | Rcpp::traits::input_parameter< const double& >::type b_drift(b_driftSEXP); 183 | Rcpp::traits::input_parameter< const double& >::type sig2(sig2SEXP); 184 | Rcpp::traits::input_parameter< const double& >::type sig2_drift(sig2_driftSEXP); 185 | Rcpp::traits::input_parameter< const double& >::type delta(deltaSEXP); 186 | Rcpp::traits::input_parameter< const double& >::type active(activeSEXP); 187 | rcpp_result_gen = Rcpp::wrap(makeQ_drift(b, b_drift, sig2, sig2_drift, delta, active)); 188 | return rcpp_result_gen; 189 | END_RCPP 190 | } 191 | -------------------------------------------------------------------------------- /src/SMM_MATS.cpp: -------------------------------------------------------------------------------- 1 | // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 2 | #include "RcppArmadillo.h" 3 | // [[Rcpp::depends(RcppArmadillo)]] 4 | using namespace Rcpp; 5 | using namespace arma; 6 | 7 | // Random normal draws for posterior sampling 8 | arma::vec armaNorm(int n){ 9 | NumericVector x = Rcpp::rnorm(n,0,1); 10 | arma::vec out(x.begin(), x.size(), false); 11 | return out; 12 | } 13 | 14 | arma::vec mvn(const arma::vec& mu, const arma::mat& Sig){ 15 | arma::mat U; 16 | arma::vec s; 17 | arma::mat V; 18 | svd(U, s, V, Sig); 19 | arma::mat out = mu + U*diagmat(sqrt(s))*armaNorm(mu.n_elem); 20 | return out; 21 | } 22 | 23 | // [[Rcpp::export]] 24 | arma::mat makeT(const double& b, const double& delta, const double& active){ 25 | arma::mat T(4,4, fill::zeros); 26 | T(0,0) = 1; 27 | T(2,2) = 1; 28 | if(active > 0){ 29 | T(0,1) = exp(R::pexp(delta,1/b,1,1) - log(b)); 30 | T(1,1) = exp(-b*delta); 31 | T(2,3) = exp(R::pexp(delta,1/b,1,1) - log(b)); 32 | T(3,3) = exp(-b*delta); 33 | } 34 | return T; 35 | } 36 | 37 | // [[Rcpp::export]] 38 | arma::mat makeQ(const double& b, const double& sig2, const double& delta, const double& active){ 39 | arma::mat Q(4,4, fill::zeros); 40 | if(active > 0){ 41 | Q(0,0) = sig2*(delta - 2*exp(R::pexp(delta,1/b,1,1)-log(b)) + exp(R::pexp(delta,1/(2*b),1,1)-log(2*b))); 42 | Q(1,1) = sig2*exp(log(b) + R::pexp(delta,1/(2*b),1,1))/2; 43 | Q(0,1) = sig2*(1-2*exp(-b*delta)+exp(-2*b*delta))/2; 44 | Q(1,0) = Q(0,1); 45 | Q.submat(2,2,3,3) = Q.submat(0,0,1,1); 46 | } 47 | return Q; 48 | } 49 | 50 | // [[Rcpp::export]] 51 | arma::mat makeT_drift(const double& b, const double& b_drift, const double& delta, const double& active){ 52 | arma::mat T(6,6, fill::zeros); 53 | T(0,0) = 1; 54 | if(active > 0){ 55 | T(0,1) = exp(R::pexp(delta,1/b,1,1) - log(b)); 56 | T(0,2) = exp(R::pexp(delta,1/b_drift,1,1) - log(b_drift)); 57 | T(1,1) = exp(-b*delta); 58 | T(2,2) = exp(-b_drift*delta); 59 | } 60 | T.submat(3,3,5,5) = T.submat(0,0,2,2); 61 | return T; 62 | } 63 | 64 | // [[Rcpp::export]] 65 | arma::mat makeQ_drift(const double& b, const double& b_drift, const double& sig2, const double& sig2_drift, 66 | const double& delta, const double& active){ 67 | arma::mat Q(6,6, fill::zeros); 68 | if(active > 0){ 69 | Q(0,0) = sig2*(delta - 2*exp(R::pexp(delta,1/b,1,1)-log(b)) + exp(R::pexp(delta,1/(2*b),1,1)-log(2*b))) + 70 | sig2_drift*(delta - 2*exp(R::pexp(delta,1/b_drift,1,1)-log(b_drift)) + exp(R::pexp(delta,1/(2*b_drift),1,1)-log(2*b_drift))); 71 | Q(1,1) = sig2*exp(log(b) + R::pexp(delta,1/(2*b),1,1))/2; 72 | Q(2,2) = sig2_drift*exp(log(b_drift) + R::pexp(delta,1/(2*b_drift),1,1))/2; 73 | Q(0,1) = sig2*(1-2*exp(-b*delta)+exp(-2*b*delta))/2; 74 | Q(1,0) = Q(0,1); 75 | Q(0,2) = sig2_drift*(1-2*exp(-b_drift*delta)+exp(-2*b_drift*delta))/2; 76 | Q(2,0) = Q(0,2); 77 | Q.submat(3,3,5,5) = Q.submat(0,0,2,2); 78 | } 79 | return Q; 80 | } 81 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | 6 | /* FIXME: 7 | Check these declarations against the C/Fortran source code. 8 | */ 9 | 10 | /* .Call calls */ 11 | extern SEXP _crawl_CTCRWNLL(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 12 | extern SEXP _crawl_CTCRWNLL_DRIFT(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 13 | extern SEXP _crawl_CTCRWPREDICT(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 14 | extern SEXP _crawl_CTCRWPREDICT_DRIFT(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 15 | extern SEXP _crawl_CTCRWSAMPLE(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 16 | extern SEXP _crawl_CTCRWSAMPLE_DRIFT(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 17 | extern SEXP _crawl_makeQ(SEXP, SEXP, SEXP, SEXP); 18 | extern SEXP _crawl_makeQ_drift(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 19 | extern SEXP _crawl_makeT(SEXP, SEXP, SEXP); 20 | extern SEXP _crawl_makeT_drift(SEXP, SEXP, SEXP, SEXP); 21 | 22 | static const R_CallMethodDef CallEntries[] = { 23 | {"_crawl_CTCRWNLL", (DL_FUNC) &_crawl_CTCRWNLL, 9}, 24 | {"_crawl_CTCRWNLL_DRIFT", (DL_FUNC) &_crawl_CTCRWNLL_DRIFT, 11}, 25 | {"_crawl_CTCRWPREDICT", (DL_FUNC) &_crawl_CTCRWPREDICT, 9}, 26 | {"_crawl_CTCRWPREDICT_DRIFT", (DL_FUNC) &_crawl_CTCRWPREDICT_DRIFT, 11}, 27 | {"_crawl_CTCRWSAMPLE", (DL_FUNC) &_crawl_CTCRWSAMPLE, 9}, 28 | {"_crawl_CTCRWSAMPLE_DRIFT", (DL_FUNC) &_crawl_CTCRWSAMPLE_DRIFT, 11}, 29 | {"_crawl_makeQ", (DL_FUNC) &_crawl_makeQ, 4}, 30 | {"_crawl_makeQ_drift", (DL_FUNC) &_crawl_makeQ_drift, 6}, 31 | {"_crawl_makeT", (DL_FUNC) &_crawl_makeT, 3}, 32 | {"_crawl_makeT_drift", (DL_FUNC) &_crawl_makeT_drift, 4}, 33 | {NULL, NULL, 0} 34 | }; 35 | 36 | void R_init_crawl(DllInfo *dll) 37 | { 38 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 39 | R_useDynamicSymbols(dll, FALSE); 40 | } --------------------------------------------------------------------------------