Mwavu
Mwavu

Mwavu

Pass Data From One Module Onto The Next

Photo by Tanner Boriack on Unsplash

Pass Data From One Module Onto The Next

Mwavu's photo
Mwavu
·Mar 21, 2022·

11 min read

I have this friend of mine called Jeff who's really philosophical about life... No, not Bezos, thanks for asking. Recently as we were having a conversation he hit me with a certain quote that went along the lines of:

Don't be the last person to do it.

Of course that's one of the worst paraphrasing you've ever come across but let's just put it this way:

image.png

"What do you mean? I thought that he who laughs last laughs the best", I asked.

Not in that sense, friend. Look at it this way: Say you're highly skilled in something and you don't pass down your knowledge to at least one person. A day comes and we put you 6 feet under. Chances are your skill won't be useful to you once you join our ancestors. But the knowledge could be very useful to someone else who's still alive. So make sure you aren't the last person to do this.

At this point I was like:

image.png

So I asked myself why would the module we created last time be the last one to hold the uploaded data? I mean, why not pass that data to a fellow module? And in fact, why wouldn't I use my friend's analogy as an introduction to this article?

image.png

Second Module, Second Tab

What's our agenda here by the way?

  • Receive data from tab 1

  • Let user make some variable selections

  • Plot these variables against each other

Receive data from tab 1

For us to receive data from tab 1, homie garra pass it down to us.

Since we're at peace with the fact that modules are really like any other R function, then we can agree that they could also have a return value. And what we basically want is data_input_server() to return the uploaded data. So go to that function ASAP and add this to the very bottom:

# <---Last time we reached here👇🏻--->
# ----switch to `tab_plot`----
observeEvent(input$go_to_plot, {
  updateNavbarPage(
    session = parent_session,
    inputId = "tab_container", # id of `navbarPage()`
    selected = "tab_plot"
  )
})
# <---Last time we reached here☝🏻--->

# <---Now add this return statement:--->
return(r_flowers)

And once again, you have to make a choice on your design principles:

image.png

`2b` || !`2b`

But trust me when I tell you returning non-reactives will cost you a dime. Might not be today, but they surely will attack.

For me and my family we choose to return reactive values from a module, which is why the return statement reads return(r_flowers) and NOT return(r_flowers()).

Our function, data_input_server(), now has a return value. So we should go to wherever it is called and assign to a variable, if indeed we want to capture the returned value.

Q: Where did we call our function?

A: Inside server.R

Then let's head there and do what we garra do:

server <- function(input, output, session) {
  r_flowers <- data_input_server(
    id = "data_input",
    parent_session = session
  )
}

I could have used the variable name flowers without the r_ but it's important for me when scrolling through server.R to be able to distinguish reactive variables from non-reactive ones. Might not seem like a big deal here but wait till you create a huge application that not only gets out of hand but also out of mind... Like it gets so big that you can't picture how your 5000 lines of code in server.R fit together, leave alone the 10k+ in ui.R. I swear I once did that and the experience was not a pleasant one.

image.png

Now let's actually create the module.

Module UI

I don't always give advice but when I do it's usually telling you that if you forget to wrap your inputIds inside NS() when creating the module UI you will curse the universe for the rest of the day wondering why the UI is showing as expected but not reacting to change of inputs.

image.png

Create a new file under the /R folder and name it plot_ui.R. That's rather bad naming but it will work since we have only 3 tabs in our app.

As usual, it contains a function with the same name, MUST have an argument called id and returns a tagList():

plot_ui <- function(id) {
  shiny::tagList(

  )
}

Now let's add the code which will achieve our objectives:

plot_ui <- function(id) {
  shiny::tagList(
    sidebarLayout(
      sidebarPanel = sidebarPanel(
        # x variable:
        selectInput(
          inputId = NS(namespace = id, id = "x_var"),
          label = "X Variable",
          choices = NULL
        ),

        # y variable:
        selectInput(
          inputId = NS(namespace = id, id = "y_var"),
          label = "Y Variable",
          choices = NULL
        )
      ),

      mainPanel = mainPanel(
        # plot of the two vars against each other:
        plotOutput(
          outputId = NS(namespace = id, id = "x_vs_y")
        )
      )
    ),

    fluidRow(
      column(
        width = 6,

        # boxplot of x variable:
        plotOutput(
          outputId = NS(namespace = id, id = "x_boxplot")
        )
      ),

      column(
        width = 6,

        plotOutput(
          outputId = NS(namespace = id, id = "y_boxplot")
        )
      )
    )
  )
}

Of course we know that the choices to the selectInput()s are going to be the column names of the iris dataset but let's just pretend for a second we don't know them.

Let's call plot_ui() from the main UI ie. ui.R. Head over to ui.R, inside the tabPanel() with value = "tab_plot" add this line:

plot_ui(id = "var_plots")

