4 min read

shiny modules part 1.

I’ve been wanting to learn about shiny modules ever since my shiny-building Italian colleague, Dan, pointed out that they might be a good way to keep the code more organised for bigger apps. My first try was overly ambitious and ended in an untagleable mess of modules within modules that didn’t run, so I decided to go with something nice and simple first off, and build from there. In fact, I’d say that’s a principle I’m sticking with from now on when it comes to building apps: start with something simple and add complexity. It makes de-bugging way easier.

Anyway, for those that don’t know, a ‘module’ in shiny is a bit like a function that creates a bit of UI and the server code that goes with that UI. Of course, if you tried to write a function to make those things normally, you’d hit the problem of duplicate input and output names, which will break the app. What modules do is they create distinct namespaces for each time the module is called, so you don’t get the clash of input and output names. This is great for:

  1. When your app code would involve lots of repetition (this is the case with my example app)
  2. When you want the user to be able to create additional parts of the UI themselves. This is potentially the more poweful use IMO, but it’s more complicated, so hopefully I’ll cover that in another blog.

Anyway here’s the module is used

compare3dsUI <- function(id) {
  
  ns <- NS(id)
  
 tagList(
   fluidRow(
     column(6, 
      selectInput(inputId =  ns("follow"), 
                  label = "highlight one country",
                  choices = gapminder$country %>% unique %>% sort 
                  )
      ),
     column(6,
       sliderTextInput(inputId = ns("year"),
                       label = "year", 
                       choices = gapminder$year %>% unique,
                       animate = animationOptions(interval = 2000)
            )
   )
          ), 
   fluidRow(
      column(6, plotlyOutput(ns("contplot"))),
      column(6, plotlyOutput(ns("worldplot")))
   )
)
  
}

compare3ds <- function(input, output, session, cont) {
  
  cont_counts <- reactive({ gapminder %>% filter(continent == cont) %>% 
                                          pull(country)  })
  
  yearData <- reactive({gapminder %>%
                   mutate(colour = if_else(continent == cont, 1, 2) %>%
                                   {if_else(country == input$follow, 3, .)}
                          ) %>%
                   filter(year == input$year)
                   
  })
  
  output$contplot <- renderPlotly(yearData() %>% filter(continent == cont) %>% 
                                    plot_3d(lifeExp, pop, gdpPercap, 
                                            text = country,
                                            title = cont,
                                            color = colour,
                                            colors = if (input$follow %in% cont_counts()) {
                                                             c("red", "blue") } else {
                                                               "red" } 
                                            
                                          )
  )
  
  output$worldplot <- renderPlotly(yearData() %>% 
                                     plot_3d(lifeExp, pop, gdpPercap, 
                                             text = country,
                                             title = "World",
                                             color = colour,
                                             colors = c("red", "grey", "blue")
                                          )
  )
}

It could be re-written a lot more generic, which would allow it to be used in other apps, but it was late at night when I wrote it and I just couldn’t be bothered. Basically, all you’d need to do it add a load more function arguments in the ‘server’ part of the module for things like colour and variable names etc, and then take those out of the function expression. It uses the plot3d function from this blog post. Then the app UI itself is just:

source("compare3ds.R")

ui <- navbarPage("Gapminder modules", theme = "bootstrap.css",

        tabPanel(title = "Africa", 
                 compare3dsUI("Africa")
              ),
        tabPanel(title = "Europe", 
                 compare3dsUI("Europe")
        ),
        tabPanel(title = "Americas", 
                 compare3dsUI("Americas")
        ),
        tabPanel(title = "Oceania", 
                 compare3dsUI("Oceania")
        ),
        tabPanel(title = "Asia", 
                 compare3dsUI("Asia")
        )
)

and the server function is just

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  Africa <- callModule(compare3ds, "Africa", cont = "Africa")
  Europe <- callModule(compare3ds, "Europe", cont = "Europe")
  Americas <- callModule(compare3ds, "Americas", cont = "Americas")
  Oceania <- callModule(compare3ds, "Oceania", cont = "Oceania")
  Asia <- callModule(compare3ds, "Asia", cont = "Asia")
}

So, basically it save a LOT of typing. Plus it means you can make changes to the module and those changes are replicated. Like I say, I think the real value will be when you combine it will actionButton + insertUI and things like that. I also think that it’s one of those things that once you start using, you’ll never go back, because it just saves you time and keeps your code more compartmentalised, which is all good.

Here’s the app on shinyapps.io. It’s basically a take on Hans Rosling famous animation, but in 3d and with less data. If only the gapminder package just gave you a bit more up-to-date data that would be nice, I’d like to see how things have changed since 2007.

It’s a bit clipped, but you can see the full page here. Once I’ve figured out some useful application of nested modules I’ll post it as part 2.