array2dt添加测试，放心使用

Author: kongdd

NAMESPACE

@@ -240,6 +240,7 @@ importFrom(crayon,red)
 importFrom(crayon,underline)
 importFrom(data.table,CJ)
 importFrom(data.table,as.data.table)
+importFrom(data.table,chmatch)
 importFrom(data.table,data.table)
 importFrom(data.table,dcast)
 importFrom(data.table,fread)

R/tools_data.table.R

@@ -33,7 +33,7 @@ fwrite2 <- function(x, file) {
 #' 
 #' @example R/examples/array2dt.R
 #' 
-#' @importFrom data.table CJ
+#' @importFrom data.table CJ chmatch
 #' @export
 array2dt <- function(arr, dimnames) {
   # 注意顺序要匹配，aperm非常必要!
@@ -47,12 +47,15 @@ dt2array <- function(dt, value_col = "value") {
   # 获取维度列（除了值列之外的所有列）
   dim_cols <- setdiff(names(dt), value_col)
 
-  # 获取每个维度的唯一值（保持原顺序）
-  dimnames <- lapply(dt[, ..dim_cols], function(x) unique(x))
-
-  # 创建 array 并用 aperm 调整维度顺序
-  dims <- lengths(dimnames) # 计算维度大小
-  dim = rev(dims) %>% setNames(NULL)
-  arr <- array(dt[[value_col]], dim = dim, dimnames = rev(dimnames))
-  aperm(arr)
+  # 获取每个维度的唯一值（保持首次出现的顺序）
+  dimnames <- lapply(dt[, ..dim_cols], unique)
+  dims <- setNames(lengths(dimnames), NULL)
+
+  # 按维度取值定位填充，不依赖 dt 的行顺序；缺失组合记为 NA
+  # 字符列用 data.table::chmatch (比 match 快约 5 倍)，其余用 match
+  .match <- function(x, levs) if (is.character(x)) chmatch(x, levs) else match(x, levs)
+  idx <- mapply(function(col, levs) .match(dt[[col]], levs), dim_cols, dimnames)
+  arr <- array(dt[[value_col]][NA_integer_], dim = dims, dimnames = dimnames)
+  arr[idx] <- dt[[value_col]]
+  arr
 }

tests/testthat/test-array2dt.R

@@ -1,19 +1,121 @@
-test_that("array2dt works", {
-  # 测试往返转换
-  arr <- array(1:6,
+## helpers ---------------------------------------------------------------------
+make_arr <- function() {
+  array(1:6,
     dim = c(2, 3),
+    dimnames = list(site = c("A", "B"), date = c("d1", "d2", "d3"))
+  )
+}
+
+make_arr3 <- function() {
+  array(1:24,
+    dim = c(2, 3, 4),
     dimnames = list(
       site = c("A", "B"),
-      date = c("d1", "d2", "d3")
-      # var = c("v1", "v2", "v3", "v4")
+      date = c("d1", "d2", "d3"),
+      var  = paste0("v", 1:4)
     )
   )
+}
 
-  # array -> dt
+## array2dt --------------------------------------------------------------------
+test_that("array2dt: 维度列、行数与列名正确", {
+  arr <- make_arr()
   dt <- array2dt(arr, dimnames(arr))
+
+  expect_s3_class(dt, "data.table")
+  expect_equal(nrow(dt), prod(dim(arr)))
+  expect_equal(names(dt), c("site", "date", "value"))
+})
+
+test_that("array2dt: 展开顺序为最后一维变化最快 (CJ 顺序)", {
+  arr <- make_arr()
+  dt <- array2dt(arr, dimnames(arr))
+
+  # 第一维 (site) 变化最慢，最后一维 (date) 变化最快
+  expect_equal(dt$site, rep(c("A", "B"), each = 3))
+  expect_equal(dt$date, rep(c("d1", "d2", "d3"), times = 2))
+  # 值需与 array 下标严格对应
   expect_equal(dt[site == "A", value], c(1, 3, 5))
+  expect_equal(dt[site == "B", value], c(2, 4, 6))
+})
+
+test_that("array2dt: 支持三维数组", {
+  arr <- make_arr3()
+  dt <- array2dt(arr, dimnames(arr))
+
+  expect_equal(nrow(dt), 24)
+  expect_equal(names(dt), c("site", "date", "var", "value"))
+  expect_equal(dt[site == "A" & date == "d1", value], as.vector(arr["A", "d1", ]))
+})
+
+## dt2array --------------------------------------------------------------------
+test_that("dt2array: 二维往返转换", {
+  arr <- make_arr()
+  expect_equal(dt2array(array2dt(arr, dimnames(arr))), arr)
+})
+
+test_that("dt2array: 三维往返转换", {
+  arr <- make_arr3()
+  expect_equal(dt2array(array2dt(arr, dimnames(arr))), arr)
+})
+
+test_that("dt2array: 值的填充不依赖 dt 的行顺序 (回归测试)", {
+  arr <- make_arr3()
+  dt <- array2dt(arr, dimnames(arr))
+
+  # 维度 level 顺序恰好保持时, 应与原数组完全一致
+  expect_equal(dt2array(dt[order(value)]), arr)
+  expect_equal(dt2array(data.table::setkey(data.table::copy(dt), var)), arr)
+
+  # 完全打乱行序: level 顺序按首次出现推断, 重排回原顺序后值应一致
+  set.seed(1)
+  r <- dt2array(dt[sample(.N)])
+  r <- r[dimnames(arr)$site, dimnames(arr)$date, dimnames(arr)$var]
+  expect_equal(r, arr)
+})
+
+test_that("dt2array: 缺失的维度组合记为 NA", {
+  arr <- make_arr()
+  dt <- array2dt(arr, dimnames(arr))
+  dt_miss <- dt[!(site == "A" & date == "d2")]
+
+  r <- dt2array(dt_miss)
+  expect_equal(dim(r), dim(arr))           # 维度不缩减 (其余行仍含全部 level)
+  expect_true(is.na(r["A", "d2"]))
+  expect_equal(sum(is.na(r)), 1L)
+})
+
+test_that("dt2array: 保留值的数据类型", {
+  # double
+  arr_d <- array(c(1.5, 2.5, 3.5, 4.5, 5.5, 6.5),
+    dim = c(2, 3), dimnames = list(s = c("A", "B"), d = c("d1", "d2", "d3")))
+  r_d <- dt2array(array2dt(arr_d, dimnames(arr_d)))
+  expect_type(r_d, "double")
+  expect_equal(r_d, arr_d)
+
+  # character
+  arr_c <- array(letters[1:6],
+    dim = c(2, 3), dimnames = list(s = c("A", "B"), d = c("d1", "d2", "d3")))
+  r_c <- dt2array(array2dt(arr_c, dimnames(arr_c)))
+  expect_type(r_c, "character")
+  expect_equal(r_c, arr_c)
+})
+
+test_that("dt2array: 支持非字符维度列 (走 match 分支)", {
+  arr <- array(1:6, dim = c(2, 3),
+    dimnames = list(id = c(10L, 20L), date = c("d1", "d2", "d3")))
+  dt <- array2dt(arr, dimnames(arr))
+  dt[, id := as.integer(id)]            # id 为 integer 列, 由 match 处理
+
+  set.seed(1)
+  r <- dt2array(dt[sample(.N)])
+  expect_equal(r[as.character(c(10, 20)), dimnames(arr)$date], arr)
+})
+
+test_that("dt2array: 支持自定义值列名", {
+  arr <- make_arr()
+  dt <- array2dt(arr, dimnames(arr))
+  data.table::setnames(dt, "value", "val")
 
-  # dt -> array
-  arr2 <- dt2array(dt)
-  expect_equal(arr, arr2)
+  expect_equal(dt2array(dt, value_col = "val"), arr)
 })