So that your ui.R now becomes:

ui <- navbarPage(
  title = "Shiny Modules",
  id = "tab_container",
  theme = shinytheme(theme = "flatly"),

  tabPanel(
    title = "Data Input",
    value = "tab_input",

    shinyjs::useShinyjs(),

    data_input_ui(id = "data_input")
  ),

  tabPanel(
    title = "Plot",
    value = "tab_plot",

    plot_ui(id = "var_plots")
  ),

  tabPanel(
    title = "Distributions",
    value = "tab_distributions"
  )
)

Module Server

Create the file plot_server.R inside our /R folder.

First things first, plot_server():

  • Is a function that takes id as one of its arguments,

  • Calls the function moduleServer() for namespacing,

  • Which in turn calls another function which looks like your normal server.R.

So inside plot_server.R add this:

plot_server <- function(id) {
  moduleServer(
    id = id,

    module = function(input, output, session) {

    }
  )
}

At this point we know that for us to make the plots plot_server() has to take in the data we passed from data_input_server(), which means we add an extra argument to it.

Here we go:

plot_server <- function(id, r_flowers) {
  # Just to be 💯% sure that `r_flowers` is a reactive:
  stopifnot(is.reactive(r_flowers))

  moduleServer(
    id = id,

    module = function(input, output, session) {

    }
  )
}

It's always important for me to have that check of whether the argument passed is reactive or not just to avoid chaos. Sometimes you might be a lil tired and pass a non-reactive. Then you get some outlandish error messages and spend 5hours before you realize your argument wasn't reactive. stopifnot() will do a clean job for you by providing straight up error messages.

Let's now update the selectInput() choices:

plot_server <- function(id, r_flowers) {
  # Just to be 💯% sure that `r_flowers` is a reactive:
  stopifnot(is.reactive(r_flowers))

  moduleServer(
    id = id,

    module = function(input, output, session) {
      observe({
        # choices will be the numeric cols of `r_flowers()`:
        numeric_cols <- purrr::map_lgl(
          .x = r_flowers(),  # *Note this*
          .f = is.numeric
        )

        choices <- colnames(r_flowers())[numeric_cols]

        # update the `selectInput()`s:
        updateSelectInput(
          session = session,
          inputId = "x_var",
          choices = choices
        )

        updateSelectInput(
          session = session,
          inputId = "y_var",
          choices = choices
        )
      })
    }
  )
}

Note that if you want to access whatever is stored inside a reactive variable you have to call it like a function with no arguments.

Let's call plot_server() from server.R. Remember you have to provide two arguments now: id and r_flowers:

server <- function(input, output, session) {
  r_flowers <- data_input_server(
    id = "data_input",
    parent_session = session
  )

  plot_server(
    id = "var_plots",
    r_flowers = r_flowers
  )
}

Let's run the app again, upload the data and see how we're doing:

image.png

Well, it looks like we have a small problem here... When I wrote the iris dataset to a .csv file I included the row.names and so the choices have an option X, BUT...

image.png

Anyway, let's correct that. Head over to your console and run this line:

write.csv(x = iris, file = "data/iris.csv", row.names = FALSE)

And now when we run the app again and upload our data:

image.png

That's more like it now! Onto the plots. 🥳

I'm going to use {ggplot2}.

Let's start with the plot of the variables against each other.

Hmmmhh🤔 ... Are we gonna need a function for that? I don't think so. Let's first try without a function and see how it goes.

Add this to plot_server():

# x_var vs y_var:
output$x_vs_y <- renderPlot({
  r_flowers() |>
    ggplot(
      mapping = aes(
        # use the `.data` pronoun here:
        x = .data[[input$x_var]], y = .data[[input$y_var]],
        # color by `Species`:
        color = Species
      )
    ) +
    geom_point(size = 2) +
    # give some bizarre colors:
    scale_color_manual(values = c("black", "red", "blue")) +
    theme_bw() +
    theme(
      # remove legend title:
      legend.title = element_blank(),
      text = element_text(size = 15),
      aspect.ratio = 0.7
    )
})

Run App again aannddd...

image.png

Not bad, not bad.

image.png

Now what's remaining are the two boxplots. Let's get 'em.

Add this to plot_server():

output$x_boxplot <- renderPlot({
        r_flowers() |>
          ggplot(
            mapping = aes(
              x = Species, y = .data[[input$x_var]], color = Species
            )
          ) +
          geom_boxplot() +
          xlab("") +
          scale_color_manual(values = c("black", "red", "blue")) +
          theme_bw() +
          theme(
            legend.title = element_blank(),
            text = element_text(size = 15),
            aspect.ratio = 0.7
          )
      })

      output$y_boxplot <- renderPlot({
        r_flowers() |>
          ggplot(
            mapping = aes(
              x = Species, y = .data[[input$y_var]], color = Species
            )
          ) +
          geom_boxplot() +
          xlab("") +
          scale_color_manual(values = c("black", "red", "blue")) +
          theme_bw() +
          theme(
            legend.title = element_blank(),
            text = element_text(size = 15),
            aspect.ratio = 0.7
          )
      })

