Применение рекурсивной функции к вложенному списку при сохранении классов подсписков - PullRequest
1 голос
/ 05 октября 2019

У меня есть вложенный список с именем 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, но это выглядит глупо.

...