Modify tags

  • The tagQuery() function exposes various methods to modify attributes and descendants of the query selection.

Playing with attributes

Method Description
addAttrs Add any number of attributes to each selected tag
removeAttrs Remove any number of attributes to each selected tag
hasAttrs Check if the selected tag has the specified attribute(s)
addClass Add any number of new classes to each selected tag
removeClass Remove any number of classes to each selected tag
hasClass Check if the selected tag has the specified classe(s)
  • Example:
    • Add class "fade" to tab panels, so that Bootstrap applies a fade transition between tabs:
    • Code:
    tagQuery(tabs)$
      find(".tab-pane")$
      addClass("fade")$
      selectedTags()
    [[1]]
    <div class="tab-pane active fade" data-value="1" id="tab-5946-1">Tab 1</div>
    
    [[2]]
    <div class="tab-pane fade" data-value="2" id="tab-5946-2">Tab 2</div>
    
    [[3]]
    <div class="tab-pane fade" data-value="3" id="tab-5946-3">Tab 3</div>

Altering element/children/siblings

Method Description
append Insert content after the children of each selected tag
prepend Insert content before the children of each selected tag
empty Remove all children from the selected tag
remove Remove all selected tags
before Insert content before each selected tag
after Insert content after each selected tag
replaceWith Replace the currently selected tag by the provided tag
  • Example:
    • For tabs, include an icon before each tab title (text content of <a> element).
    • Code:
    new_tabs <- tagQuery(tabs)$
      find("a")$
      prepend(icon("flag"))
    
    new_tabs$selectedTags()
    [[1]]
    <a href="#tab-5946-1" data-toggle="tab" data-value="1" class="nav-link active" data-target="#tab-5946-1">
      <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
      1
    </a>
    
    [[2]]
    <a href="#tab-5946-2" data-toggle="tab" data-value="2" class="nav-link" data-target="#tab-5946-2">
      <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
      2
    </a>
    
    [[3]]
    <a href="#tab-5946-3" data-toggle="tab" data-value="3" class="nav-link" data-target="#tab-5946-3">
      <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
      3
    </a>

Chain tag queries

  • The $resetSelected() function allows us to reset the element selection to the base element after a given operation, making it possible to chain multiple queries.

  • Let’s combine all previous examples:

    # Set HTML element "tabs" as base
    tagQuery(tabs)$
      # Operation 1:
      #   Add "fade" class to all panels
      find(".tab-pane")$
      addClass("fade")$
      resetSelected()$
      # New operation: 
      #   Add icon before the title of each "link"
      find("a")$
      prepend(icon("flag"))$
      allTags()
    <div class="tabbable">
      <ul class="nav nav-tabs" data-tabsetid="5946">
        <li class="nav-item">
          <a href="#tab-5946-1" data-toggle="tab" data-value="1" class="nav-link active" data-target="#tab-5946-1">
            <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
            1
          </a>
        </li>
        <li class="nav-item">
          <a href="#tab-5946-2" data-toggle="tab" data-value="2" class="nav-link" data-target="#tab-5946-2">
            <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
            2
          </a>
        </li>
        <li class="nav-item">
          <a href="#tab-5946-3" data-toggle="tab" data-value="3" class="nav-link" data-target="#tab-5946-3">
            <i class="far fa-flag" role="presentation" aria-label="flag icon"></i>
            3
          </a>
        </li>
      </ul>
      <div class="tab-content" data-tabsetid="5946">
        <div class="tab-pane active fade" data-value="1" id="tab-5946-1">Tab 1</div>
        <div class="tab-pane fade" data-value="2" id="tab-5946-2">Tab 2</div>
        <div class="tab-pane fade" data-value="3" id="tab-5946-3">Tab 3</div>
      </div>
    </div>

Specific cases

  • Some methods, like $append() and $prepend() are only able to add the same elements to one or multiple targets.

  • When the transformation to perform is index specific, $each() should be used. Such function takes an anonymous function as input, with parameters element and index.

  • Example:

    • Replace text content of each tab panel with This is tab “tab_index”.
    • Code:
    tagQuery(tabs)$
      find(".tab-pane")$
      empty()$
      each(function(el, i) {
        el <- tagAppendChild(el, paste("This is tab", i))
        return(el)
      })$
      selectedTags()
    [[1]]
    <div class="tab-pane active" data-value="1" id="tab-5946-1">This is tab 1</div>
    
    [[2]]
    <div class="tab-pane" data-value="2" id="tab-5946-2">This is tab 2</div>
    
    [[3]]
    <div class="tab-pane" data-value="3" id="tab-5946-3">This is tab 3</div>

Practice

  • Let’s perform the same transformation as in the Practical examples section, but now using tagQuery().

  • Model:

    <div>
      <label id="variable-label" for="variable">Variable:</label>
      <select id="variable" class="some-class">
        <option value="cyl" selected>Cylinders</option>
        <option value="gear">Gears</option>
      </select>
    </div>
  • Example:

    shinySelect <- shiny::selectInput(
      inputId = "selectId",
      label = "Choose",
      choices = 1:2,
      selected = 1
    )
    shinySelect
    <div class="form-group shiny-input-container">
      <label class="control-label" id="selectId-label" for="selectId">Choose</label>
      <div>
        <select id="selectId" class="shiny-input-select"><option value="1" selected>1</option>
    <option value="2">2</option></select>
        <script type="application/json" data-for="selectId" data-nonempty="">{"plugins":["selectize-plugin-a11y"]}</script>
      </div>
    </div>
  • Solution:

    tagQuery(shinySelect)$
      # Remove class of container
      removeAttrs("class")$
      # Remove label element's class
      find(".control-label")$
      removeAttrs("class")$
      # Remove extra div container for <select>
      siblings()$
      replaceWith(
        tagQuery(shinySelect)$
          find(".control-label")$
          siblings()$
          children()$
          selectedTags()
      )$
      allTags()
    <div>
      <label id="selectId-label" for="selectId">Choose</label>
      <select id="selectId" class="shiny-input-select"><option value="1" selected>1</option>
    <option value="2">2</option></select>
      <script type="application/json" data-for="selectId" data-nonempty="">{"plugins":["selectize-plugin-a11y"]}</script>
    </div>

