Skip to contents

Advanced Workflow

Source: vignettes/advanced-workflow.qmd

This guide covers complex use cases, performance optimizations, and edge case handling for arthelpers functions.

Advanced Screenshot Workflows

Multi-App Comparison

Capture screenshots of multiple app variants for visual regression testing:

library(shiny)
library(arthelpers)

# Define app variants
variants <- list(
  baseline = shinyApp(
    ui = fluidPage(theme = bslib::bs_theme(version = 5), h1("Version 1")),
    server = function(input, output) {}
  ),
  updated = shinyApp(
    ui = fluidPage(theme = bslib::bs_theme(version = 5), h1("Version 2")),
    server = function(input, output) {}
  )
)

# Capture all variants
screenshots <- lapply(names(variants), function(name) {
  file <- sprintf("screenshots/%s.png", name)
  screenshot_app(variants[[name]], file = file, method = "webshot2")
  file
})

# Compare with image comparison tool (external)
# system(sprintf("compare %s %s diff.png", screenshots[[1]], screenshots[[2]]))

Screenshot with Custom Chrome Flags

For advanced Chrome configuration, use chromote method:

library(chromote)

# Custom screenshot with specific Chrome flags
app <- shinyApp(
  ui = fluidPage(plotOutput("plot")),
  server = function(input, output) {
    output$plot <- renderPlot({ plot(1:10) })
  }
)

# Use chromote for fine-grained control
screenshot_app(
  app,
  method = "chromote",
  vwidth = 1920,
  vheight = 1080,
  delay = 1,
  port = 8888,
  max_wait_attempts = 100  # Increase for slow-loading apps
)

Parallel Screenshot Capture

Capture multiple apps concurrently using futures:

library(future)
library(future.apply)

plan(multisession, workers = 4)

# Create multiple test apps
apps <- lapply(1:10, function(i) {
  shinyApp(
    ui = fluidPage(h1(paste("App", i))),
    server = function(input, output) {}
  )
})

# Screenshot in parallel
screenshots <- future_lapply(seq_along(apps), function(i) {
  screenshot_app(
    apps[[i]],
    file = sprintf("output/app_%02d.png", i),
    method = "webshot2"
  )
})

Performance note: Parallel screenshot capture works best with webshot2 method. Avoid parallelizing chromote method (port conflicts) or shinytest2 (resource contention).

Screenshot with Authentication

Capture screenshots of apps requiring authentication:

library(shinytest2)

# App with authentication
app_dir <- "path/to/auth-app"

# Manual approach with shinytest2
ad <- shinytest2::AppDriver$new(app_dir)

# Simulate login
ad$set_inputs(username = "testuser")
ad$set_inputs(password = "testpass")
ad$click("login_button")
ad$wait_for_idle()

# Screenshot authenticated state
ad$get_screenshot("authenticated.png")
ad$stop()

Advanced Environment Diagnostics

Compare Environments Across Machines

Capture environment info for reproducibility reports:

# Machine 1 (development)
env_dev <- describe_env(quiet = TRUE)
saveRDS(env_dev, "env_dev.rds")

# Machine 2 (production)
env_prod <- describe_env(quiet = TRUE)
saveRDS(env_prod, "env_prod.rds")

# Compare (on analysis machine)
env_dev <- readRDS("env_dev.rds")
env_prod <- readRDS("env_prod.rds")

# Check version mismatches
dev_versions <- env_dev$deps_versions
prod_versions <- env_prod$deps_versions

mismatches <- names(dev_versions)[dev_versions != prod_versions[names(dev_versions)]]

if (length(mismatches) > 0) {
  cat("Version mismatches:\n")
  for (pkg in mismatches) {
    cat(sprintf("  %s: dev=%s, prod=%s\n",
                pkg, dev_versions[pkg], prod_versions[pkg]))
  }
}

Extract Environment Info for CI/CD

Integrate describe_env() into CI pipelines:

# In CI script
env <- describe_env(quiet = TRUE)

# Write to file for CI artifacts
writeLines(
  c(
    sprintf("Package: %s", env$pkg_name),
    sprintf("Version: %s", env$pkg_desc["Version"]),
    "Dependencies:",
    sprintf("  %s: %s", names(env$deps_versions), env$deps_versions)
  ),
  "ci-env-summary.txt"
)

Custom Environment Filters

The function masks sensitive vars automatically, but you can post-process for custom filters:

env <- describe_env(quiet = TRUE)

# Filter to only PATH-related variables
path_vars <- env$env_vars[grepl("PATH", names(env$env_vars), ignore.case = TRUE)]
print(path_vars)

