Dynamic Tabs, insertTab, and removeTab For More efficient R Shiny Applications

In the last tutorial, we created an application where we made dynamic tabs based on what checkboxes were selected by the user. The link to the application is here and the link to the last post here. A big disadvantage from the last application was that the application was re-rendering the tabs every time the input value changed. A better solution would be to insert tabs whenever we want to create new ones and also remove tabs without re-rendering anything.

The application we are building now is identical to the one we built last time. except that this one will be a lot more efficient. For the gapminder data set, we are using the difference will probably not as apparent. However, when the tabs have very computationally expensive calculations, using insertTab and removeTab are crucial.

Let’s jump in!

R Shiny Dynamic Tabs UI

The UI has not changed compared to the last application.

ui <- shiny::bootstrapPage(

    div(
        class = "container",
        style = "margin-top: 25px;",
        div(
            class = "row text-center",
            shiny::checkboxGroupInput(inputId = "continents",
                                      label   = "Choose continents",
                                      choices = unique(gapminder$continent) %>% 
                                          sort(),
                                      inline  = TRUE,
                                      selected = c("Africa", "Asia", "Oceania")),
            
            shiny::actionButton(inputId = "btn",
                                label   = "Create Dynamic Tabs")
        )
    ),
    
    div(
        class = "container",
        shiny::uiOutput("dynamic_tabs")
    )
    
)

The UI is pretty self-explanatory and if you need some more explanation, then check out my last blog post. The link can be found in the first paragraph.

R Shiny Dynamic Tabs Server Logic

The server logic is a bit complicated and it took me a while to figure out how to create a working application. Luckily for you, I did all the work already 🙂

First, we have to create reactive values again.

rv <- shiny::reactiveValues(keep_track = list(initial = c()),
                            start      = NULL)

We need to keep track of the inputs the user selects. Specifically, we need to know what has changed from the previous inputs. Therefore, we are holding two vectors in the list keep_track. The first vector is about the current inputs and the second vector is about the inputs previously. That way, we can compare the two vectors and see what has been changed and what has been added. Whatever has been added, we can use insertTab and for values that have been removed, we use removeTab.

The observer that keeps track of the current inputs and previous input looks like this:

shiny::observeEvent(input$btn, {
        
        rv$keep_track <- list(input$continents) %>% 
            append(rv$keep_track) %>% 
            .[c(1:2)] %>% 
            purrr::set_names(c("current", "previous"))
        
        if(is.null(rv$keep_track[["current"]]) & !is.null(rv$keep_track[["previous"]])) {
            
            rv$start <- NULL
            
        } else if(!is.null(rv$keep_track[["current"]]) & is.null(rv$keep_track[["previous"]])) {
            
            rv$start <- input$continents
            
        }
        
    }, priority = 1)

One more challenge is to specify when to use the render function and when to use inserTab and removeTab in R Shiny. When the application starts, the rv$start value is NULL. Then, when we first click on the action button, the current values are equal to the continents we selected and the previous value is NULL. So, we are using the renderUI function by modifying rv$start and the tabs are going to be created.

When we deselect all checkboxes and click the action button then the current value is NULL and the previous value is equal to whatever continents were selected. The rv$start is obviously NULL and we use the render function again to display nothing.

Consequently, whenever the current vector and previous vector are not null, we are using insertTab and removeTab.

For completeness, here is the render function that creates the tabs dynamically. The function has not changed from our last blog post.

output$dynamic_tabs <- shiny::renderUI({
        
        rv$start %>% 
            purrr::map(~
                           shiny::tabPanel(
                               title = .x,
                               div(
                                   class = "panel", 
                                   div(
                                       class = "panel-header",
                                       tags$h3(.x)
                                   ),
                                   div(
                                       class = "panel-body",
                                       
                                       gapminder %>% 
                                           dplyr::filter(continent == .x) %>% 
                                           dplyr::group_by(continent, year) %>% 
                                           dplyr::summarise(life_exp = mean(lifeExp)) %>% 
                                           dplyr::ungroup() %>% 
                                           
                                           plotly::plot_ly(x = ~year, y = ~life_exp, 
                                                           mode = 'lines+markers',
                                                           type = "scatter") %>% 
                                           layout(legend = list(orientation = "h",
                                                                xanchor = "center",  
                                                                x = 0.5),
                                                  xaxis = list(title = ""),
                                                  yaxis = list(title = ""), height = 500)
                                   )
                               )
                           )
            ) -> gap
        
        do.call(what = shiny::tabsetPanel, 
                args = gap %>% 
                    append(list(type = "pills",
                                id   = "continent_tabs")))
        
    })

insertTab and removeTab to Remove and Create Tabs Dynamically

The above-mentioned functions are being used in an observer:

shiny::observeEvent(input$btn, {
        
    }, priority = 0)

Inside the observer, we put the req function. This function decides whether the code inside the observer is run or not. As we discussed above, we only run the code when rv$keep_track$current and rv$keep_track$previous is not NULL. Here is the code:

shiny::req(!is.null(rv$keep_track[["current"]]) & !is.null(rv$keep_track[["previous"]]))

Get Inserted Tabs and Remove Tabs

