Group_by + lag repeat the same values for all groups in Shiny

Question

I'm making a Shiny app in which the user can generate a column in a table by clicking on a checkboxInput. The column I would like to create contains the lagged value of the column already present in the table.

The code below shows a reproducible example: there are two individuals (A and B) and three time periods (1, 2 and 3).

library(dplyr)
library(shiny)

data <- head(mtcars)
data$time <- rep(seq(1:3))
data$ID <- rep(c("A", "B"), each = 3)

ui <- fluidPage(
  selectInput("choice", "Select a column", choices = c("mpg", "drat", "hp"), multiple = F),
  checkboxInput("lag", "Compute lag value"),
  tableOutput("table")
)

server <- function(input, output, session) {

  data2 <- reactive({
    lagged_name <- paste0(input$choice, "_lagged")
    if (input$lag){
      data %>%
        select(ID, time, input$choice) %>%
        group_by(ID) %>%
        mutate(!!all_of(lagged_name) := lag(data[, input$choice]))
    }
    else {
      data %>%
        select(ID, time, input$choice)
    }
  })

  output$table <- renderTable({
    data2()
  })
}

shinyApp(ui, server)

When I run this code and click on the checkbox, I have the error:

Warning: Error in : Column mpg_lagged must be length 3 (the group size) or one, not 6

Thanks to this answer, I corrected it by adding order_by = ID in the lag function but now there is another problem: for individual 1, it creates the right lagged values, but then those values are repeated for individual 2 as well whereas they do not correspond.

I tried a similar example without the Shiny environment and the right output is produced so I suppose this problem comes from the inputs or reactive environment.

Does anybody have a solution?

Answer 1

There are some (minor) issues with non-standard evaluation (NSE) inside your reactive data object. Fixing these gives

library(dplyr)
library(shiny)

data <- head(mtcars)
data$time <- rep(seq(1:3))
data$ID <- rep(c("A", "B"), each = 3)

ui <- fluidPage(
  selectInput("choice", "Select a column", choices = c("mpg", "drat", "hp"), multiple = F),
  checkboxInput("lag", "Compute lag value"),
  tableOutput("table")
)

server <- function(input, output, session) {

  data2 <- reactive({
    lagged_name <- paste0(input$choice, "_lagged")
    if (input$lag){
      data %>%
        select(ID, time, input$choice) %>%
        group_by(ID) %>%
        mutate(!!lagged_name := lag(!!sym(input$choice)))
    }
    else {
      data %>%
        select(ID, time, input$choice)
    }
  })

  output$table <- renderTable({
    data2()
  })
}

shinyApp(ui, server)

resulting in

Explanation:

• select takes both evaluated symbols and strings as arguments, so we can directly pass input$choice as an argument to select.
• To construct a new column with a name from a variable we need to evaluate the variable as !!lagged_name; we then must use := (instead of =) to do the assignment, as R's grammar does not allow expressions as argument names (the lhs of the assignment). Finally, inside the lag function we first must convert input$choice to a symbol with sym and then evaluate the symbol with !!. That's because of dplyr's NSE, where you would write e.g. mtcars %>% mutate(col = lag(wt)) and not mtcars %>% mutate(col = lag("wt")).