Debug: Interactive API Testing • spdgt.sight

Internal testing vignette for debugging API calls and verifying package functionality.

Authentication required. To run this vignette interactively:

Run spdgt.auth::auth_login() or call any function in this package to authenticate
Open this file in RStudio
Run chunks individually or use “Run All”

# Check if authenticated
has_auth <- tryCatch({
  spdgt.auth::is_auth()
}, error = function(e) FALSE)

has_auth

Part 1: Quick diagnostic

Run the built-in diagnostic function to check API connectivity:

library(spdgt.sight)

sight_check_api()

Part 2: Setup - dynamic lookups

This section discovers available data and establishes context for all subsequent API calls. We pick a sightability survey that has both design rows and entry observations so every function can be exercised.

# Discover available survey data
summaries <- sight_read_surveys()
summaries

# Prefer a Sightability survey type (required for model testing)
sightability <- summaries |>
  dplyr::filter(grepl("Sightability", survey_type, ignore.case = TRUE))

# Find a survey with actual entries (some future-year designs lack entries)
target_row <- NULL
for (i in seq_len(nrow(sightability))) {
  row <- sightability[i, ]
  sp_id <- lkup_species_id(row$species)
  n <- nrow(sight_read_entries_id(
    species_id = sp_id,
    survey_type_id = row$survey_type_id,
    analysis_unit_id = row$analysis_unit_id,
    bio_year = row$bio_year,
    pages = list(size = 1)
  ))
  if (n > 0) {
    target_row <- row
    break
  }
}

if (is.null(target_row)) stop("No sightability survey with entries found")

# Extract context from the selected row
target_species <- target_row$species
target_survey_type <- target_row$survey_type
target_dau <- target_row$analysis_unit
bio_year <- target_row$bio_year

cat("Selected data row:\n")
print(target_row)

# Look up IDs for the selected context
species_id <- lkup_species_id(target_species)
survey_type_id <- lkup_survey_type_id(
  target_survey_type, species_id = species_id
)
analysis_unit_id <- lkup_dau_id(target_dau, species_id = species_id)

cat("Species:", target_species, "(ID:", species_id, ")\n")
cat("Survey Type:", target_survey_type, "(ID:", survey_type_id, ")\n")
cat("Analysis Unit:", target_dau, "(ID:", analysis_unit_id, ")\n")
cat("Bio Year:", bio_year, "\n")

# Get available sightability models
models <- lkup_model()
models

# Find a model that supports the target survey type
model_supports_survey <- sapply(models$survey_type_ids, function(ids) {
  survey_type_id %in% ids
})

if (any(model_supports_survey)) {
  # Use the first model that supports this survey type
  target_model <- models$name[which(model_supports_survey)[1]]
} else {
  # Fallback to first model if none match
  target_model <- models$name[1]
  cat("Warning: No model found for survey type",
      survey_type_id, "- using default\n")
}

model_id <- lkup_model_id(target_model)
cat("Using model:", target_model, "(ID:", model_id, ")\n")

# Summary of context
cat("\n=== Context Summary ===\n")
cat("Species:", target_species, "(", species_id, ")\n")
cat("Survey Type:", target_survey_type, "(", survey_type_id, ")\n")
cat("Analysis Unit:", target_dau, "(", analysis_unit_id, ")\n")
cat("Model:", target_model, "(", model_id, ")\n")
cat("Bio Year:", bio_year, "\n")

Part 3: Lookup functions

Additional lookup examples using the established context.

3.1 Species and survey types

lkup_species()
lkup_species_opts()
lkup_survey_type(species_id = species_id)
lkup_survey_type_opts(species_id = species_id)

3.2 Management units (GMU)

gmus <- lkup_gmu(species_id = species_id)
head(gmus)
lkup_gmu_opts(species_id = species_id) |> head()

3.3 Analysis units (DAU)

daus <- lkup_dau(species_id = species_id)
head(daus)
lkup_dau_opts(species_id = species_id) |> head()

3.4 Strata

strata <- lkup_strata(species_id = species_id, survey_type_id = survey_type_id)
strata
lkup_strata_opts(species_id = species_id, survey_type_id = survey_type_id)