I feel there's just waaayyy too much repetition and copy pasting going on, so let's actually go ahead and create a function for the plots.

Create a file named xy_plots.R inside the folder /R. I know, I know. I'm too creative with the names.

image.png

Inside the xy_plots.R let's have this:

#' Scatter plot of var `x` against `y` plus their boxplots.
#'
#' @param flowers dataset to use, of course it *must* be iris in
#' our case
#' @param x `x` variable. Length one character vector.
#' @param y `y` variable. Length one character vector.
#'
#' @return Named list of three: scatterplot, x_boxplot, y_boxplot
#' @export
#'
#' @examples
#' xy_plots(iris, "Sepal.Length", "Sepal.Width")
#' xy_plots(iris, "Petal.Length", "Sepal.Width")

xy_plots <- function(flowers, x, y) {
  # theming:
  tm <- ggplot2::theme_bw() +
    ggplot2::theme(
      # remove legend title:
      legend.title = ggplot2::element_blank(),
      text = ggplot2::element_text(size = 15),
      aspect.ratio = 0.7
    )

  colors <- ggplot2::scale_color_manual(
    values = c("black", "red", "blue")
  )

  scatterplot <- flowers |>
    ggplot2::ggplot(
      mapping = ggplot2::aes(
        x = .data[[x]], y = .data[[y]], color = Species
      )
    ) +
    ggplot2::geom_point(size = 2) +
    colors +
    tm

  x_boxplot <- flowers |>
    ggplot2::ggplot(
      mapping = ggplot2::aes(
        x = Species, y = .data[[x]], color = Species
      )
    ) +
    ggplot2::geom_boxplot() +
    ggplot2::xlab("") +
    colors +
    tm

  # damn I still gotta repeat myself here!
  y_boxplot <- flowers |>
    ggplot2::ggplot(
      mapping = ggplot2::aes(
        x = Species, y = .data[[y]], color = Species
      )
    ) +
    ggplot2::geom_boxplot() +
    ggplot2::xlab("") +
    colors +
    tm

  # ----return----
  res <- list(
    scatterplot = scatterplot,
    x_boxplot = x_boxplot,
    y_boxplot = y_boxplot
  )

  return(res)
}

That's the best I can do for now, folks.

image.png

Now let's head over to plot_server() and render the plots as follows:

# ----plots----
plots <- reactive({
  xy_plots(
    flowers = r_flowers(),
    x = input$x_var,
    y = input$y_var
  )
})

# x_var vs y_var:
output$x_vs_y <- renderPlot({
  plots()$scatterplot
})

output$x_boxplot <- renderPlot({
  plots()$x_boxplot
})

output$y_boxplot <- renderPlot({
  plots()$y_boxplot
})

That looks much much cleaner! Run App and see if that works:

image.png

Looks good but let's actually increase the number of breaks between the two selectInput()s, between the sidebarLayout() and the fluidRow() and also after the fluidRow(). Then we'll also add a spinner to the scatter plot.

Our new plot_ui() becomes:

plot_ui <- function(id) {
  shiny::tagList(
    sidebarLayout(
      sidebarPanel = sidebarPanel(
        align = "center",

        # x variable:
        selectInput(
          inputId = NS(namespace = id, id = "x_var"),
          label = "X Variable",
          choices = NULL
        ),

        tags$br(),
        tags$br(),

        # y variable:
        selectInput(
          inputId = NS(namespace = id, id = "y_var"),
          label = "Y Variable",
          choices = NULL
        )
      ),

      mainPanel = mainPanel(
        # plot of the two vars against each other:
        plotOutput(
          outputId = NS(namespace = id, id = "x_vs_y")
        ) |>
          shinycssloaders::withSpinner(
            type = 2,
            color.background = "white"
          )
      )
    ),

    tags$br(),
    tags$br(),

    fluidRow(
      column(
        width = 6,

        # boxplot of x variable:
        plotOutput(
          outputId = NS(namespace = id, id = "x_boxplot")
        )
      ),

      column(
        width = 6,

        plotOutput(
          outputId = NS(namespace = id, id = "y_boxplot")
        )
      ),

      tags$br()
    )
  )
}

On Run App again, I think that's pretty nice. Of course there's some other functionality that can be added like letting user choose the size of the points in the scatterplot and also the colors. You can go ahead and add those, and just in case you get stuck reach out to me for some help.

image.png

But what we have so far has served our purpose.

That's it for our second tab. There's a final article coming up which will deal with the third tab and the final touches on our application.

Code for both the first tab and now the second tab can be found here.

A final one on lists:

image.png

 
Share this