Alter tag rendering with rendering hooks

2.6.0.1 Simple hooks

  • Let’s explore one of the more advanced features of the htmltools package: Conditionally render an HTML element, depending on conditions like external options , a specific theme version, etc..

  • As an example, the condition will be if Shiny is in dev mode:

    devmode(TRUE)
    getOption("shiny.devmode")
    [1] TRUE
  • We create an htmltools tag with specific instructions for the .renderHook parameter:

    cssStyle <- "color: red; border: dashed red;"
    customTag <- span("", .renderHook = function(x) {
      if (getOption("shiny.devmode")) {
        return(tagAppendAttributes(x, style = cssStyle))
      }
    })
    
    customTag
    <span style="color: red; border: dashed red;"></span>
  • If the htmlools tag already has an existing hook, the tagAddRenderHook() adds another hook to the current list:

    customTag <- tagAddRenderHook(customTag, function(x) {
      if (getOption("shiny.devmode")) {
        return(tagAppendChildren(x, "UNDER REWORK"))
      } 
    })
    
    customTag$.renderHooks
    [[1]]
    function (x) 
    {
        if (getOption("shiny.devmode")) {
            return(tagAppendAttributes(x, style = cssStyle))
        }
    }
    
    [[2]]
    function (x) 
    {
        if (getOption("shiny.devmode")) {
            return(tagAppendChildren(x, "UNDER REWORK"))
        }
    }
    # Remove first hook
    # customTag$.renderHooks[[1]] <- NULL
  • Let’s try it in a Shiny app, after enabling or disabling dev mode:

    library(shiny)
    
    devmode(TRUE)
    # devmode(devmode = FALSE)
    getOption("shiny.devmode")
    
    cssStyle <- "color: red; border: dashed red;"
    customTag <- span("text", .renderHook = function(x) {
      if (getOption("shiny.devmode")) {
        return(tagAppendAttributes(x, style = cssStyle))
      }
    })
    
    ui <- fluidPage(
        customTag
      )
    server <- function(input, output) {}
    
    shinyApp(ui, server)

Nested hooks

  • Most Shiny elements are composed of main wrappers and nested tags, for example, tabsetPanel() and tabPanel().

  • How do we handle nested elements?

  • Example:

my_wrapper_tag <- function(...) {
  wrapper <- div(class = "parent", ...)
  items <- list(...)
  
  tagAddRenderHook(wrapper, function(x) {
    version <- getOption("theme_version")
    if (!is.null(version)) {
      if (version == "4") {
        new_items <- tagQuery(items)$
          find(".new-child")$
          each(function(x, i) {
            tagAppendAttributes(x, id = letters[i])
          })$
          allTags()
        
        x <- tagQuery(x)$
          empty()$
          append(new_items)$
          allTags()
      } 
    }
    return(x)
  })
}
  • Let’s design the nested item function:
my_nested_tag <- function() {
  wrapper <- div(class = "nested")
  
  tagAddRenderHook(wrapper, function(x) {
    version <- getOption("theme_version")
    if (!is.null(version)) {
      x <- if (version == "4") {
        new_child <- div(class = "new-child")
        
        tagQuery(x)$
          append(new_child)$
          allTags()
      } 
    }
    return(x)
  })
}
  • Testing:
options("theme_version" = "4")
my_wrapper_tag(my_nested_tag(), my_nested_tag())
<div class="parent">
  <div class="nested">
    <div class="new-child"></div>
  </div>
  <div class="nested">
    <div class="new-child"></div>
  </div>
</div>
options("theme_version" = "3")
my_wrapper_tag(my_nested_tag(), my_nested_tag())
<div class="parent"></div>
  • Why did the id attribute did not get updated?
    • It’s basically a resolve issue.
    • In the top-level render hook (my_wrapper_tag), the newly added item is not yet available.
    • A solution is to resolve the sub items with as.tags(), in order to convert any arbitrary element to be a part of the tag structure.
# Fixing the top-level render hook
my_wrapper_tag <- function(...) {
  wrapper <- div(class = "parent", ...)
  items <- list(...)
  
  tagAddRenderHook(wrapper, function(x) {
    version <- getOption("theme_version")
    if (!is.null(version)) {
      if (version == "4") {
        ###############################
        items <- lapply(items, as.tags)
        ###############################

        new_items <- tagQuery(items)$
          find(".new-child")$
          each(function(x, i) {
            tagAppendAttributes(x, id = letters[i])
          })$
          allTags()
        
        x <- tagQuery(x)$
          empty()$
          append(new_items)$
          allTags()
      } 
    }
    return(x)
  })
}
  • Final test:
options("theme_version" = "4")
my_wrapper_tag(my_nested_tag(), my_nested_tag())
<div class="parent">
  <div class="nested">
    <div class="new-child" id="a"></div>
  </div>
  <div class="nested">
    <div class="new-child" id="b"></div>
  </div>
</div>
options("theme_version" = "3")
my_wrapper_tag(my_nested_tag(), my_nested_tag())
<div class="parent"></div>

A real-life case study is available later in the book in section 9.3.3.3 .