Utility script for finding Mob Spawners in a Minecraft Bedrock World.

mobspawners.R

# Copyright (c) 2020-2022 Reed A. Cartwright
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
#     Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#
#     Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in
#     the documentation and/or other materials provided with the
#     distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#### EXAMPLE USAGE ####
# source("https://git.io/JTgQx") # read this file from the web
#
# dat <- find_spawners(PATH_TO_WORLD, dimension = 0)
# print(dat)
# write_csv(dat, "MobSpawners.csv")
#
# clusters <- dat %>% filter(Mob == "cave_spider") %>% find_clusters()
# clusters
#
# afk <- clusters %>% filter(Cluster == 1) %>% find_afk_spots()

# find_spawners() is a function that will identify all spawners in
# a dimension in a Minecraft world
# Arguments:
#   `dbpath` is the path to a world directory
#   `dimension` is the dimension you want mobspawners for
#
find_spawners <- function(dbpath, dimension = 0) {
    msg <- progress_bar$new()
    msg$message("Loading World...")

    db <- try(bedrockdb(dbpath))
    if(inherits(db, "try-error")) {
        stop("cannot open world database")
    }
    on.exit(close(db, compact=FALSE))

    msg$message("Inspecting Keys...")
    keys <- get_keys(db) %>% str_subset(str_glue("{dimension}:49$"))

    msg$message("Reading BlockEntity Data...")
    nbt_data <- get_block_entity_data(db, keys)

    close(db, compact=FALSE)

    msg$message("Identifying MobSpawner Data...")

    dat <- nbt_data %>% flatten() %>%
        keep(~.$id == "MobSpawner") %>%
        map_dfr(payload)

    dat <- clean_spawner_dat(dat)

    spawners <- dat %>% transmute(x=as.integer(x), y=as.integer(y), z=as.integer(z),
        Mob = str_replace(EntityIdentifier,"minecraft:",""))

    spawners
}

# find_clusters() is a function that will identify all spawner clusters.
# Arguments:
#   `dat` the (filtered) output of a `find_spawners()` call
#   `min_cluster_size` the minimum cluster size to report
#   `spawn_radius` how close must a player be to a spawner to activate it
#   `precision` how finely to search for afk locations,
#               lower values mean more afk positions tried
#   `tol` a fudge factor used with identifying clusters
#
find_clusters <- function(dat, min_cluster_size = 3, precision = 1, spawn_radius = 16, tol = 0.5) {
    # Height of a players center; its the eyes.
    player_offset <- 1.62001002

    # Identify Spawner Centers
    spawners <- dat %>% mutate(x=x+0.5,y=y+0.5,z=z+0.5)

    # Convert spawner pos to data matrix and take calculate their
    # distances
    spawner_pos <- spawners %>% select(x,y,z) %>% data.matrix()
    spawner_dist <- spawner_pos %>% dist() %>% as.matrix()

    # For every spawner search for player positions that
    # that activate at least 3 spawners
    pb <- progress_bar$new(format = "Looking for mob spawner clusters [:bar] :percent",
        total = nrow(spawner_dist))
    res = list()
    for(irow in 1:nrow(spawner_dist)) {
        # find spawners near the focal one
        # continue if the cluster is not big enough
        idist <- spawner_dist[irow,]
        cluster <- which( idist < 2*spawn_radius+2*tol)
        if(length(cluster) < min_cluster_size) {
            pb$tick()
            next
        }
        # reorder cluster from nearest to farthest away from focus 
        cluster <- cluster[order(idist[cluster])]
        # subset spawners until a the largest group is found that
        # overlaps
        for(j in 1:length(cluster)) {
            # identify the region in which all spawn cubes intersect
            s <- spawners[cluster,]
            pos <- data.matrix(s[,c("x","y","z")])
            aabb <- aabb_intersect(pos, spawn_radius+tol)
            # if region is found check spawn spheres 
            if(!is.null(aabb)) {
                # construct a grid of possible player positions
                xrange <- seq(aabb[1,1], aabb[2,1], precision)
                zrange <- seq(aabb[1,3], aabb[2,3], precision)
                yrange <- seq(ceiling(aabb[1,2]/precision)*precision,
                             floor(aabb[2,2]/precision)*precision,
                             by = precision)
                afkgrid <- expand_grid(x = xrange,
                                      y = yrange,
                                      z = zrange)
                afkgrid <- data.matrix(afkgrid)
                # are their any positions in the spawn radius
                good <- apply(afkgrid, 1, function(x) {
                    # adjust for player center
                    x <- x + c(0,player_offset,0)
                    # calculate distances and check them
                    # use a fudge factor
                    d <- sqrt(colSums((t(pos)-x)**2))
                    all(d <= spawn_radius+tol)
                })
                # did these work? If so great!
                if(any(good)) {
                    break
                }
            }
            # remove the furthermost spawner and try again
            cluster <- cluster[-length(cluster)]
        }
        # add result
        res[[irow]] <- sort(cluster)

        pb$tick()
    }

    res_cleaned <- res %>% compact() %>% unique()
    len <- sapply(res_cleaned,length)
    res_clusters <- res_cleaned[rev(order(len))] %>% 
        map_dfr(~dat[.,], .id="Cluster")

    res_clusters
}