3.5 Models

lkup_model()
lkup_model_opts()

Part 4: Reading survey data (counts API)

4.1 Survey summaries

# All summaries
sight_read_surveys() |> head()

# Filtered and non-compact
sight_read_surveys(
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau
)

sight_read_surveys_id(
  species_id = species_id,
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  compact = FALSE
)

4.2 Survey column mappings

# Get column definitions for the survey type
cols <- sight_read_survey_cols_id(survey_type_id = survey_type_id)
cols

# Named variant
sight_read_survey_cols(
  species = target_species,
  survey_type = target_survey_type
)

4.3 Datasheet column definitions

# Entry column mapping versions for data entry UI configuration
ds_cols <- sight_read_datasheet_cols_id(survey_type_id = survey_type_id)
ds_cols

# Named variant
sight_read_datasheet_cols(
  species = target_species,
  survey_type = target_survey_type
)

4.4 Survey entries (observations)

# Read a page of entries
entries <- sight_read_entries_id(
  species_id = species_id,
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  bio_year = bio_year,
  pages = list(size = 10, number = 1)
)
dplyr::glimpse(entries)

# Named variant
sight_read_entries(
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau,
  bio_year = bio_year,
  pages = list(size = 5, number = 1)
)

4.5 Survey designs

# Read design without observations
designs <- sight_read_design_id(
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  bio_year = bio_year,
  pages = list(size = 10, number = 1)
)
dplyr::glimpse(designs)

# Named variant
sight_read_design(
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau,
  bio_year = bio_year,
  pages = list(size = 5, number = 1)
)

4.6 Designs with entries

# Read design with associated observations
design_entries <- sight_read_design_entries_id(
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  bio_year = bio_year,
  pages = list(size = 10, number = 1)
)
dplyr::glimpse(design_entries)

# Named variant
sight_read_design_entries(
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau,
  bio_year = bio_year,
  pages = list(size = 5, number = 1)
)

4.7 Combined sightability data

# Read combined entry + design data
data <- sight_read_data_id(
  species_id = species_id,
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  bio_year = bio_year
)
cat("Rows:", nrow(data), "\n")
dplyr::glimpse(data)

# Named variant
sight_read_data(
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau,
  bio_year = bio_year
) |> nrow()

Part 5: Model parameters (counts API)

5.1 Model definitions

# Get all models
all_models <- sight_read_model()
all_models

# Get model with covariates
model_detail <- sight_read_model(
  name = target_model,
  includes = c("covars", "surveyTypes")
)
model_detail

5.2 Beta coefficients

# ID variant
betas <- sight_read_betas_id(model_id = model_id, includes = "covar")
betas

# Named variant
sight_read_betas(model = target_model)

5.3 Variance-covariance matrix

# ID variant
vcov <- sight_read_vcov_id(model_id = model_id)
vcov

# Named variant
sight_read_vcov(model = target_model)

5.4 Saved IPM estimates

# ID variant
estimates <- sight_read_estimates_id(
  species_id = species_id,
  analysis_unit_id = analysis_unit_id
)
estimates

# Named variant
sight_read_estimates(
  species = target_species,
  analysis_unit = target_dau
)

Part 6: Sightability API functions

These functions call the sightability Cloud Run API.

6.1 Data preparation

# ID variant
prep <- sight_prep_data_id(
  species_id = species_id,
  bio_year = bio_year,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id,
  model_id = model_id
)

cat("N Observations:", nrow(prep), "\n")
dplyr::glimpse(prep)

# Named variant
sight_prep_data(
  species = target_species,
  bio_year = bio_year,
  analysis_unit = target_dau,
  survey_type = target_survey_type,
  model = target_model
) |>
  nrow() |>
  (\(n) cat("N Observations:", n, "\n"))()

6.2 Model fitting

# ID variant
fit <- sight_fit_model_id(
  species_id = species_id,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id,
  model_id = model_id
)
fit

# Named variant
sight_fit_model(
  species = target_species,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit = target_dau,
  survey_type = target_survey_type,
  model = target_model
)