# Extract only R-related variables
r_vars <- env$env_vars[grepl("^R_", names(env$env_vars))]
print(r_vars)

Advanced Repository Operations

Track Repository Changes Over Time

Monitor when new repos are added:

library(data.table)

# Capture current state
repos_today <- get_repo_index()
saveRDS(repos_today, sprintf("repos_%s.rds", Sys.Date()))

# Compare to previous capture
repos_previous <- readRDS("repos_2024-01-01.rds")

# Find new repos
new_repos <- repos_today[!repo_name %in% repos_previous$repo_name]

if (nrow(new_repos) > 0) {
  cat("New repositories since 2024-01-01:\n")
  print(new_repos[, .(repo_name, description)])
}

# Find archived/deleted repos
removed_repos <- repos_previous[!repo_name %in% repos_today$repo_name]

if (nrow(removed_repos) > 0) {
  cat("Removed repositories:\n")
  print(removed_repos[, .(repo_name)])
}

Generate Documentation Snippets

Automatically generate markdown tables for documentation:

repos <- get_repo_index()

# Filter to public repos only
public_repos <- repos[visibility == "public"]

# Generate markdown table
cat("| Repository | Description |\n")
cat("|------------|-------------|\n")
for (i in seq_len(nrow(public_repos))) {
  cat(sprintf("| [%s](%s) | %s |\n",
              public_repos$repo_name[i],
              public_repos$repo_url[i],
              public_repos$description[i]))
}

Repository Analytics

Analyze repository metadata:

repos <- get_repo_index()

# Count by visibility
visibility_counts <- repos[, .N, by = visibility]
print(visibility_counts)
#>   visibility  N
#> 1:    private 25
#> 2:     public  3

# Find repos without descriptions
no_desc <- repos[is.na(description)]
cat("Repos missing descriptions:", nrow(no_desc), "\n")
print(no_desc[, .(repo_name)])

Advanced Database Cleanup

Conditional Cleanup Based on Age

Delete old test data while preserving recent records:

library(artcore)
library(data.table)

cn <- ..dbc()

