Skip to content

reformat code based on air #7

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
mhpob merged 1 commit into from
Sep 10, 2025
Merged

reformat code based on air #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
42 changes: 21 additions & 21 deletions R/COA_Tag_Integrated.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,23 +27,22 @@
#' @seealso [rstan::sampling()]
#' @export
COA_TagInt <- function(
nind,
nrec,
ntime,
ntest,
ntrans,
y,
test,
recX,
recY,
xlim,
ylim,
testX,
testY,
ndraws = NULL,
...
nind,
nrec,
ntime,
ntest,
ntrans,
y,
test,
recX,
recY,
xlim,
ylim,
testX,
testY,
ndraws = NULL,
...
) {

# First move everything into a list
standata <- list(
nind = nind,
Expand All @@ -62,8 +61,7 @@ COA_TagInt <- function(
)

# validate this list prior to sending it to the model
exp_len <- expected_lengths(recX = recX, recY = recY,
ntest_len = ntest)
exp_len <- expected_lengths(recX = recX, recY = recY, ntest_len = ntest)

validate_standata(standata, exp_len)
# set rstan options
Expand All @@ -88,9 +86,11 @@ COA_TagInt <- function(
# How much time did fitting take (in minutes)?
fit_time <- sum(print(rstan::get_elapsed_time(fit_model))) / 60
# # calculate generated quantities
fit_generated_quantities <- generated_quantities(model = fit_model,
standata = standata,
ndraws = ndraws)
fit_generated_quantities <- generated_quantities(
model = fit_model,
standata = standata,
ndraws = ndraws
)
# transform gq into matrix
tran_fit_gq <- transform_gq(fit_generated_quantities)

Expand Down
11 changes: 6 additions & 5 deletions R/COA_TimeVarying.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,6 @@ COA_TimeVarying <- function(
ndraws = NULL,
...
) {

# First move everything into a list
standata <- list(
nind = nind,
Expand All @@ -53,7 +52,7 @@ COA_TimeVarying <- function(

validate_standata(standata, exp_len)

# set rstan options
# set rstan options
rstan::rstan_options(auto_write = TRUE)
# set coores - this probably should be an argument
options(mc.cores = parallel::detectCores())
Expand All @@ -72,9 +71,11 @@ COA_TimeVarying <- function(
fit_time <- sum(print(rstan::get_elapsed_time(fit_model))) / 60

# calculate generated quantities
fit_generated_quantities <- generated_quantities(model = fit_model,
standata = standata,
ndraws = ndraws)
fit_generated_quantities <- generated_quantities(
model = fit_model,
standata = standata,
ndraws = ndraws
)
# transform gq into matrix
tran_fit_gq <- transform_gq(fit_generated_quantities)
# Extract COA estimates
Expand Down
61 changes: 32 additions & 29 deletions R/COA_standard.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,19 +24,18 @@
#'
#' @export
COA_Standard <- function(
nind,
nrec,
ntime,
ntrans,
y,
recX,
recY,
xlim,
ylim,
ndraws = NULL,
...
nind,
nrec,
ntime,
ntrans,
y,
recX,
recY,
xlim,
ylim,
ndraws = NULL,
...
) {

# First move everything into a list
standata <- list(
nind = nind,
Expand Down Expand Up @@ -74,9 +73,11 @@ COA_Standard <- function(
fit_time <- sum(print(rstan::get_elapsed_time(fit_model))) / 60

# calculate generated quantities
fit_generated_quantities <- generated_quantities(model = fit_model,
standata = standata,
ndraws = ndraws)
fit_generated_quantities <- generated_quantities(
model = fit_model,
standata = standata,
ndraws = ndraws
)
# transform gq into matrix
tran_fit_gq <- transform_gq(fit_generated_quantities)
# Extract COA estimates
Expand Down Expand Up @@ -113,19 +114,21 @@ COA_Standard <- function(

coas <- as.data.frame(coas[,, 1])
# Report results
model_results <- list(fit_model,
fit_summary,
fit_time,
coas,
fit_estimates,
tran_fit_gq
)
names(model_results) <- c('model',
'summary',
'time',
'coas',
'all_estimates',
'generated_quantities'
)
model_results <- list(
fit_model,
fit_summary,
fit_time,
coas,
fit_estimates,
tran_fit_gq
)
names(model_results) <- c(
'model',
'summary',
'time',
'coas',
'all_estimates',
'generated_quantities'
)
return(model_results)
}
5 changes: 2 additions & 3 deletions R/distf.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,10 +5,9 @@
#' @export
#' @param x Data frame or matrix containing 2-dimensional coordinates
#' @param y Data frame or matrix containing 2-dimensional coordinates
#' @return 'distf' returns a matrix containing the Euclidean distance between each location in dataframe x with that in dataframe y
#' @return 'distf' returns a matrix containing the Euclidean distance between each location in dataframe x with that in dataframe y
#'
distf=function (x, y)
{
distf = function(x, y) {
i = sort(rep(1:nrow(y), nrow(x)))
dvec = sqrt((x[, 1] - y[i, 1])^2 + (x[, 2] - y[i, 2])^2)
matrix(dvec, nrow = nrow(x), ncol = nrow(y), byrow = F)
Expand Down
51 changes: 26 additions & 25 deletions R/generated_quantities.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,7 @@
#' @keywords internal
#' @name generated_quantities

generated_quantities <- function(model,
standata,
ndraws = NULL) {

generated_quantities <- function(model, standata, ndraws = NULL) {
# check stan object
check_stan_object(model)
# check to see if ntest is in standata this will allow for gq's to be made
Expand Down Expand Up @@ -56,39 +53,44 @@ generated_quantities <- function(model,
}
# create blank array with the name of eveyrhting

yrep <- array(NA, c(nind, nrec, ntime),
dimnames = list(
tag = seq_len(nind),
rec = seq_len(nrec),
time = seq_len(ntime)
)
yrep <- array(
NA,
c(nind, nrec, ntime),
dimnames = list(
tag = seq_len(nind),
rec = seq_len(nrec),
time = seq_len(ntime)
)
)

if (check_test_tag) {
yrep_test <- array(NA, c(ntest, nrec, ntime),
dimnames = list(
tag = seq_len(ntest),
rec = seq_len(nrec),
time = seq_len(ntime)
)
yrep_test <- array(
NA,
c(ntest, nrec, ntime),
dimnames = list(
tag = seq_len(ntest),
rec = seq_len(nrec),
time = seq_len(ntime)
)
)

}
# ----- generate quantities ------
# First for number of detections for each tagged individual
for (t in 1:ntime) {
for (i in 1:nind) {
for (j in 1:nrec) {
# create distances
d <- sqrt((sx[draw, i, t] - recX[j]) ^ 2 +
(sy[draw, i, t] - recY[j]) ^ 2)
d <- sqrt(
(sx[draw, i, t] - recX[j])^2 +
(sy[draw, i, t] - recY[j])^2
)
# make this work for when p0 is dimensions
if (is.matrix(p0)) {
base <- p0[t, j]
} else{
} else {
base <- p0
}
p <- base * exp(-a1 * d ^ 2)
p <- base * exp(-a1 * d^2)
# make sure the pobablity is above 0
p <- min(max(p, 1e-9), 1 - 1e-9)
# then run int using a the iteration of transmission by probability
Expand All @@ -105,9 +107,9 @@ generated_quantities <- function(model,
for (m in 1:nrec) {
for (s in 1:ntest) {
# Euclidean distance between test tag s and receiver m
td <- sqrt((testX[s] - recX[m]) ^ 2 + (testY[s] - recY[m]) ^ 2)
td <- sqrt((testX[s] - recX[m])^2 + (testY[s] - recY[m])^2)
# Probability
ptest <- p0[l, m] * exp(-a1 * td ^ 2)
ptest <- p0[l, m] * exp(-a1 * td^2)
ptest <- min(max(ptest, 1e-9), 1 - 1e-9)
# Simulate detection
yrep_test[s, m, l] <- stats::rbinom(1, ntrans, ptest)
Expand All @@ -118,8 +120,7 @@ generated_quantities <- function(model,
}
}
if (check_test_tag) {
return(list(yrep = yrep_list,
testrep = yrep_test_list))
return(list(yrep = yrep_list, testrep = yrep_test_list))
} else {
return(list(yrep = yrep_list))
}
Expand Down
Loading
Loading