More refactoring of subchunk palette code.

R/blocks.R

@@ -594,7 +594,7 @@ 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(3,1,2))
+        x[[i]]$values <- aperm(x[[i]]$values, c(1,3,2))
         x[[i]]$palette <- from_rnbt(x[[i]]$palette)
     }
     x
@@ -633,7 +633,7 @@ write_subchunk_layers_value <- function(object, version = 9L,
             abort("an element of `object` is malformed")
         }
         dim(x) <- c(16,16,16)
-        aperm(x, c(2, 3, 1))
+        aperm(x, c(1, 3, 2))
     })
     palette <- purrr::map(object, function(x) {
         if (!has_name(x, "palette") ||

R/data3d.R

@@ -105,7 +105,7 @@ read_data3d_value <- function(rawdata) {
     }
     vec_assert(rawdata, raw())
     height_map <- readBin(rawdata[1:512], integer(), n = 256L, size = 2L,
-                 endian = "little", signed = TRUE)
+                          endian = "little", signed = TRUE)
     dim(height_map) <- c(16L, 16L)
 
     b <- .Call(Cread_chunk_biomes, rawdata[-(1:512)])
@@ -134,45 +134,43 @@ read_data3d_value <- function(rawdata) {
     }
 
     # Fill biome array
-    biome_map <- array(NA_integer_, c(24*16, 16, 16))
+    biome_map <- array(NA_integer_, c(16, 16, 24*16))
 
     # Subchunks with data
     ii <- which(hasdata)
     for(i in ii) {
         bb <- b[[i]]
-        biome_map[16 * (i - 1) + (1:16), , ] <- bb$palette[bb$values]
+        biome_map[, , 16 * (i - 1) + (1:16)] <- bb$palette[bb$values]
     }
-    # Subchunks without data use the highest y level of subchunks with data
+    # Subchunks without data copy from the highest y level of
+    # subchunks with data
     i <- max(ii)
     if(i < 24) {
         y <- 16 * i
-        bb <- rep(biome_map[y, , ], each = 16*24 - y)
-        biome_map[(y+1):(16*24), , ] <- bb
+        biome_map[, , (y+1):(16*24)] <- biome_map[, , y]
     }
-    biome_map <- aperm(biome_map, c(3,1,2))
+    # reshape from x,z,y to x,y,z
+    biome_map <- aperm(biome_map, c(1,3,2))
     list(height_map = height_map, biome_map = biome_map)
 }
 
 reshape_biome_map <- function(value) {
-    # returns biome_map in y,z,x order
+    # returns biome_map in x,z,y order
     n <- length(value)
-    if (n == 1) {
-        array(value, c(16 * 24, 16, 16))
-    } else if (n == 256) {
-        value <- array(value, c(16, 16, 16 * 24))
-        aperm(value, c(3, 2, 1))
+    if (n == 1 || n == 256) {
+        array(value, c(16, 16, 16 * 24))
     } else if(n > 0 && n %% 256 == 0) {
         ny <- length(value) %/% 256
         if(ny == 16 * 24) {
             value <- array(value, c(16, ny, 16))
-            aperm(value, c(2, 3, 1))
+            aperm(value, c(1, 3, 2))
         } else if(ny > 16 * 24) {
             value <- array(value, c(16, ny, 16))
-            aperm(value[1:(16*24) , , ], c(2, 3, 1))
+            aperm(value[, , 1:(16*24)], c(1, 3, 2))
         } else {
-            v <- array(NA_integer_, c(16*24, 16, 16))
-            v[1:ny, , ] <- aperm(value, c(2, 3, 1))
-            v[(ny+1):(16*24), , ] <- rep(value[,ny,], each = 16*24 - ny)
+            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
         }
     } else {
@@ -211,7 +209,7 @@ write_data3d_value <- function(height_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, , ])})
+    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]
     # y levels m to 384 are identical.
@@ -222,7 +220,7 @@ write_data3d_value <- function(height_map, biome_map) {
     palette_list <- rep(list(integer(0L)), 24)
     for (i in 1:mm) {
         j <- (1:16) + (i - 1) * 16
-        id <- c(biome_map[j, , ])
+        id <- c(biome_map[, , j])
         palette_list[[i]] <- vec_unique(id)
         values_list[[i]] <- match(id, palette_list[[i]])
     }

src/subchunk.c

@@ -54,15 +54,12 @@ SEXP read_subchunk_palette_ids(const unsigned char **buffer, const unsigned char
             memcpy(&temp, p, 4);
             p += 4;
             for(int k = 0; k < blocks_per_word && u < 4096; ++k) {
-                // OLD: calculate position as if we did aperm(v, c(3,1,2))
-                // unsigned int x = (u >> 8) & 0xf;
-                // unsigned int y = u & 0xf;
-                // unsigned int z = (u >> 4) & 0xf;
-                // unsigned int pos = x + 16*y + 256*z;
-
-                // NEW: calculate position without permuting
-                // Storage order is y,z,x
-                unsigned int pos = u;
+                // Current order is y,z,x
+                // Reshape to order x,z,y
+                unsigned int x = (u >> 8) & 0xf;
+                unsigned int z = (u >> 4) & 0xf;
+                unsigned int y = u & 0xf;
+                unsigned int pos = x + 16*z + 256*y;
                 // store block id
                 v[pos] = (temp & mask) + 1;
                 temp = temp >> bits_per_block;
@@ -146,12 +143,11 @@ SEXP write_subchunk_palette_ids(SEXP r_values, bool is_persistent, R_xlen_t pale
         // read current word and parse
         unsigned int temp = 0;
         for(int k = 0; k < blocks_per_word && u < 4096; ++k) {
-            // calculate position as if we did aperm(v, c(3,1,2))
-            // unsigned int x = (u >> 8) & 0xf;
-            // unsigned int y = u & 0xf;
-            // unsigned int z = (u >> 4) & 0xf;
-            // unsigned int pos = x + 16*y + 256*z;
-            unsigned int pos = u;
+            // translate x,z,y order to y,z,x order
+            unsigned int x = (u >> 8) & 0xf;
+            unsigned int y = u & 0xf;
+            unsigned int z = (u >> 4) & 0xf;
+            unsigned int pos = x + 16*z + 256*y;
             // store block id
             unsigned int id = v[pos]-1;
             temp |= (id & mask) << k*bits_per_block;