将递归函数应用于嵌套列表，同时保留子列表的类

Question

我有一个名为

inputs

的嵌套列表：

library(htmltools)
library(shiny)

inputs = tagList(
  selectInput('first', 'FIRST', letters), 
  checkboxInput('second', 'SECOND')
)

str(inputs, max.level = 1)
List of 2
 $ :List of 3
  ..- attr(*, "class")= chr "shiny.tag"
  ..- attr(*, "html_dependencies")=List of 1
 $ :List of 3
  ..- attr(*, "class")= chr "shiny.tag"
 - attr(*, "class")= chr [1:2] "shiny.tag.list" "list"

我想修改所有具有

shiny.tag

类且

name

元素等于

label

的子列表（有关此类子列表的示例，请参阅

inputs[[1]][["children"]][[1]]

），但在这样做时保留列表的原始结构。

为此，我定义了一个递归函数

hideLabel

：

hideLabel <- function(tag.list) {

  lapply(tag.list, function(x) {

    if(inherits(x, 'shiny.tag')) {

      if(x$name == 'label') {

        tagAppendAttributes(x, style = 'display:none;')

      } else {

        hideLabel(x$children)

      }

    } else {

      return(x)

    }
  })
} 

这是将 hideLabel 应用到输入列表的输出：

res = hideLabel(inputs)

str(res, max.level = 1)
List of 2
 $ :List of 2
 $ :List of 1

如上所示，hideLabel 不会返回与原始列表输入结构相同的列表（将第一个代码块中 str 的输出与上面第三个代码块中 str 的输出进行比较）。我想知道是否有人可以帮助我理解该函数为什么这样做以及如何修改它？我尝试重写了好几次都没有成功。

更新：

在考虑了函数在每个阶段返回的内容后，我让它开始工作。这是更新的功能：

hideLabel <- function(x) {

  children = x$children

  x$children = lapply(children, function(y) {

    if(inherits(y, 'shiny.tag')) {

      if(y$name == 'label') tagAppendAttributes(y, style = 'display:none;') else hil(y)

    } else y

  })

  return(x)

}

这保留了原始列表的结构：

inputs_new = lapply(inputs, hideLabel)

str(inputs, max.level = 1)
List of 2
 $ :List of 3
  ..- attr(*, "class")= chr "shiny.tag"
  ..- attr(*, "html_dependencies")=List of 1
 $ :List of 3
  ..- attr(*, "class")= chr "shiny.tag"
 - attr(*, "class")= chr [1:2] "shiny.tag.list" "list"

注意：整个列表的类别从

shiny.tag.list

更改为

list

。有人知道如何防止这种情况发生吗？我知道我可以使用

do.call(tagList, inputs_new)

手动添加

shiny.tag.list

类，但这看起来很麻烦。

Answer 1

从 htmltools 0.5.2 版本开始

tagAppendAttributes

获得了

.cssSelector

参数，所以我们可以简单地这样做：

library(htmltools)

inputs = tagList(
  selectInput('first', 'FIRST', letters), 
  checkboxInput('second', 'SECOND')
)

inputs_new <- tagAppendAttributes(inputs, style = "display:none;", .cssSelector = "label")

PS：在这种情况下还请检查

htmltools::tagQuery()