# Scenario Gallery

`boids4R` includes named scenarios for common swarm motifs: compact schools, obstacle corridors, predator avoidance, and 3D murmurations. The examples below run each scenario with a fixed seed, then summarize the recorded frames with plain data-frame operations.

    library(boids4R)

    gallery <- data.frame(
      scenario = c(
        "schooling_2d",
        "obstacle_corridor_2d",
        "predator_avoidance_2d",
        "murmuration_3d",
        "mixed_species_3d"
      ),
      n = c(120L, 120L, 120L, 160L, 150L),
      steps = c(60L, 70L, 70L, 55L, 55L),
      record_every = c(5L, 5L, 5L, 5L, 5L),
      seed = c(111L, 112L, 113L, 114L, 115L),
      stringsAsFactors = FALSE
    )

    sims <- setNames(
      lapply(seq_len(nrow(gallery)), function(i) {
        boids_scenario(
          gallery$scenario[i],
          n = gallery$n[i],
          steps = gallery$steps[i],
          record_every = gallery$record_every[i],
          seed = gallery$seed[i]
        )
      }),
      gallery$scenario
    )

## Compare recorded swarms

A simulation stores every recorded boid as one row per frame. This makes it straightforward to compute summaries without any renderer-specific object model.

    final_frame <- function(sim) {
      frames <- as.data.frame(sim)
      frames[frames$frame == max(frames$frame), , drop = FALSE]
    }

    mean_spread <- function(frame) {
      center <- colMeans(frame[, c("x", "y", "z"), drop = FALSE])
      distance <- sqrt(
        (frame$x - center["x"])^2 +
          (frame$y - center["y"])^2 +
          (frame$z - center["z"])^2
      )
      mean(distance)
    }

    mean_nearest_neighbor <- function(frame) {
      if (nrow(frame) < 2L) return(NA_real_)
      coords <- as.matrix(frame[, c("x", "y", "z"), drop = FALSE])
      distances <- as.matrix(stats::dist(coords))
      diag(distances) <- NA_real_
      mean(apply(distances, 1L, min, na.rm = TRUE), na.rm = TRUE)
    }

    scenario_summary <- function(sim) {
      frames <- as.data.frame(sim)
      final <- final_frame(sim)
      data.frame(
        scenario = sim$scenario,
        dimension = sim$dimension,
        boids = length(unique(final$id)),
        species = paste(sort(unique(final$species)), collapse = ", "),
        recorded_frames = length(unique(frames$frame)),
        mean_final_speed = round(mean(final$speed), 3),
        mean_final_spread = round(mean_spread(final), 3),
        mean_nearest_neighbor = round(mean_nearest_neighbor(final), 3),
        stringsAsFactors = FALSE
      )
    }

    do.call(rbind, lapply(sims, scenario_summary))
    #>                                    scenario dimension boids           species
    #> schooling_2d                   schooling_2d        2d   120              boid
    #> obstacle_corridor_2d   obstacle_corridor_2d        2d   120              boid
    #> predator_avoidance_2d predator_avoidance_2d        2d   120     school, scout
    #> murmuration_3d               murmuration_3d        3d   160              boid
    #> mixed_species_3d           mixed_species_3d        3d   150 kite, swift, tern
    #>                       recorded_frames mean_final_speed mean_final_spread
    #> schooling_2d                       13            1.185             1.413
    #> obstacle_corridor_2d               15            0.920             1.468
    #> predator_avoidance_2d              15            0.932             1.757
    #> murmuration_3d                     12            1.188             1.478
    #> mixed_species_3d                   12            1.192             1.700
    #>                       mean_nearest_neighbor
    #> schooling_2d                          0.174
    #> obstacle_corridor_2d                  0.150
    #> predator_avoidance_2d                 0.139
    #> murmuration_3d                        0.255
    #> mixed_species_3d                      0.308

