--- title: "2D Swarm Scenarios with boids4R" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{2D Swarm Scenarios with boids4R} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_knit$set(purl = FALSE) ggwebgl_truthy <- function(x) { tolower(x) %in% c("1", "true", "yes", "y") } ggwebgl_ci_vars <- c( "CI", "GITHUB_ACTIONS", "GITLAB_CI", "BUILDKITE", "TRAVIS", "APPVEYOR", "CIRCLECI", "JENKINS_URL" ) ggwebgl_is_ci <- any(vapply(Sys.getenv(ggwebgl_ci_vars), ggwebgl_truthy, logical(1))) ggwebgl_is_check <- nzchar(Sys.getenv("_R_CHECK_PACKAGE_NAME_")) ggwebgl_eval_code <- !ggwebgl_is_ci && !ggwebgl_is_check && ( ggwebgl_truthy(Sys.getenv("NOT_CRAN")) || ggwebgl_truthy(Sys.getenv("GGWEBGL_EVAL_COVERAGE_VIGNETTE")) ) ggwebgl_eval_widgets <- ggwebgl_eval_code && ggwebgl_truthy(Sys.getenv("GGWEBGL_EVAL_LIVE_WIDGETS")) knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = ggwebgl_eval_code) if (file.exists("../DESCRIPTION") && requireNamespace("pkgload", quietly = TRUE)) { pkgload::load_all("..", export_all = FALSE, helpers = FALSE, quiet = TRUE) } else { library(ggWebGL) } boids4r_available <- requireNamespace("boids4R", quietly = TRUE) ``` # 2D Swarm Scenarios These examples use `boids4R` scenario builders and render current boids, species-aware velocity arrows, faint recent trails, and obstacle or predator context rings through `ggWebGL`. Code examples are shown by default. Live WebGL widgets are disabled during CRAN, package checks, and CI. Rich local or pkgdown rendering requires `GGWEBGL_EVAL_COVERAGE_VIGNETTE=true` and `GGWEBGL_EVAL_LIVE_WIDGETS=true`. ```{r, eval = ggwebgl_eval_code} if (!boids4r_available) { cat("boids4R is unavailable, so live 2D boids widgets are skipped.\n") } else if (!ggwebgl_eval_widgets) { cat("boids4R is available, but live 2D boids widgets are skipped because live widget evaluation is disabled.\n") } else { cat("boids4R is available; live 2D boids widgets will be rendered below.\n") } ``` ```{r, include = FALSE, eval = ggwebgl_eval_code} render_2d_boids_scenario <- function(name, n, seed) { sim <- boids4R::boids_scenario( name, n = n, steps = 240L, record_every = 3L, seed = seed ) spec <- ggWebGL:::ggwebgl_boids_display_spec( sim, boid_size = 4.2, prey_size = 4.8, predator_size = 7.5, current_alpha = 0.95, trail_alpha = 0.18, vector_mode = "current", vector_colour_mode = "species", vector_every = 1L, vector_alpha = 0.68, vector_width = 1.25, vector_scale = 0.13, obstacle_mode = "ring", obstacle_segments = 48L, obstacle_alpha = 0.9, trail = "recent", trail_length = 32L, shader = "default", speed = 1.4, fps = 24L ) spec$labels$title <- paste("boids4R", name) ggWebGL::ggWebGL(spec, height = 500) } ``` ## Schooling 2D ```{r schooling-2d, eval = ggwebgl_eval_widgets} if (!boids4r_available) { cat("Schooling widget skipped.\n") } else { render_2d_boids_scenario("schooling_2d", n = 180L, seed = 111L) } ``` ## Obstacle Corridor 2D ```{r obstacle-corridor-2d, eval = ggwebgl_eval_widgets} if (!boids4r_available) { cat("Obstacle corridor widget skipped.\n") } else { render_2d_boids_scenario("obstacle_corridor_2d", n = 160L, seed = 112L) } ``` ## Predator Avoidance 2D ```{r predator-avoidance-2d, eval = ggwebgl_eval_widgets} if (!boids4r_available) { cat("Predator avoidance widget skipped.\n") } else { render_2d_boids_scenario("predator_avoidance_2d", n = 170L, seed = 113L) } ```