Skip to content

Commit

Permalink
Fix issues identified by lintr
Browse files Browse the repository at this point in the history
  • Loading branch information
@reedacartwright
reedacartwright committed Feb 2, 2025
1 parent 0eddc1e commit 46646ae
Show file tree
Hide file tree
Showing 4 changed files with 91 additions and 80 deletions.
102 changes: 56 additions & 46 deletions R/blocks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,18 +23,20 @@
#' returned by `read_chunk_blocks_value()`.
#' @export
get_chunk_blocks_data <- function(db, x, z, dimension,
names_only = FALSE, extra_block = !names_only,
min_subchunk = TRUE, max_subchunk = !names_only) {
names_only = FALSE,
extra_block = !names_only,
min_subchunk = TRUE,
max_subchunk = !names_only) {
starts_with <- .process_key_args_prefix(x, z, dimension)
starts_with <- vec_unique(starts_with)

dat <- purrr::map(starts_with, function(x) {
.get_chunk_blocks_value_impl(db,
starts_with = x,
names_only = names_only,
extra_block = extra_block,
min_subchunk = min_subchunk,
max_subchunk = max_subchunk)
starts_with = x,
names_only = names_only,
extra_block = extra_block,
min_subchunk = min_subchunk,
max_subchunk = max_subchunk)
})