Next, we want to know which continents we want to insert and which ones we want to remove. We can do that with the code below:

inserted_vals <- rv$keep_track$current[!(rv$keep_track$current %in% rv$keep_track$previous)] %>% 
            sort()  
remove_tabs <- rv$keep_track$previous[!(rv$keep_track$previous %in% rv$keep_track$current)]

Create R SHiny Dynamic Tabs, get_position Function

Next, we need to know where we want to insert the new tab. When looking at the insertTab function, then the documentation looks like this:

insertTab(
  inputId,
  tab,
  target,
  position = c("before", "after"),
  select = FALSE,
  session = getDefaultReactiveDomain()
)

The inputId has to equal the inputId in the tabsetPanel function. The id is continent_tabs. For the tab argument, we will insert the tabPanel function and will use the code from the renderUI function. The tricky part is to figure out where to place the inserted tab. In order to do that, we have to write a function that lets us know where to insert the tab. The function looks like this:

get_position <- function(current_list, inserted_value) {
    
    all <- c(current_list, inserted_value) %>% 
        sort()
    index <- which(inserted_value == all)
    
    if(index == length(all)) {
        
        last_val <- current_list[length(current_list)]
        position <- "after"
        return(
            list(
                a = last_val,
                b = position,
                c = inserted_value
            )
        )
        
    } else if(index == 1) {
        
        first_val <- current_list[1]
        position <- "before"
        return(
            list(
                a = first_val,
                b = position,
                c = inserted_value
            )
        )
        
    } else {
        
        val <- current_list[index]
        position <- "before"
        return(
            list(
                a = val,
                b = position,
                c = inserted_value
            )
        )
        
    }
    
    
}

The function above takes the current vector of continents into consideration and as the second argument the value we want to insert. Then we calculate the position of the newly inserted value. If it is last, the position is after and the target is the last value of the current vector. If it is first, the position is before and the target is the first value in the current vector. If the inserted value lies somewhere in between the first value and last value of the current vector, then the position is before and the target is the index of the current vector.

The Final insertTab/removeTab Observer

shiny::observeEvent(input$btn, {
        
        shiny::req(!is.null(rv$keep_track[["current"]]) & !is.null(rv$keep_track[["previous"]]))
        
        inserted_vals <- rv$keep_track$current[!(rv$keep_track$current %in% rv$keep_track$previous)] %>% 
            sort()  
        remove_tabs <- rv$keep_track$previous[!(rv$keep_track$previous %in% rv$keep_track$current)]
        
        x <- inserted_vals %>%
            purrr::map(~
                           get_position(rv$keep_track$previous, .x)
            )
        
        before_continents <- x %>%
            purrr::keep(~ .$b == "before") %>%
            purrr::map(~purrr::pluck(., "c")) %>%
            purrr::flatten_chr()
        
        after_continents <- x %>%
            purrr::keep(~ .$b == "after") %>%
            purrr::map(~purrr::pluck(., "c")) %>%
            purrr::flatten_chr() %>% 
            rev()
        
        c(before_continents, after_continents) %>% 
            purrr::map(~
                           shiny::insertTab(inputId = "continent_tabs",
                                            shiny::tabPanel(
                                                title = .x,
                                                div(
                                                    class = "panel", 
                                                    div(
                                                        class = "panel-header",
                                                        tags$h3(.x)
                                                    ),
                                                    div(
                                                        class = "panel-body",
                                                        
                                                        gapminder %>% 
                                                            dplyr::filter(continent == .x) %>% 
                                                            dplyr::group_by(continent, year) %>% 
                                                            dplyr::summarise(life_exp = mean(lifeExp)) %>% 
                                                            dplyr::ungroup() %>% 
                                                            
                                                            plotly::plot_ly(x = ~year, y = ~life_exp, 
                                                                            mode = 'lines+markers',
                                                                            type = "scatter") %>% 
                                                            layout(legend = list(orientation = "h",
                                                                                 xanchor = "center",  
                                                                                 x = 0.5),
                                                                   xaxis = list(title = ""),
                                                                   yaxis = list(title = ""), height = 500)
                                                    )
                                                )
                                            ),
                                            target = get_position(rv$keep_track$previous, .x)$a,
                                            position = get_position(rv$keep_track$previous, .x)$b)
            )
        
        
        remove_tabs %>% 
            purrr::map(~
                           shiny::removeTab(inputId = "continent_tabs",
                                            target  = .x)
            )
        
        
    }, priority = 0)

x holds the inserted values or continents. Then, we want to know which continents have to be inserted after and which ones have to be inserted before. We need to know that in order to reverse the after vector to get the tabs in the right order. Then we can combine both vectors again and then use purrr's map function again to insert every single continent/tab in the right position.

For the removeTab function, the logic is very simple. We just remove tabs one by one. And that is it! We have successfully implemented the insertTab/removeTab functions in R Shiny.

You may have noticed the priority argument in the observers. The first observer has higher priority and runs first, determining the previous and current inputs for the continents. After we know that, we can run the second observer which adds and removes tabs based on the rv$keep_track reactive values.

If you have any questions about this tutorial, you can let me know in the comments below or send me an email.

Other R Shiny Tutorials

 

 

Comments (2)

Post your comment