将嵌套的矩阵列表转换为四维数组
背景
我正在开发一个R 程序,用于在命令行中对数据进行分层制表。遵循 cli 及其 box-styles 的精神,我创建了一个嵌套列表,其中包含合适的 盒线字符。
box_uni_sets <- list(
light = list(
light = ...,
heavy = ...,
double = ...
),
heavy = list(
light = ...,
heavy = ...
),
double = list(
light = ...,
double = ...
)
)
注
并非每个子节点都会在每个父节点中表示。例如,heavy 缺少一个 double 子节点。
为了便于维护,每个“叶子节点”实际上是一个二维矩阵,如下所示:
box_uni_sets$light$double
#> HORIZONTAL
#> VERTICAL right middle left none
#> upper "╓" "╥" "╖" NA
#> middle "╟" "╫" "╢" "║"
#> lower "╙" "╨" "╜" NA
#> none "╶" "─" "╴" NA
因此,要获取带有 "upper" "right"-手角,并且有 "light" 行和 "double" 列时,我们可以通过下标实现:
box_uni_sets[[c("light", "double")]]["upper", "right"]
#> [1] "╓"
然而,我更倾向于用一个单一的四维数组进行下标:
box_uni_sets["light", "double", "upper", "right"]
我曾考虑在对 cli 的模仿中使用 rbind() 来实现这点。现在我们应该让现存的子节点与它们同义的维度匹配,然后对“缺失”的部分进行“跳过”。但相反的是,这种方法并没有跳过任何东西,而是把矩阵“循环利用”来填充空缺。
do.call(rbind, box_uni_sets)
#> light heavy double
#> light character,16 character,16 character,16
#> heavy character,16 character,16 character,16
#> double character,16 character,16 character,16
不幸的是,甚至在显式指定了 dim 和 dimnames 之后,我在 array() 处也遇到了类似的问题。更一般地说,数值并不会映射到相应的名称,而是按出现的顺序盲目填充。
问题
我怎么将 box_uni_sets 转换为一个四维的 character 数组,并将值映射到正确的名称,以便像下面这样进行子集化呢?
box_uni_sets["light", "double", "upper", "right"]
#> [1] "╓"
这个数组是“ ragged ”(不规则),数据缺失的地方——就像 $heavy$double 那样——我认为这些数组的槽位最好用 NAs来填充:
box_uni_sets["heavy", "double", "upper", "right"]
#> [1] NA
请注意,我并不想要一个多维的 list,因为我希望进行向量化的字符串处理,并应用向量化的ANSI格式。
数据
下面是我的 box_uni_sets 列表的一个可重复示例(reprex)。
# Enumerate the alignments.
box_aligns <- list(
VERTICAL = c(
UPPER = "upper",
MIDDLE = "middle",
LOWER = "lower",
NONE = "none"
),
HORIZONTAL = c(
RIGHT = "right",
MIDDLE = "middle",
LEFT = "left",
NONE = "none"
)
)
# Equivalent of tibble::tribble() for matrices with character sets.
make_box_set <- function(..., default = NA) {
chrs <- list(...)
chrs <- as.character(unlist(chrs,
recursive = FALSE,
use.names = FALSE
))
va <- box_aligns$VERTICAL
ha <- box_aligns$HORIZONTAL
n_va <- length(va)
n_ha <- length(ha)
set <- matrix(chrs, byrow = TRUE,
nrow = n_va,
ncol = n_ha,
dimnames = box_aligns
)
if (!is.na(default))
set[is.na(set)] <- default
set
}
# Set the global default when the set lacks the relevant character.
box_default <- NA
# Enumerate the characters for each set.
box_uni_sets <- list(
light = list(
light = make_box_set(default = box_default,
# "┌", "┬", "┐", "╷",
# "├", "┼", "┤", "│",
# "└", "┴", "┘", "╵",
# "╶", "─", "╴", NA
"\u250c", "\u252c", "\u2510", "\u2577",
"\u251c", "\u253c", "\u2524", "\u2502",
"\u2514", "\u2534", "\u2518", "\u2575",
"\u2576", "\u2500", "\u2574", NA
),
heavy = make_box_set(default = box_default,
# "┎", "┰", "┒", "╻",
# "┠", "╂", "┨", "┃",
# "┖", "┸", "┚", "╹",
# "╶", "─", "╴", NA
"\u250e", "\u2530", "\u2512", "\u257b",
"\u2520", "\u2542", "\u2528", "\u2503",
"\u2516", "\u2538", "\u251a", "\u2579",
"\u2576", "\u2500", "\u2574", NA
),
double = make_box_set(default = box_default,
# "╓", "╥", "╖", NA,
# "╟", "╫", "╢", "║",
# "╙", "╨", "╜", NA,
# "╶", "─", "╴", NA
"\u2553", "\u2565", "\u2556", NA,
"\u255f", "\u256b", "\u2562", "\u2551",
"\u2559", "\u2568", "\u255c", NA,
"\u2576", "\u2500", "\u2574", NA
)
),
heavy = list(
light = make_box_set(default = box_default,
# "┍", "┯", "┑", "╷",
# "┝", "┿", "┥", "│",
# "┕", "┷", "┙", "╵",
# "╺", "━", "╸", NA
"\u250d", "\u252f", "\u2511", "\u2577",
"\u251d", "\u253f", "\u2525", "\u2502",
"\u2515", "\u2537", "\u2519", "\u2575",
"\u257a", "\u2501", "\u2578", NA
),
heavy = make_box_set(default = box_default,
# "┏", "┳", "┓", "╻",
# "┣", "╋", "┫", "┃",
# "┗", "┻", "┛", "╹",
# "╺", "━", "╸", NA
"\u250f", "\u2533", "\u2513", "\u257b",
"\u2523", "\u254b", "\u252b", "\u2503",
"\u2517", "\u253b", "\u251b", "\u2579",
"\u257a", "\u2501", "\u2578", NA
)
),
double = list(
light = make_box_set(default = box_default,
# "╒", "╤", "╕", "╷",
# "╞", "╪", "╡", "│",
# "╘", "╧", "╛", "╵",
# NA, "═", NA, NA
"\u2552", "\u2564", "\u2555", "\u2577",
"\u255e", "\u256a", "\u2561", "\u2502",
"\u2558", "\u2567", "\u255b", "\u2575",
NA, "\u2550", NA, NA
),
double = make_box_set(default = box_default,
# "╔", "╦", "╗", NA,
# "╠", "╬", "╣", "║",
# "╚", "╩", "╝", NA,
# NA, "═", NA, NA
"\u2554", "\u2566", "\u2557", NA,
"\u2560", "\u256c", "\u2563", "\u2551",
"\u255a", "\u2569", "\u255d", NA,
NA, "\u2550", NA, NA
)
)
)
解决方案
为了得到一个4 维数组,原始数据——一个由矩阵组成的“嵌套列表”——必须让所有的子列表长度相同。第一组子列表,box_uni_sets$light,包含 三个矩阵,而另外两组只有 两个矩阵。
因此,在下面的代码中,我对原始数据进行了修改,在每一组 box_uni_sets$heavy 与 box_uni_sets$double 中各再增加一个 NA 矩阵。特别地,原始数据中没有 box_uni_sets$heavy$double 也没有 box_uni_sets$double$heavy。(heavy 与 double 的组合在原始数据中不存在。)
# Enumerate the alignments.
box_aligns <- list(
VERTICAL = c(
UPPER = "upper",
MIDDLE = "middle",
LOWER = "lower",
NONE = "none"
),
HORIZONTAL = c(
RIGHT = "right",
MIDDLE = "middle",
LEFT = "left",
NONE = "none"
)
)
# Equivalent of tibble::tribble() for matrices with character sets.
make_box_set <- function(..., default = NA) {
chrs <- list(...)
chrs <- as.character(unlist(chrs,
recursive = FALSE,
use.names = FALSE
))
va <- box_aligns$VERTICAL
ha <- box_aligns$HORIZONTAL
n_va <- length(va)
n_ha <- length(ha)
set <- matrix(chrs, byrow = TRUE,
nrow = n_va,
ncol = n_ha,
dimnames = box_aligns
)
if (!is.na(default))
set[is.na(set)] <- default
set
}
# Set the global default when the set lacks the relevant character.
box_default <- NA
# Enumerate the characters for each set.
box_uni_sets <- list(
light = list(
light = make_box_set(default = box_default,
# "┌", "┬", "┐", "╷",
# "├", "┼", "┤", "│",
# "└", "┴", "┘", "╵",
# "╶", "─", "╴", NA
"\u250c", "\u252c", "\u2510", "\u2577",
"\u251c", "\u253c", "\u2524", "\u2502",
"\u2514", "\u2534", "\u2518", "\u2575",
"\u2576", "\u2500", "\u2574", NA
),
heavy = make_box_set(default = box_default,
# "┎", "┰", "┒", "╻",
# "┠", "╂", "┨", "┃",
# "┖", "┸", "┚", "╹",
# "╶", "─", "╴", NA
"\u250e", "\u2530", "\u2512", "\u257b",
"\u2520", "\u2542", "\u2528", "\u2503",
"\u2516", "\u2538", "\u251a", "\u2579",
"\u2576", "\u2500", "\u2574", NA
),
double = make_box_set(default = box_default,
# "╓", "╥", "╖", NA,
# "╟", "╫", "╢", "║",
# "╙", "╨", "╜", NA,
# "╶", "─", "╴", NA
"\u2553", "\u2565", "\u2556", NA,
"\u255f", "\u256b", "\u2562", "\u2551",
"\u2559", "\u2568", "\u255c", NA,
"\u2576", "\u2500", "\u2574", NA
)
),
heavy = list(
light = make_box_set(default = box_default,
# "┍", "┯", "┑", "╷",
# "┝", "┿", "┥", "│",
# "┕", "┷", "┙", "╵",
# "╺", "━", "╸", NA
"\u250d", "\u252f", "\u2511", "\u2577",
"\u251d", "\u253f", "\u2525", "\u2502",
"\u2515", "\u2537", "\u2519", "\u2575",
"\u257a", "\u2501", "\u2578", NA
),
heavy = make_box_set(default = box_default,
# "┏", "┳", "┓", "╻",
# "┣", "╋", "┫", "┃",
# "┗", "┻", "┛", "╹",
# "╺", "━", "╸", NA
"\u250f", "\u2533", "\u2513", "\u257b",
"\u2523", "\u254b", "\u252b", "\u2503",
"\u2517", "\u253b", "\u251b", "\u2579",
"\u257a", "\u2501", "\u2578", NA
),
double = make_box_set(default = box_default,
rep(NA, 4L),
rep(NA, 4L),
rep(NA, 4L),
rep(NA, 4L)
)
),
double = list(
light = make_box_set(default = box_default,
# "╒", "╤", "╕", "╷",
# "╞", "╪", "╡", "│",
# "╘", "╧", "╛", "╵",
# NA, "═", NA, NA
"\u2552", "\u2564", "\u2555", "\u2577",
"\u255e", "\u256a", "\u2561", "\u2502",
"\u2558", "\u2567", "\u255b", "\u2575",
NA, "\u2550", NA, NA
),
heavy = make_box_set(default = box_default,
rep(NA, 4L),
rep(NA, 4L),
rep(NA, 4L),
rep(NA, 4L)
),
double = make_box_set(default = box_default,
# "╔", "╦", "╗", NA,
# "╠", "╬", "╣", "║",
# "╚", "╩", "╝", NA,
# NA, "═", NA, NA
"\u2554", "\u2566", "\u2557", NA,
"\u2560", "\u256c", "\u2563", "\u2551",
"\u255a", "\u2569", "\u255d", NA,
NA, "\u2550", NA, NA
)
)
)
# this is a hack, it works after trial and error
nms1 <- box_uni_sets |> names()
nms2 <- box_uni_sets[[1L]][[1L]] |> dimnames() |> lapply(unname)
box_uni_sets_array_4d <- array(NA, dim = c(4L, 4L, 3L, 3L))
dimnames(box_uni_sets_array_4d) <- list(nms2[[1L]], nms2[[2L]], nms1, nms1)
for(i in nms1) {
for(j in nms1) {
box_uni_sets_array_4d[, , i, j] <- box_uni_sets[[i]][[j]]
}
}
box_uni_sets_array_4d
#> , , light, light
#>
#> right middle left none
#> upper "┌" "┬" "┐" "╷"
#> middle "├" "┼" "┤" "│"
#> lower "└" "┴" "┘" "╵"
#> none "╶" "─" "╴" NA
#>
#> , , heavy, light
#>
#> right middle left none
#> upper "┍" "┯" "┑" "╷"
#> middle "┝" "┿" "┥" "│"
#> lower "┕" "┷" "┙" "╵"
#> none "╺" "━" "╸" NA
#>
#> , , double, light
#>
#> right middle left none
#> upper "╒" "╤" "╕" "╷"
#> middle "╞" "╪" "╡" "│"
#> lower "╘" "╧" "╛" "╵"
#> none NA "═" NA NA
#>
#> , , light, heavy
#>
#> right middle left none
#> upper "┎" "┰" "┒" "╻"
#> middle "┠" "╂" "┨" "┃"
#> lower "┖" "┸" "┚" "╹"
#> none "╶" "─" "╴" NA
#>
#> , , heavy, heavy
#>
#> right middle left none
#> upper "┏" "┳" "┓" "╻"
#> middle "┣" "╋" "┫" "┃"
#> lower "┗" "┻" "┛" "╹"
#> none "╺" "━" "╸" NA
#>
#> , , double, heavy
#>
#> right middle left none
#> upper NA NA NA NA
#> middle NA NA NA NA
#> lower NA NA NA NA
#> none NA NA NA NA
#>
#> , , light, double
#>
#> right middle left none
#> upper "╓" "╥" "╖" NA
#> middle "╟" "╫" "╢" "║"
#> lower "╙" "╨" "╜" NA
#> none "╶" "─" "╴" NA
#>
#> , , heavy, double
#>
#> right middle left none
#> upper NA NA NA NA
#> middle NA NA NA NA
#> lower NA NA NA NA
#> none NA NA NA NA
#>
#> , , double, double
#>
#> right middle left none
#> upper "╔" "╦" "╗" NA
#> middle "╠" "╬" "╣" "║"
#> lower "╚" "╩" "╝" NA
#> none NA "═" NA NA
box_uni_sets_array_4d[ , , "light", "double"]
#> right middle left none
#> upper "╓" "╥" "╖" NA
#> middle "╟" "╫" "╢" "║"
#> lower "╙" "╨" "╜" NA
#> none "╶" "─" "╴" NA
box_uni_sets_array_4d["upper", "right", "light", "double"]
#> [1] "╓"
Created on 2026-04-12 with reprex v2.1.1
备选方案
这里有一种递归方法来解决同样的问题。它具有动态性,因为它可以处理各种深度。不仅限于四维数组:
make_df <- function(x){
if(is.matrix(x[[1]]))
Map(f = \(x, name) cbind(name, as.data.frame(as.table(x))), x, names(x))|>
do.call(what = rbind)
else if(is.data.frame(x[[1]]))
do.call(rbind, Map(cbind, name = names(x), x))
else make_df(lapply(x, make_df))
}
make_array <- function(x){
y <- make_df(x)
names(y) <- make.unique(names(y))
res <- xtabs(Freq~ ., transform(y, Freq = seq(nrow(y))))
is.na(res) <- res == 0
res[] <- y$Freq[res]
res
}
result4D <- make_array(box_uni_sets)
result4D["heavy", "double", "upper", "right"]
# [1] NA
result4D["light", "double", "upper", "right"]
# [1] "╓"
result4D["light", "double", , ]
# HORIZONTAL
# VERTICAL right middle left none
# upper ╓ ╥ ╖
# middle ╟ ╫ ╢ ║
# lower ╙ ╨ ╜
# none ╶ ─ ╴
## compare with
box_uni_sets$light$double
# HORIZONTAL
# VERTICAL right middle left none
# upper "╓" "╥" "╖" NA
# middle "╟" "╫" "╢" "║"
# lower "╙" "╨" "╜" NA
# none "╶" "─" "╴" NA
请注意,我们甚至可以使用五维:
list5D <- list(blue = box_uni_sets, yellow = box_uni_sets) # even 3d etc
make_array(list5D)['blue', 'light', 'double', , ]
# HORIZONTAL
# VERTICAL right middle left none
# upper ╓ ╥ ╖
# middle ╟ ╫ ╢ ║
# lower ╙ ╨ ╜
# none ╶ ─ ╴