set_names(dat, starts_with)
Expand All @@ -58,8 +60,10 @@ get_chunk_blocks_values <- get_chunk_blocks_data
#' @rdname get_chunk_blocks_data
#' @export
get_chunk_blocks_value <- function(db, x, z, dimension,
names_only = FALSE, extra_block = !names_only,
min_subchunk = TRUE, max_subchunk = !names_only) {
names_only = FALSE,
extra_block = !names_only,
min_subchunk = TRUE,
max_subchunk = !names_only) {
starts_with <- .process_key_args_prefix(x, z, dimension)
starts_with <- vec_unique(starts_with)

Expand Down Expand Up @@ -92,8 +96,10 @@ put_chunk_blocks_values <- function(db, x, z, dimension, values,
version = 9L) {
keys <- .process_key_args_prefix(x, z, dimension)
values <- vec_recycle(values, length(keys), x_arg = "values")
purrr::walk2(keys, values,
function(x, y) .put_chunk_blocks_value_impl(db, x, y, version = version))
f <- function(x, y) {
.put_chunk_blocks_value_impl(db, x, y, version = version)
}
purrr::walk2(keys, values, f)
}

#' @param value A 16xNx16 character array
Expand All @@ -106,37 +112,39 @@ put_chunk_blocks_value <- function(db, x, z, dimension, value, version = 9L) {
.put_chunk_blocks_value_impl(db, key, value, version = version)
}

.get_chunk_blocks_value_impl <- function(db, starts_with,
names_only, extra_block, min_subchunk, max_subchunk) {
.get_chunk_blocks_value_impl <- function(db, starts_with, names_only,

Check warning on line 115 in R/blocks.R

View workflow job for this annotation

GitHub Actions / lint 

file=R/blocks.R,line=115,col=1,[cyclocomp_linter] Functions should have cyclomatic complexity of less than 15, this has 21.
extra_block, min_subchunk,
max_subchunk) {

p <- .split_chunk_stems(starts_with)
dimension <- p[3]

starts_with <- paste0(starts_with, ":47")
dat <- .get_subchunk_blocks_data_impl(db, starts_with = starts_with,
names_only = names_only, extra_block = extra_block)
names_only = names_only,
extra_block = extra_block)

# calculate lowest and highest subchunks
pos <- purrr::map_int(dat, attr, "offset")
if(is.numeric(min_subchunk)) {
if (is.numeric(min_subchunk)) {
bottom <- as.integer(min_subchunk)
} else if(isTRUE(min_subchunk)) {
bottom <- if(dimension == 0) -4 else 0
} else if(length(pos) > 0L) {
} else if (isTRUE(min_subchunk)) {
bottom <- if (dimension == 0) -4 else 0
} else if (length(pos) > 0L) {
bottom <- min(pos)
} else {
bottom <- NA
}
if(is.numeric(max_subchunk)) {
if (is.numeric(max_subchunk)) {
top <- as.integer(max_subchunk)
} else if(isTRUE(max_subchunk)) {
top <- if(dimension == 0) 19 else if(dimension == 1) 7 else 15
} else if(length(pos) > 0L) {
} else if (isTRUE(max_subchunk)) {
top <- if (dimension == 0) 19 else if (dimension == 1) 7 else 15
} else if (length(pos) > 0L) {
top <- max(pos)
} else {
top <- NA
}
if(is.na(top) || is.na(bottom)) {
if (is.na(top) || is.na(bottom)) {
return(NULL)
}

Expand All @@ -146,7 +154,7 @@ put_chunk_blocks_value <- function(db, x, z, dimension, value, version = 9L) {

# Copy Data
for (i in seq_along(pos)) {
if(pos[i] >= bottom && pos[i] <= top) {
if (pos[i] >= bottom && pos[i] <= top) {
mat[, ((pos[i] - bottom) * 16) + 1:16, ] <- dat[[i]]
}
}
Expand Down Expand Up @@ -189,9 +197,9 @@ chunk_origin <- function(x) {
if (!.valid_blocks_value(value)) {
abort("`value` must be a 16 x 16*N x 16 character array.")
}
if(!.is_blocks_prefix(prefix)) {
if (!.is_blocks_prefix(prefix)) {
prefix_ <- paste0(prefix, ":47")
if(!.is_blocks_prefix(prefix_)) {
if (!.is_blocks_prefix(prefix_)) {
msg <- sprintf("`%s` is not a valid blocks prefix", prefix)
abort(msg)
}
Expand Down Expand Up @@ -310,7 +318,8 @@ NULL
#' @rdname SubchunkBlocks
#' @export
get_subchunk_blocks_data <- function(db, x, z, dimension, subchunk,
names_only = FALSE, extra_block = !names_only) {
names_only = FALSE,
extra_block = !names_only) {
keys <- .process_key_args(x, z, dimension, tag = 47L, subtag = subchunk)

.get_subchunk_blocks_data_impl(db, keys,
Expand Down Expand Up @@ -344,7 +353,8 @@ get_subchunk_blocks_values <- get_subchunk_blocks_data
#' @rdname SubchunkBlocks
#' @export
get_subchunk_blocks_value <- function(db, x, z, dimension, subchunk,
names_only = FALSE, extra_block = !names_only) {
names_only = FALSE,
extra_block = !names_only) {
key <- .process_key_args(x, z, dimension, tag = 47L, subtag = subchunk)
vec_assert(key, character(), 1L)

Expand All @@ -366,8 +376,8 @@ get_subchunk_blocks_value <- function(db, x, z, dimension, subchunk,
#' @rdname SubchunkBlocks
#' @export
get_subchunk_blocks_from_chunk <- function(db, x, z, dimension,
names_only = FALSE, extra_block = !names_only) {

names_only = FALSE,
extra_block = !names_only) {
starts_with <- .process_key_args_prefix(x, z, dimension)
vec_assert(starts_with, character(), 1L)
starts_with <- str_c(starts_with, ":47")
Expand Down Expand Up @@ -593,8 +603,8 @@ read_subchunk_layers_value <- function(rawdata) {
}
vec_assert(rawdata, raw())
x <- .Call(Cread_subchunk_blocks, rawdata)
for(i in seq_along(x)) {
x[[i]]$values <- aperm(x[[i]]$values, c(1,3,2))
for (i in seq_along(x)) {
x[[i]]$values <- aperm(x[[i]]$values, c(1, 3, 2))
x[[i]]$palette <- from_rnbt(x[[i]]$palette)
}
x
Expand Down Expand Up @@ -632,7 +642,7 @@ write_subchunk_layers_value <- function(object, version = 9L,
if (length(x) != 16 * 16 * 16) {
abort("an element of `object` is malformed")
}
dim(x) <- c(16,16,16)
dim(x) <- c(16, 16, 16)
aperm(x, c(1, 3, 2))
})
palette <- purrr::map(object, function(x) {
Expand Down Expand Up @@ -833,22 +843,22 @@ subchunk_coords <- function(ind, origins = subchunk_origins(names(ind))) {
}

.chunk_blocks_apply_offsets <- function(args, dims, origin) {
if(length(args) == length(dims)) {
for(i in seq_along(args)) {
if(is.numeric(args[[i]])) {
if (length(args) == length(dims)) {
for (i in seq_along(args)) {
if (is.numeric(args[[i]])) {
ii <- args[[i]] - origin[i] + 1L
if(any(ii < 1L, na.rm = TRUE)) {
if (any(ii < 1L, na.rm = TRUE)) {
rlang::abort("subscript out of bounds")
}
args[[i]] <- ii
}
}
} else if(length(args) == 1L) {
if(is.matrix(args[[1]]) && is.numeric(args[[1]])) {
} else if (length(args) == 1L) {
if (is.matrix(args[[1]]) && is.numeric(args[[1]])) {
# adjust indices
args[[1]] <- sweep(args[[1]], 2, origin) + 1L
}
} else if(length(args) != 0L) {
} else if (length(args) != 0L) {
rlang::abort("incorrect number of dimensions")
}

Expand All @@ -858,10 +868,10 @@ subchunk_coords <- function(ind, origins = subchunk_origins(names(ind))) {
#' Extract or replace chunk blocks from an array
#'
#' Convenience wrappers around `[` to extract or replace blocks from an array
#' based on block coordinates.
#' based on block coordinates.
#'
#' @param x Object from which to extract element(s) or in which to replace
#' element(s).
#' element(s).
#' @param drop if `TRUE` the result is coerced to the lowest possible dimension.
#' @param origin the origin of the chunk array, used for mapping coordinates to
#' indices
Expand All @@ -873,8 +883,8 @@ subchunk_coords <- function(ind, origins = subchunk_origins(names(ind))) {
#' @export
chunk_blocks <- function(x, ..., drop = TRUE, origin = chunk_origin(x)) {
args <- rlang::dots_list(..., .named = NULL,
.preserve_empty = TRUE,
.ignore_empty = "none")
.preserve_empty = TRUE,
.ignore_empty = "none")
args <- .chunk_blocks_apply_offsets(args, dim(x), origin)

# if this fails the error message is gnarly, see rlang::exec docs
Expand All @@ -885,8 +895,8 @@ chunk_blocks <- function(x, ..., drop = TRUE, origin = chunk_origin(x)) {
#' @export
`chunk_blocks<-` <- function(x, ..., origin = chunk_origin(x), value) {
args <- rlang::dots_list(..., .named = NULL,
.preserve_empty = TRUE,
.ignore_empty = "none")
.preserve_empty = TRUE,
.ignore_empty = "none")
args <- .chunk_blocks_apply_offsets(args, dim(x), origin)

rlang::exec(`[<-`, x, !!!args, value = value)
Expand Down
47 changes: 24 additions & 23 deletions R/data3d.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,47 +110,48 @@ read_data3d_value <- function(rawdata) {

b <- .Call(Cread_chunk_biomes, rawdata[-(1:512)])
# Validate Biome Data
if(length(b) == 0 || is.null(b[[1]])) {
if (length(b) == 0 || is.null(b[[1]])) {
abort("Value does not contain at least one subchunk of biome data.")
}
# Enlarge list to length 24 if necessary.
if(length(b) < 24) {
if (length(b) < 24) {
b[24] <- list(NULL)
}
# Validate Biome Data
hasdata <- !sapply(b, is.null)
n <- length(hasdata)
if(sum(hasdata[-1] != hasdata[-n]) > 1) {
abort("Value contains empty subchunk of biome data between valid subchunks.")
if (sum(hasdata[-1] != hasdata[-n]) > 1) {
abort("Value contains empty biome data between valid subchunks.")
}
# Trim biome data
if(n > 24) {
if(any(hasdata[25:n])) {
msg <- sprintf("Trimming biome data from %d to 24 subchunks.", length(b))
if (n > 24) {
if (any(hasdata[25:n])) {
msg <- sprintf("Trimming biome data from %d to 24 subchunks.",
length(b))
warn(msg)
}
b <- b[1:24]
hasdata <- hasdata[1:24]
}

# Fill biome array
biome_map <- array(NA_integer_, c(16, 16, 24*16))
biome_map <- array(NA_integer_, c(16, 16, 24 * 16))

# Subchunks with data
ii <- which(hasdata)
for(i in ii) {
for (i in ii) {
bb <- b[[i]]
biome_map[, , 16 * (i - 1) + (1:16)] <- bb$palette[bb$values]
}
# Subchunks without data copy from the highest y level of
# subchunks with data
i <- max(ii)
if(i < 24) {
if (i < 24) {
y <- 16 * i
biome_map[, , (y+1):(16*24)] <- biome_map[, , y]
biome_map[, , (y + 1):(16 * 24)] <- biome_map[, , y]
}
# reshape from x,z,y to x,y,z
biome_map <- aperm(biome_map, c(1,3,2))
biome_map <- aperm(biome_map, c(1, 3, 2))
list(height_map = height_map, biome_map = biome_map)
}

Expand All @@ -159,18 +160,18 @@ reshape_biome_map <- function(value) {
n <- length(value)
if (n == 1 || n == 256) {
array(value, c(16, 16, 16 * 24))
} else if(n > 0 && n %% 256 == 0) {
} else if (n > 0 && n %% 256 == 0) {
ny <- length(value) %/% 256
if(ny == 16 * 24) {
if (ny == 16 * 24) {
value <- array(value, c(16, ny, 16))
aperm(value, c(1, 3, 2))
} else if(ny > 16 * 24) {
} else if (ny > 16 * 24) {
value <- array(value, c(16, ny, 16))
aperm(value[, , 1:(16*24)], c(1, 3, 2))
aperm(value[, , 1:(16 * 24)], c(1, 3, 2))
} else {
v <- array(NA_integer_, c(16, 16, 16*24))
v <- array(NA_integer_, c(16, 16, 16 * 24))
v[, , 1:ny] <- aperm(value, c(1, 3, 2))
v[, , (ny+1):(16*24)] <- v[, , ny]
v[, , (ny + 1):(16 * 24)] <- v[, , ny]
v
}
} else {
Expand Down Expand Up @@ -207,14 +208,14 @@ write_data3d_value <- function(height_map, biome_map) {
# reshape biome_map
biome_map <- reshape_biome_map(biome_map)

# identify y levels with repetitive biomes
y <- (16*24):2
o <- sapply(y, function(x) {any(biome_map[,,x] != biome_map[, , x-1])})
# identify y levels with repetitive biomes
y <- (16 * 24):2
o <- sapply(y, function(x) any(biome_map[, , x] != biome_map[, , x - 1]))
m <- match(TRUE, o)
m <- if(is.na(m)) 1 else y[m]
m <- if (is.na(m)) 1 else y[m]
# y levels m to 384 are identical.
# chunks 1:mm need to be written
mm <- ((m-1) %/% 16) + 1
mm <- ((m - 1) %/% 16) + 1

values_list <- rep(list(integer(0L)), 24)
palette_list <- rep(list(integer(0L)), 24)
Expand Down
Loading

0 comments on commit 46646ae

Please sign in to comment.