find_afk_spots <- function(dat, min_cluster_size = 3, precision = 1, spawn_radius = 16, tol = 0.5) {
    # Height of a players center; its the eyes.
    player_offset <- 1.62001002
    # identify the region in which all spawn cubes intersect
    pos <- data.matrix(dat[,c("x","y","z")])
    aabb <- aabb_intersect(pos, spawn_radius+tol)
    if(is.null(aabb)) {
        return()
    }
    xrange <- seq(aabb[1,1], aabb[2,1], precision)
    zrange <- seq(aabb[1,3], aabb[2,3], precision)
    yrange <- seq(ceiling(aabb[1,2]/precision)*precision,
                 floor(aabb[2,2]/precision)*precision,
                 by = precision)
    afkgrid <- expand_grid(x = xrange,
                          y = yrange,
                          z = zrange)

    # are their any positions in the spawn radius
    afkgrid$count <- apply(data.matrix(afkgrid), 1, function(x) {
        # adjust for player center
        x <- x + c(0,player_offset,0)
        # calculate distances and check them
        # use a fudge factor
        d <- sqrt(colSums((t(pos)-x)**2))
        sum(d <= spawn_radius)
    })

    afkgrid %>% filter(count >= min_cluster_size) %>%
        arrange(desc(count))
}


# Read mob spawner data from old chunks (before Village & Pillage)
clean_spawner_dat <- function(dat) {
    b <- is.na(dat$EntityIdentifier)
    if(any(b) && has_name(dat,"EntityId")) {
        dat$EntityIdentifier[b] <- recode(dat$EntityId[b],
            "32" = "minecraft:zombie",
            "34" = "minecraft:skeleton",
            "35" = "minecraft:spider",
            "39" = "minecraft:silverfish",
            "40" = "minecraft:cave_spider",
            "43" = "minecraft:blaze",

            "199456" = "minecraft:zombie",
            "1116962" = "minecraft:skeleton",
            "264995" = "minecraft:spider",
            "264999" = "minecraft:silverfish",
            "265000" = "minecraft:cave_spider",
            "2859" = "minecraft:blaze",

            "33753888" = "minecraft:zombie",
            "34671394" = "minecraft:skeleton",
            "33819427" = "minecraft:spider",
            "33819431" = "minecraft:silverfish",
            "33819432" = "minecraft:cave_spider",
            "33557291" = "minecraft:blaze",
     
             .default = ""
        )
    }
    dat
}

aabb_intersect <- function(pos,r=16) {
    xlow <- apply(pos-r,2,max)
    xhigh <- apply(pos+r,2,min)
    if(!all(xlow < xhigh)) {
        return(NULL)
    }
    rbind(xlow,xhigh)
}

# Copyright (c) 2020 RStudio; MIT License
# https://github.com/r-lib/cpp11/blob/master/R/utils.R
stop_unless_installed <- function(pkgs) {
  has_pkg <- logical(length(pkgs))
  for (i in seq_along(pkgs)) {
    has_pkg[[i]] <- requireNamespace(pkgs[[i]], quietly = TRUE)
  }
  if (any(!has_pkg)) {
    msg <- sprintf(
      "The %s package(s) are required for this functionality",
      paste(pkgs[!has_pkg], collapse = ", ")
    )

    if (base::interactive()) {
      ans <- readline(paste(c(msg, "Would you like to install them? (Y/N) "), collapse = "\n"))
      if (tolower(ans) == "y") {
        utils::install.packages(pkgs[!has_pkg])
        stop_unless_installed(pkgs)
        return()
      }
    }

    stop(msg, call. = FALSE)
  }
}

stop_unless_installed(c("tidyverse","progress","rbedrock"))

library(tidyverse)
library(progress)
library(rbedrock)