Apply a recursive function to a nested list while preserving the classes of sublists

Question

I have a nested list called 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"

I would like to modify all sublists who have class shiny.tag and whose name element equals label (see inputs[[1]][["children"]][[1]] for an example of such a sublist) but preserve the original structure of the list while doing so.

To do this, I define a recursive function 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)

    }
  })
} 

Here is the output of applying hideLabel to the inputs list:

res = hideLabel(inputs)

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

As shown above, hideLabel does not return a list of the same structure as the original list inputs (compare the output of str in the first code chunk with the output of str in the third chunk above). I was wondering if someone could help me understand why the function is doing this and how it could be modified? I have tried rewriting it several times to no avail.

Update:

I got it to work after thinking about what the function was returning at each stage. Here is the updated function:

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)

}

This preserves the structure of the original list:

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"

NOTE: The class of the overall list changes though from shiny.tag.list to just list. Would anyone know how to prevent this from happening? I know I could use do.call(tagList, inputs_new) to manually add the shiny.tag.list class back on but that seems hacky.

Tranquil

You will need to share code of tagAppendAttributes to make this a reproducible example – Defoliant

It's a function from the htmltools package, I have included a library call in the header of my code so the result should be reproducible. – Tranquil

I would like to modify all sublists who have class shiny.tag and whose name element equals label modify to what? Also why do you think tagAppendAttributes would change the class of x in your function ? – Insult

No sorry, I would like to modify those sublists that have class shiny.tag and whose first element (name) equals label by applying the tagAppendAttributes function to them as so: tagAppendAttributes(x, style = 'display:none;'). tagAppendAttributes does not change the class of the tag. It's the hideLabel function that changes the class of tags that do not satisfy the x$name == 'label' condition during the recursion. Does this clarify it? – Tranquil

Basically, I need to go apply tagAppendAttributes(x, style = 'display:none;') to all label tags in the inputs list (label tags are all sublists with class shiny.tag AND name == 'label') while preserving the original structure of the inputs list (the structure is shown in the str output in the first chunk in my post). – Tranquil

Answer 1

As of htmltools version 0.5.2 tagAppendAttributes gained the .cssSelector parameter, so we can simply do:

library(htmltools)

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

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

PS: in this context also check htmltools::tagQuery()

Tsushima