# Find old test artworks (example: over 7 days old)
old_artworks <- DBI::dbGetQuery(cn, "
  SELECT art_uuid, created_utc
  FROM app.artwork_index
  WHERE artist_uuid = '746b8207-...'  -- test artist
    AND created_utc < NOW() - INTERVAL '7 days'
")

cat("Found", nrow(old_artworks), "old test artworks\n")

# Delete old artworks
for (art in old_artworks$art_uuid) {
  delete_artwork(artwork = art, delete_cdn = TRUE, cn = cn)
}

..dbd(cn)

Safe Deletion with Confirmation

Implement confirmation prompts for production-adjacent environments:

safe_delete_artist <- function(artist, delete_cdn = FALSE) {
  library(artcore)

  # Preview what will be deleted
  cn <- ..dbc()
  artworks <- DBI::dbGetQuery(cn,
    sprintf("SELECT COUNT(*) as n FROM app.artwork_index WHERE artist_uuid = '%s'", artist)
  )
  ..dbd(cn)

  cat(sprintf("About to delete artist %s and %d artworks\n", artist, artworks$n))
  cat("CDN deletion:", ifelse(delete_cdn, "YES", "NO"), "\n")

  response <- readline("Type 'DELETE' to confirm: ")

  if (response == "DELETE") {
    delete_artist(artist = artist, delete_cdn = delete_cdn)
    cat("Deletion complete\n")
  } else {
    cat("Deletion cancelled\n")
  }
}

# Usage
safe_delete_artist("746b8207-...", delete_cdn = TRUE)

Cleanup with Transaction Rollback Testing

Test deletion logic without committing changes:

library(DBI)
library(artcore)

cn <- ..dbc()

# Start transaction
dbBegin(cn)

# Perform deletion
delete_artwork(
  artwork = "99a61148-...",
  delete_cdn = FALSE,  # Don't delete CDN yet
  cn = cn
)

# Verify deletion
result <- dbGetQuery(cn,
  "SELECT COUNT(*) as n FROM app.artwork_index WHERE art_uuid = '99a61148-...'")

if (result$n == 0) {
  cat("Deletion logic works correctly\n")
}

# Rollback (undo deletion)
dbRollback(cn)

# Verify rollback
result <- dbGetQuery(cn,
  "SELECT COUNT(*) as n FROM app.artwork_index WHERE art_uuid = '99a61148-...'")

if (result$n == 1) {
  cat("Rollback successful - record restored\n")
}

..dbd(cn)

Note: CDN deletion cannot be rolled back. Always test with delete_cdn = FALSE first.

Bulk Deletion Performance

For large-scale cleanup, optimize with batching:

library(artcore)

# Get all test artworks
cn <- ..dbc()
test_artworks <- DBI::dbGetQuery(cn,
  "SELECT art_uuid FROM app.artwork_index WHERE artist_uuid = '746b8207-...'")
..dbd(cn)

cat("Deleting", nrow(test_artworks), "artworks\n")

# Delete in batches
batch_size <- 50
batches <- split(test_artworks$art_uuid, ceiling(seq_along(test_artworks$art_uuid) / batch_size))

cn <- ..dbc()

for (i in seq_along(batches)) {
  cat(sprintf("Processing batch %d/%d\n", i, length(batches)))

  for (art in batches[[i]]) {
    delete_artwork(artwork = art, delete_cdn = TRUE, cn = cn)
  }

  # Brief pause between batches to avoid overwhelming API rate limits
  Sys.sleep(1)
}

..dbd(cn)

Performance Considerations

Screenshot Method Selection

Choose the right method based on your needs:

Method Speed Memory Use Case
webshot2 Fast Low Static UI, documentation
shinytest2 Medium Medium Reactive apps, testing
chromote Medium High Complex scenarios, debugging

Benchmark comparison:

library(tictoc)

app <- shinyApp(
  ui = fluidPage(h1("Test")),
  server = function(input, output) {}
)

# webshot2
tic("webshot2")
screenshot_app(app, method = "webshot2", file = "test1.png")
toc()
#> webshot2: 1.2 sec elapsed

# shinytest2
tic("shinytest2")
screenshot_app(app, method = "shinytest2", file = "test2.png")
toc()
#> shinytest2: 2.8 sec elapsed

# chromote
tic("chromote")
screenshot_app(app, method = "chromote", file = "test3.png")
toc()
#> chromote: 2.1 sec elapsed

Database Connection Reuse

Reusing connections significantly improves performance for batch operations:

library(tictoc)

artworks <- c("99a61148-...", "99a61148-...", "99a61148-...")

# Without connection reuse
tic("no reuse")
for (art in artworks) {
  delete_artwork(artwork = art, cn = NULL)  # Creates new connection each time
}
toc()
#> no reuse: 3.5 sec elapsed

# With connection reuse
tic("with reuse")
cn <- artcore::dbc()
for (art in artworks) {
  delete_artwork(artwork = art, cn = cn)
}
artcore::dbd(cn)
toc()
#> with reuse: 0.8 sec elapsed

Performance gain: ~4x faster for batch operations.

CDN Deletion Robustness

CDN deletion is robust to missing assets but warnings can clutter output. Suppress for cleaner logs:

# Suppress CDN warnings (missing assets are OK during cleanup)
suppressWarnings({
  delete_artwork(artwork = "99a61148-...", delete_cdn = TRUE)
})

# Or capture warnings programmatically
result <- withCallingHandlers(
  delete_artwork(artwork = "99a61148-...", delete_cdn = TRUE),
  warning = function(w) {
    if (grepl("cleanup skipped", w$message)) {
      # Log to file instead of console
      cat(w$message, file = "cleanup-warnings.log", append = TRUE)
      invokeRestart("muffleWarning")
    }
  }
)

Error Handling Patterns

Graceful Failure for Missing Records

Handle cases where records may already be deleted:

artworks_to_delete <- c("99a61148-...", "99b72259-...", "99c83360-...")

for (art in artworks_to_delete) {
  result <- delete_artwork(artwork = art, delete_cdn = TRUE)

  if (result) {
    cat("Deleted:", art, "\n")
  } else {
    cat("Skipped (not found):", art, "\n")
  }
}

Retry Logic for API Calls

Handle transient failures when using get_repo_index():

get_repo_index_retry <- function(org = "artalytics", max_attempts = 3) {
  for (attempt in 1:max_attempts) {
    result <- tryCatch(
      get_repo_index(org = org),
      error = function(e) {
        if (attempt < max_attempts) {
          cat(sprintf("Attempt %d failed, retrying...\n", attempt))
          Sys.sleep(2^attempt)  # Exponential backoff
          NULL
        } else {
          stop("Failed after ", max_attempts, " attempts: ", e$message)
        }
      }
    )

    if (!is.null(result)) return(result)
  }
}

repos <- get_repo_index_retry()

Next Steps