6.3 Model summary

# ID variant
summ <- sight_fit_summary_id(
  species_id = species_id,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id,
  model_id = model_id
)

cat("Model:", summ$model$name, "(", summ$model$type, ")\n")
cat("Covariates:", paste(summ$model$covariates, collapse = ", "), "\n")
cat("N Observations:", summ$data_summary$n_observations, "\n")
cat("N Strata:", summ$data_summary$n_strata, "\n")
summ$est

# Named variant
sight_fit_summary(
  species = target_species,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit = target_dau,
  survey_type = target_survey_type,
  model = target_model
) |> (\(x) x$est)()

6.4 Full diagnostics

# ID variant
diag <- sight_fit_diagnostics_id(
  species_id = species_id,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id,
  model_id = model_id
)

cat("Observations:", nrow(diag$observations), "\n")
cat("Betas:", nrow(diag$betas), "\n")
cat("Design matrix:", diag$design_matrix$nrow,
    "x", diag$design_matrix$ncol, "\n")
dplyr::glimpse(diag$observations)

# Named variant
sight_fit_diagnostics(
  species = target_species,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit = target_dau,
  survey_type = target_survey_type,
  model = target_model
) |> (\(x) cat("Observations:", nrow(x$observations), "\n"))()

6.5 Wong (SightabilityModel-compatible format)

# ID variant
wong <- sight_prep_wong_id(
  species_id = species_id,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id,
  model_id = model_id
)

cat("odat:", nrow(wong$odat), "rows\n")
cat("sampinfo:", nrow(wong$sampinfo), "rows\n")
cat("formula:", deparse(wong$form), "\n")
cat("betas:", length(wong$bet), "coefficients\n")
cat("varbet:", nrow(wong$varbet), "x", ncol(wong$varbet), "\n")

# Named variant
sight_prep_wong(
  species = target_species,
  spatial_focus = "DAU",
  bio_year = bio_year,
  analysis_unit = target_dau,
  survey_type = target_survey_type,
  model = target_model
) |> (\(x) cat("odat:", nrow(x$odat), "rows\n"))()

6.6 Survey optimization

# ID variant
optimization <- sight_optimize_design_id(
  method = "fixed",
  value = 100,
  species_id = species_id,
  survey_type_id = survey_type_id,
  analysis_unit_id = analysis_unit_id,
  bio_year = bio_year
)
optimization

# Named variant
sight_optimize_design(
  method = "fixed",
  value = 100,
  species = target_species,
  survey_type = target_survey_type,
  analysis_unit = target_dau,
  bio_year = bio_year
)

6.7 Stratum standard deviation

# ID variant (uses entries from all years for the DAU)
stratum_sd <- sight_calc_stratum_sd_id(
  species_id = species_id,
  analysis_unit_id = analysis_unit_id,
  survey_type_id = survey_type_id
)
stratum_sd

# Named variant
sight_calc_stratum_sd(
  species = target_species,
  analysis_unit = target_dau,
  survey_type = target_survey_type
)

6.8 Survey sampling

if (exists("strata") && nrow(strata) > 0) {
  # Get a real payload with designs from the Counts API
  proportions <- lapply(seq_len(nrow(strata)), function(i) {
    list(stratum_id = strata$id[i], proportion = strata$default_prop[i])
  })

  payload_resp <- spdgt.auth::api_post(
    api_name = "counts",
    endpoint = "/aerial-surveys/designs/sample/payload",
    body = list(
      method = "random",
      bio_year = bio_year,
      survey_type_id = survey_type_id,
      analysis_unit_id = analysis_unit_id,
      proportions = proportions
    )
  )

  payload <- httr2::resp_body_json(payload_resp, simplifyVector = FALSE)
  cat("Payload designs:", length(payload$designs), "\n")

  samples <- sight_sample_subunits(method = "random", payload = payload)
  cat("Total:", nrow(samples), "| Selected:", sum(samples$is_selected), "\n")
  dplyr::glimpse(samples)
} else {
  cat("Skipping - no strata defined\n")
}

Session info

sessionInfo()