Group_by + lag повторяют одинаковые значения для всех групп в Shiny

Question

Я создаю блестящее приложение, в котором пользователь может создать столбец в таблице, нажав checkboxInput. Столбец, который я хотел бы создать, содержит задержанное значение столбца, уже присутствующего в таблице.

Приведенный ниже код демонстрирует воспроизводимый пример: есть два человека (A и B) и три раза периоды (1, 2 и 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)

Когда я запускаю этот код и нажимаю на флажок, у меня появляется ошибка:

Предупреждение: Ошибка в: столбец mpg_lagged должен иметь длину 3 (группа размер) или один, а не 6

Благодаря этому ответу я исправил его, добавив order_by = ID в функцию lag, но теперь есть другая проблема: для отдельных 1, он создает правильные запаздывающие значения, но затем эти значения повторяются для отдельных 2, тогда как они не соответствуют.

Я пробовал подобный пример без среды Shiny, и правильный вывод таким образом, я полагаю, что эта проблема исходит от входных данных или реактивной среды.

У кого-нибудь есть решение?

Answer 1

Есть некоторые (незначительные) проблемы с нестандартной оценкой (NSE) внутри вашего reactive объекта данных. Исправление этих данных дает

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)

, в результате чего

Объяснение:

• select дубль и вычисленные символы и строки в качестве аргументов, поэтому мы можем напрямую передать input$choice в качестве аргумента select.
• Чтобы построить новый столбец с именем из переменной, нам нужно оценить переменную как !!lagged_name; затем мы должны использовать := (вместо =) для выполнения присваивания, поскольку грамматика R не допускает выражения в качестве имен аргументов (lhs присваивания). Наконец, внутри функции lag мы должны сначала преобразовать input$choice в символ с sym, а затем вычислить символ с !!. Это из-за NSE dplyr, где вы могли бы написать, например, mtcars %>% mutate(col = lag(wt)), а не mtcars %>% mutate(col = lag("wt")).