The same summaries can be split by species. This is useful for mixed flocks or cases where scouts and schooling agents are initialized together.

    species_speed <- do.call(rbind, lapply(sims, function(sim) {
      final <- final_frame(sim)
      out <- stats::aggregate(speed ~ species, final, mean)
      out$scenario <- sim$scenario
      out$mean_final_speed <- round(out$speed, 3)
      out[, c("scenario", "species", "mean_final_speed")]
    }))

    species_speed
    #>                                      scenario species mean_final_speed
    #> schooling_2d                     schooling_2d    boid            1.185
    #> obstacle_corridor_2d     obstacle_corridor_2d    boid            0.920
    #> predator_avoidance_2d.1 predator_avoidance_2d  school            0.936
    #> predator_avoidance_2d.2 predator_avoidance_2d   scout            0.928
    #> murmuration_3d                 murmuration_3d    boid            1.188
    #> mixed_species_3d.1           mixed_species_3d    kite            1.198
    #> mixed_species_3d.2           mixed_species_3d   swift            1.197
    #> mixed_species_3d.3           mixed_species_3d    tern            1.181

## Snapshot plots

The frame table is also enough for quick base-R diagnostics. The helper below draws a final-frame x/y projection, including obstacles, attractors, and predator influence radii when the scenario defines them. For 3D scenarios this is an overhead projection; point size varies with the z coordinate.

    scenario_palette <- function(species) {
      keys <- sort(unique(species))
      stats::setNames(grDevices::hcl.colors(length(keys), "Dark 3"), keys)
    }

    draw_world_marks <- function(world) {
      if (nrow(world$obstacles)) {
        graphics::symbols(
          world$obstacles$x, world$obstacles$y,
          circles = world$obstacles$radius,
          inches = FALSE,
          add = TRUE,
          fg = "gray45",
          bg = grDevices::adjustcolor("gray70", alpha.f = 0.28)
        )
      }
      if (nrow(world$predators)) {
        graphics::symbols(
          world$predators$x, world$predators$y,
          circles = world$predators$radius,
          inches = FALSE,
          add = TRUE,
          fg = "#B24C63",
          lty = 2
        )
        graphics::points(world$predators$x, world$predators$y, pch = 4, col = "#B24C63", lwd = 2)
      }
      if (nrow(world$attractors)) {
        graphics::points(world$attractors$x, world$attractors$y, pch = 8, col = "#2F7E79", lwd = 2)
      }
    }

    draw_snapshot <- function(sim) {
      final <- final_frame(sim)
      world <- sim$world
      palette <- scenario_palette(final$species)
      z_span <- diff(range(final$z))
      cex <- if (z_span > 0) 0.45 + 0.85 * (final$z - min(final$z)) / z_span else 0.75

      graphics::plot(
        final$x, final$y,
        xlim = world$bounds["x", ],
        ylim = world$bounds["y", ],
        asp = 1,
        xlab = "x",
        ylab = "y",
        main = sim$scenario,
        col = palette[final$species],
        pch = 16,
        cex = cex
      )
      draw_world_marks(world)
      graphics::legend(
        "topright",
        legend = names(palette),
        col = palette,
        pch = 16,
        bty = "n",
        cex = 0.75
      )
    }

    old_par <- graphics::par(mfrow = c(2, 2), mar = c(3, 3, 3, 1))
    draw_snapshot(sims$schooling_2d)
    draw_snapshot(sims$obstacle_corridor_2d)
    draw_snapshot(sims$predator_avoidance_2d)
    draw_snapshot(sims$murmuration_3d)

    graphics::par(old_par)

## Hand off to ggWebGL

When `ggWebGL` 0.4.0 or later is installed, the same simulation object can be converted into a timeline-aware WebGL specification. This step is optional and leaves the core simulation object renderer-neutral.

    if (requireNamespace("ggWebGL", quietly = TRUE) &&
        utils::packageVersion("ggWebGL") >= "0.4.0") {
      ggWebGL::ggWebGL(
        as_ggwebgl_spec(sims$mixed_species_3d, vector_every = 12),
        height = 520
      )
    }