Skip to content

Standardize getDesign output #47

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
kenkellner merged 7 commits into from
Aug 26, 2025
Merged

Standardize getDesign output #47

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
bda696c
Remove unused zzz.R file
kenkellner Aug 25, 2025
9678257
Update outputs of base getDesign
kenkellner Aug 25, 2025
cd86a58
Update outputs of multFrame and G3 getDesigns
kenkellner Aug 26, 2025
a8f42d9
Update getDesign outputs for dail madsen models
kenkellner Aug 26, 2025
5d40b76
Update GDR and FP getDesign outputs
kenkellner Aug 26, 2025
373f02d
Don't make unnecessary duplicates of getDesign outputs
kenkellner Aug 26, 2025
7b29e4e
Bump version
kenkellner Aug 26, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: unmarked
Version: 1.5.0.9006
Date: 2025-08-01
Version: 1.5.0.9008
Date: 2025-08-26
Type: Package
Title: Models for Data from Unmarked Animals
Authors@R: c(
Expand Down
48 changes: 24 additions & 24 deletions R/IDS.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -102,20 +102,20 @@ IDS <- function(lambdaformula = ~1,
}
ds_hds <- get_ds_info(dataDS@dist.breaks)
Xavail_ds <- matrix(0,0,0)
if(has_avail) Xavail_ds <- getDesign(dataDS, form_avail)$X
if(has_avail) Xavail_ds <- getDesign(dataDS, form_avail)$X_state
if(is.null(durationDS)) durationDS <- rep(0,0)

gd_pc <- list(y=matrix(0,0,0), X=matrix(0,0,0), V=matrix(0,0,0))
gd_pc <- list(y=matrix(0,0,0), X_state=matrix(0,0,0), X_det=matrix(0,0,0))
ds_pc <- list(total_area=0, db=c(0,0), a=0, w=0, u=0)
Xavail_pc <- matrix(0,0,0)
if(is.null(durationPC)) durationPC <- rep(0,0)
if(!is.null(dataPC)){
gd_pc <- getDesign(dataPC, form_pc)
ds_pc <- get_ds_info(c(0, maxDistPC))
if(has_avail) Xavail_pc <- getDesign(dataPC, form_avail)$X
if(has_avail) Xavail_pc <- getDesign(dataPC, form_avail)$X_state
}

gd_oc <- list(y=matrix(0,0,0), X=matrix(0,0,0), V=matrix(0,0,0))
gd_oc <- list(y=matrix(0,0,0), X_state=matrix(0,0,0), X_det=matrix(0,0,0))
ds_oc <- list(total_area=0, db=c(0,0), a=0, w=0, u=0)
Kmin_oc <- rep(0,0)
Xavail_oc <- matrix(0,0,0)
Expand All @@ -124,7 +124,7 @@ IDS <- function(lambdaformula = ~1,
gd_oc <- getDesign(dataOC, form_oc)
ds_oc <- get_ds_info(c(0, maxDistOC))
Kmin_oc <- apply(gd_oc$y, 1, max, na.rm=T)
if(has_avail) Xavail_oc <- getDesign(dataOC, form_avail)$X
if(has_avail) Xavail_oc <- getDesign(dataOC, form_avail)$X_state
}

# Density conversion and unequal area correction
Expand All @@ -143,13 +143,13 @@ IDS <- function(lambdaformula = ~1,

# Parameter stuff------------------------------------------------------------
pind_mat <- matrix(0, nrow=8, ncol=2)
pind_mat[1,] <- c(1, ncol(gd_hds$X))
pind_mat[2,] <- max(pind_mat) + c(1, ncol(gd_hds$V))
pind_mat[1,] <- c(1, ncol(gd_hds$X_state))
pind_mat[2,] <- max(pind_mat) + c(1, ncol(gd_hds$X_det))
if(!is.null(detformulaPC) & !is.null(dataPC)){
pind_mat[3,] <- max(pind_mat) + c(1, ncol(gd_pc$V))
pind_mat[3,] <- max(pind_mat) + c(1, ncol(gd_pc$X_det))
}
if(!is.null(detformulaOC) & !is.null(dataOC)){
pind_mat[4,] <- max(pind_mat) + c(1, ncol(gd_oc$V))
pind_mat[4,] <- max(pind_mat) + c(1, ncol(gd_oc$X_det))
}
if(has_avail){
pind_mat[5,] <- max(pind_mat) + c(1, ncol(Xavail_ds))
Expand All @@ -167,8 +167,8 @@ IDS <- function(lambdaformula = ~1,

if(is.null(starts)){
lam_init <- log(mean(apply(dataDS@y, 1, sum, na.rm=TRUE)) / lam_adjust[1])
params_tmb <- list(beta_lam = c(lam_init, rep(0, ncol(gd_hds$X)-1)),
beta_hds = c(log(median(dataDS@dist.breaks)),rep(0, ncol(gd_hds$V)-1)),
params_tmb <- list(beta_lam = c(lam_init, rep(0, ncol(gd_hds$X_state)-1)),
beta_hds = c(log(median(dataDS@dist.breaks)),rep(0, ncol(gd_hds$X_det)-1)),
beta_pc = rep(0,0),
beta_oc = rep(0,0),
beta_avail = rep(0,0),
Expand All @@ -179,11 +179,11 @@ IDS <- function(lambdaformula = ~1,
if(keyfun == "hazard") params_tmb$beta_schds <- 0

if(!is.null(detformulaPC) & !is.null(dataPC)){
params_tmb$beta_pc <- c(log(maxDistPC/2), rep(0, ncol(gd_pc$V)-1))
params_tmb$beta_pc <- c(log(maxDistPC/2), rep(0, ncol(gd_pc$X_det)-1))
if(keyfun == "hazard") params_tmb$beta_scpc <- 0
}
if(!is.null(detformulaOC) & !is.null(dataOC)){
params_tmb$beta_oc <- c(log(maxDistOC/2), rep(0, ncol(gd_oc$V)-1))
params_tmb$beta_oc <- c(log(maxDistOC/2), rep(0, ncol(gd_oc$X_det)-1))
if(keyfun == "hazard") params_tmb$beta_scoc <- 0
}
if(has_avail){
Expand Down Expand Up @@ -224,16 +224,16 @@ IDS <- function(lambdaformula = ~1,
pind = pind_mat, lam_adjust = lam_adjust,

# HDS data
y_hds = gd_hds$y, X_hds = gd_hds$X, V_hds = gd_hds$V, key_hds = keyidx,
y_hds = gd_hds$y, X_hds = gd_hds$X_state, V_hds = gd_hds$X_det, key_hds = keyidx,
db_hds = dataDS@dist.breaks, a_hds = ds_hds$a, w_hds = ds_hds$w,
u_hds = ds_hds$u,

# PC data
y_pc = gd_pc$y, X_pc = gd_pc$X, V_pc = gd_pc$V, key_pc = keyidx,
y_pc = gd_pc$y, X_pc = gd_pc$X_state, V_pc = gd_pc$X_det, key_pc = keyidx,
db_pc = c(0, maxDistPC), a_pc = ds_pc$a, w_pc = ds_pc$w, u_pc = ds_pc$u,

# occ data
y_oc = gd_oc$y, X_oc = gd_oc$X, V_oc = gd_oc$V, key_oc = keyidx,
y_oc = gd_oc$y, X_oc = gd_oc$X_state, V_oc = gd_oc$X_det, key_oc = keyidx,
db_oc = c(0, maxDistOC), a_oc = ds_oc$a, w_oc = ds_oc$w, u_oc = ds_oc$u,
K_oc = K, Kmin_oc = Kmin_oc,

Expand All @@ -251,37 +251,37 @@ IDS <- function(lambdaformula = ~1,

sdr <- TMB::sdreport(tmb_obj)

lam_coef <- get_coef_info(sdr, "lam", colnames(gd_hds$X),
lam_coef <- get_coef_info(sdr, "lam", colnames(gd_hds$X_state),
pind_mat[1,1]:pind_mat[1,2])

lam_est <- unmarkedEstimate(name="Density", short.name="lam",
estimates = lam_coef$ests, covMat = lam_coef$cov, fixed=1:ncol(gd_hds$X),
estimates = lam_coef$ests, covMat = lam_coef$cov, fixed=1:ncol(gd_hds$X_state),
invlink = "exp", invlinkGrad = "exp")

dist_coef <- get_coef_info(sdr, "hds", colnames(gd_hds$V),
dist_coef <- get_coef_info(sdr, "hds", colnames(gd_hds$X_det),
pind_mat[2,1]:pind_mat[2,2])

dist_est <- unmarkedEstimate(name="Distance sampling detection", short.name="ds",
estimates = dist_coef$ests, covMat = dist_coef$cov, fixed=1:ncol(gd_hds$V),
estimates = dist_coef$ests, covMat = dist_coef$cov, fixed=1:ncol(gd_hds$X_det),
invlink = "exp", invlinkGrad = "exp")

est_list <- list(lam=lam_est, ds=dist_est)

if(!is.null(detformulaPC) & !is.null(dataPC)){
pc_coef <- get_coef_info(sdr, "pc", colnames(gd_pc$V),
pc_coef <- get_coef_info(sdr, "pc", colnames(gd_pc$X_det),
pind_mat[3,1]:pind_mat[3,2])

pc_est <- unmarkedEstimate(name="Point count detection", short.name="pc",
estimates = pc_coef$ests, covMat = pc_coef$cov, fixed=1:ncol(gd_pc$V),
estimates = pc_coef$ests, covMat = pc_coef$cov, fixed=1:ncol(gd_pc$X_det),
invlink = "exp", invlinkGrad = "exp")
est_list <- c(est_list, list(pc=pc_est))
}

if(!is.null(detformulaOC) & !is.null(dataOC)){
oc_coef <- get_coef_info(sdr, "oc", colnames(gd_oc$V),
oc_coef <- get_coef_info(sdr, "oc", colnames(gd_oc$X_det),
pind_mat[4,1]:pind_mat[4,2])
oc_est <- unmarkedEstimate(name="Presence/absence detection", short.name="oc",
estimates = oc_coef$ests, covMat = oc_coef$cov, fixed=1:ncol(gd_oc$V),
estimates = oc_coef$ests, covMat = oc_coef$cov, fixed=1:ncol(gd_oc$X_det),
invlink = "exp", invlinkGrad = "exp")
est_list <- c(est_list, list(oc=oc_est))
}
Expand Down
36 changes: 18 additions & 18 deletions R/RcppExports.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,36 +13,36 @@ nll_distsamp <- function(y, lam, sig, scale, a, u, w, db, keyfun, survey) {
.Call(`_unmarked_nll_distsamp`, y, lam, sig, scale, a, u, w, db, keyfun, survey)
}

nll_distsampOpen <- function(y, yt, Xlam, Xgam, Xom, Xsig, Xiota, beta, bi, Xlam_offset, Xgam_offset, Xom_offset, Xsig_offset, Xiota_offset, ytna, lk, mixture, first, last, first1, M, T, delta, dynamics, survey, fix, go_dims, immigration, I, I1, Ib, Ip, a, u, w, db, keyfun, lfac_k, kmyt, lfac_kmyt, fin, A) {
.Call(`_unmarked_nll_distsampOpen`, y, yt, Xlam, Xgam, Xom, Xsig, Xiota, beta, bi, Xlam_offset, Xgam_offset, Xom_offset, Xsig_offset, Xiota_offset, ytna, lk, mixture, first, last, first1, M, T, delta, dynamics, survey, fix, go_dims, immigration, I, I1, Ib, Ip, a, u, w, db, keyfun, lfac_k, kmyt, lfac_kmyt, fin, A)
nll_distsampOpen <- function(y, yt, X_lambda, X_gamma, X_omega, X_det, X_iota, beta, bi, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, lk, mixture, first, last, first1, M, T, delta, dynamics, survey, fix, go_dims, immigration, I, I1, Ib, Ip, a, u, w, db, keyfun, lfac_k, kmyt, lfac_kmyt, fin, A) {
.Call(`_unmarked_nll_distsampOpen`, y, yt, X_lambda, X_gamma, X_omega, X_det, X_iota, beta, bi, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, lk, mixture, first, last, first1, M, T, delta, dynamics, survey, fix, go_dims, immigration, I, I1, Ib, Ip, a, u, w, db, keyfun, lfac_k, kmyt, lfac_kmyt, fin, A)
}

nll_gdistremoval <- function(beta, n_param, yDistance, yRemoval, ysum, mixture, keyfun, Xlam, A, Xphi, Xrem, Xdist, db, a, u, w, pl, K, Kmin, threads) {
.Call(`_unmarked_nll_gdistremoval`, beta, n_param, yDistance, yRemoval, ysum, mixture, keyfun, Xlam, A, Xphi, Xrem, Xdist, db, a, u, w, pl, K, Kmin, threads)
nll_gdistremoval <- function(beta, n_param, yDistance, yRemoval, ysum, mixture, keyfun, X_lambda, A, X_phi, X_rem, X_dist, db, a, u, w, pl, K, Kmin, threads) {
.Call(`_unmarked_nll_gdistremoval`, beta, n_param, yDistance, yRemoval, ysum, mixture, keyfun, X_lambda, A, X_phi, X_rem, X_dist, db, a, u, w, pl, K, Kmin, threads)
}

nll_gdistsamp <- function(beta, n_param, y, mixture, keyfun, survey, Xlam, Xlam_offset, A, Xphi, Xphi_offset, Xdet, Xdet_offset, db, a, u, w, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads) {
.Call(`_unmarked_nll_gdistsamp`, beta, n_param, y, mixture, keyfun, survey, Xlam, Xlam_offset, A, Xphi, Xphi_offset, Xdet, Xdet_offset, db, a, u, w, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads)
nll_gdistsamp <- function(beta, n_param, y, mixture, keyfun, survey, X_lambda, offset_lambda, A, X_phi, offset_phi, X_det, offset_det, db, a, u, w, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads) {
.Call(`_unmarked_nll_gdistsamp`, beta, n_param, y, mixture, keyfun, survey, X_lambda, offset_lambda, A, X_phi, offset_phi, X_det, offset_det, db, a, u, w, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads)
}

nll_gmultmix <- function(beta, n_param, y, mixture, pi_fun, Xlam, Xlam_offset, Xphi, Xphi_offset, Xdet, Xdet_offset, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads) {
.Call(`_unmarked_nll_gmultmix`, beta, n_param, y, mixture, pi_fun, Xlam, Xlam_offset, Xphi, Xphi_offset, Xdet, Xdet_offset, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads)
nll_gmultmix <- function(beta, n_param, y, mixture, pi_fun, X_lambda, offset_lambda, X_phi, offset_phi, X_det, offset_det, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads) {
.Call(`_unmarked_nll_gmultmix`, beta, n_param, y, mixture, pi_fun, X_lambda, offset_lambda, X_phi, offset_phi, X_det, offset_det, k, lfac_k, lfac_kmyt, kmyt, Kmin, threads)
}

nll_gpcount <- function(ym, Xlam, Xphi, Xp, beta_lam, beta_phi, beta_p, log_alpha, Xlam_offset, Xphi_offset, Xp_offset, M, mixture, T, threads) {
.Call(`_unmarked_nll_gpcount`, ym, Xlam, Xphi, Xp, beta_lam, beta_phi, beta_p, log_alpha, Xlam_offset, Xphi_offset, Xp_offset, M, mixture, T, threads)
nll_gpcount <- function(ym, X_lambda, X_phi, X_det, beta_lambda, beta_phi, beta_det, log_alpha, offset_lambda, offset_phi, offset_det, M, mixture, T, threads) {
.Call(`_unmarked_nll_gpcount`, ym, X_lambda, X_phi, X_det, beta_lambda, beta_phi, beta_det, log_alpha, offset_lambda, offset_phi, offset_det, M, mixture, T, threads)
}

nll_multinomPois <- function(beta, pi_fun, Xlam, Xlam_offset, Xdet, Xdet_offset, y, navec, nP, nAP) {
.Call(`_unmarked_nll_multinomPois`, beta, pi_fun, Xlam, Xlam_offset, Xdet, Xdet_offset, y, navec, nP, nAP)
}

nll_multmixOpen <- function(y, yt, Xlam, Xgam, Xom, Xp, Xiota, beta, bi, Xlam_offset, Xgam_offset, Xom_offset, Xp_offset, Xiota_offset, ytna, yna, lk, mixture, first, last, first1, M, T, J, R, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip, pi_fun, lfac_k, kmyt, lfac_kmyt, fin) {
.Call(`_unmarked_nll_multmixOpen`, y, yt, Xlam, Xgam, Xom, Xp, Xiota, beta, bi, Xlam_offset, Xgam_offset, Xom_offset, Xp_offset, Xiota_offset, ytna, yna, lk, mixture, first, last, first1, M, T, J, R, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip, pi_fun, lfac_k, kmyt, lfac_kmyt, fin)
nll_multmixOpen <- function(y, yt, X_lambda, X_gamma, X_omega, X_det, X_iota, beta, bi, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, yna, lk, mixture, first, last, first1, M, T, J, R, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip, pi_fun, lfac_k, kmyt, lfac_kmyt, fin) {
.Call(`_unmarked_nll_multmixOpen`, y, yt, X_lambda, X_gamma, X_omega, X_det, X_iota, beta, bi, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, yna, lk, mixture, first, last, first1, M, T, J, R, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip, pi_fun, lfac_k, kmyt, lfac_kmyt, fin)
}

nll_nmixTTD <- function(beta, y, delta, W, V, pinds, mixture, tdist, N, J, K, naflag, threads) {
.Call(`_unmarked_nll_nmixTTD`, beta, y, delta, W, V, pinds, mixture, tdist, N, J, K, naflag, threads)
nll_nmixTTD <- function(beta, y, delta, X_state, X_det, pinds, mixture, tdist, N, J, K, naflag, threads) {
.Call(`_unmarked_nll_nmixTTD`, beta, y, delta, X_state, X_det, pinds, mixture, tdist, N, J, K, naflag, threads)
}

nll_occu <- function(y, X, V, beta_psi, beta_p, nd, knownOcc, navec, X_offset, V_offset, link_psi) {
Expand Down Expand Up @@ -73,15 +73,15 @@ nll_occuRN <- function(beta, n_param, y, X, V, X_offset, V_offset, K, Kmin, thre
.Call(`_unmarked_nll_occuRN`, beta, n_param, y, X, V, X_offset, V_offset, K, Kmin, threads)
}

nll_occuTTD <- function(beta, y, delta, W, V, Xgam, Xeps, pind, dind, cind, eind, lpsi, tdist, N, T, J, naflag) {
.Call(`_unmarked_nll_occuTTD`, beta, y, delta, W, V, Xgam, Xeps, pind, dind, cind, eind, lpsi, tdist, N, T, J, naflag)
nll_occuTTD <- function(beta, y, delta, X_psi, X_det, X_col, X_ext, pind, dind, cind, eind, lpsi, tdist, N, T, J, naflag) {
.Call(`_unmarked_nll_occuTTD`, beta, y, delta, X_psi, X_det, X_col, X_ext, pind, dind, cind, eind, lpsi, tdist, N, T, J, naflag)
}

nll_pcount <- function(beta, n_param, y, X, V, X_offset, V_offset, K, Kmin, mixture, threads) {
.Call(`_unmarked_nll_pcount`, beta, n_param, y, X, V, X_offset, V_offset, K, Kmin, mixture, threads)
}

nll_pcountOpen <- function(ym, Xlam, Xgam, Xom, Xp, Xiota, beta_lam, beta_gam, beta_om, beta_p, beta_iota, log_alpha, Xlam_offset, Xgam_offset, Xom_offset, Xp_offset, Xiota_offset, ytna, ynam, lk, mixture, first, last, M, J, T, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip) {
.Call(`_unmarked_nll_pcountOpen`, ym, Xlam, Xgam, Xom, Xp, Xiota, beta_lam, beta_gam, beta_om, beta_p, beta_iota, log_alpha, Xlam_offset, Xgam_offset, Xom_offset, Xp_offset, Xiota_offset, ytna, ynam, lk, mixture, first, last, M, J, T, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip)
nll_pcountOpen <- function(ym, X_lambda, X_gamma, X_omega, X_det, X_iota, beta_lam, beta_gam, beta_om, beta_p, beta_iota, log_alpha, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, ynam, lk, mixture, first, last, M, J, T, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip) {
.Call(`_unmarked_nll_pcountOpen`, ym, X_lambda, X_gamma, X_omega, X_det, X_iota, beta_lam, beta_gam, beta_om, beta_p, beta_iota, log_alpha, offset_lambda, offset_gamma, offset_omega, offset_det, offset_iota, ytna, ynam, lk, mixture, first, last, M, J, T, delta, dynamics, fix, go_dims, immigration, I, I1, Ib, Ip)
}

Loading
Loading