将嵌套的矩阵列表转换为四维数组

编程语言 2026-07-10

背景

我正在开发一个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

不幸的是,甚至在显式指定了 dimdimnames 之后,我在 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$heavybox_uni_sets$double 中各再增加一个 NA 矩阵。特别地,原始数据中没有 box_uni_sets$heavy$double 也没有 box_uni_sets$double$heavy。(heavydouble 的组合在原始数据中不存在。)

# 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   ╶     ─      ╴
站内所有文章版权归属LeftHeroAI导航站,无授权禁止任何主体转载、抄袭、复制内容,亦不得私自架设镜像站点。一经侵权,本站将通过法律途径追责。

相关文章