Обновить datatable на основе пользовательского ввода, включить обновление соответствующих столбцов, а не только отредактированного

#r #shiny #dt

#r #блестящий #dt

Вопрос:

Небольшое приложение ниже генерирует DT::datatable с двумя столбцами x, y. X начинается как случайное число с rnorm. y должно быть таким, какое x равно плюс 1.

Приложение позволяет пользователю редактировать столбец x в DT ::datatable. Я создал его так, чтобы пользователь мог изменять столбец x, однако столбец y обновляется не так, как ожидалось, он просто остается неизменным.

Блестящий код:

 library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
    data.frame(
        x = x %>% unlist
    ) %>% mutate(y = x   1)
}

## render DT
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
    renderDT(data, selection = 'none', server = server, editable = editable, ...)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
    
    x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
    
    # the df to be displayed as a DT::datatable. 
    ex_df <- reactive({create_sample_df(x)})
    
    ## set to initially be the on open result of ex_df, before any user input
    reactivs <- reactiveValues(ex_df = ex_df)
    
    observeEvent(input$ex_df_cell_edit, {
        info = input$ex_df_cell_edit
        str(info)
        i = info$row
        j = info$col
        v = info$value

        # update budgets, which in turn is used to generate data during create_sample_df()
        x[[i]] <<- v
        
        # now update the reactive values object with the newly generated df
        reactivs$ex_df <<- reactive({create_sample_df(x)})
    })
    
    output$ex_df <- render_dt(data = reactivs$ex_df(),
                              rownames = FALSE,
                              list(target = 'cell', 
                                   disable = list(columns = c(1))))
    
}

shinyApp(ui, server)
  

Снимок экрана:
введите описание изображения здесь

На экране я собираюсь отредактировать первую строку в столбце x с -1, скажем, до 10. После нажатия enter желаемый результат заключается в том, что для строки 1 значение x равно 10, а значение y равно 11.

В настоящее время этого не происходит, y остается неизменным, несмотря ни на что. Кроме того, первая попытка отредактировать столбец x не работает, только после второй попытки новое значение сохраняется.

Ответ №1:

Проблема в том, как вы передаете реактивные данные своему пользовательскому render_dt . Я не совсем уверен, почему, но изменения в reactivs$ex_df не распознаются. Изменения, которые вы видите в столбце x, связаны не с обновленным ex_df , а с изменениями, непосредственно внесенными в таблицу. Поэтому я изменил его обратно на использование renderDT напрямую. Я внес некоторые дополнительные изменения:

  • ex_df само по себе не реагирует. Он хранится в reactiveValues объекте, где каждая запись сама по себе уже реагирует.
  • назначения для reactiveValues не нужны <<-
  • отредактированное значение в cell_edit является символьным вектором
 library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
  data.frame(
    x = x %>% unlist
  ) %>% mutate(y = x   1)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
  
  x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
  
  # the df to be displayed as a DT::datatable. 
  ex_df <- create_sample_df(x)
  
  ## set to initially be the on open result of ex_df, before any user input
  reactivs <- reactiveValues(ex_df = ex_df)
  
  observeEvent(input$ex_df_cell_edit, {
    info = input$ex_df_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    # update budgets, which in turn is used to generate data during create_sample_df()
    x[[i]] <<- as.numeric(v)
    
    # now update the reactive values object with the newly generated df
    reactivs$ex_df <- create_sample_df(x)
  })
  
  output$ex_df <- renderDT({
    datatable(reactivs$ex_df,
              editable = "cell",
              rownames = FALSE,
              options = list(target = 'cell', 
                             disable = list(columns = c(1))))
  })
  
}

shinyApp(ui, server)
  

Редактировать

здесь решение без observeEvent и только reactive() для ex_df . Затем вы можете передать недооцененное reactive в свою render_dt функцию:

 library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)


# define functions

## generate example data
create_sample_df <- function(x) {
  data.frame(
    x = x %>% unlist
  ) %>% mutate(y = x   1)
}

## render DT
render_dt = function(data_in, editable = 'cell', server = TRUE, ...) {
  renderDT(data_in(), selection = 'none', server = server, editable = editable, ...)
}


# UI ----

header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)

# Server ----
server <- function(input, output) {
  
  x <- rnorm(10, 0, 2) %>% as.integer %>%  as.list
  
  # the df to be displayed as a DT::datatable. 
  setup_df <- create_sample_df(x)
  
  ex_df <- eventReactive(input$ex_df_cell_edit, {
    # on startup
    if (is.null(input$ex_df_cell_edit)) {
      setup_df
      
      # for edits
    } else {
      
      
      info = input$ex_df_cell_edit
      str(info)
      i = info$row
      j = info$col
      v = info$value
      
      # update budgets, which in turn is used to generate data during create_sample_df()
      x[[i]] <<- as.numeric(v)
      
      create_sample_df(x)
    }
  },
  ignoreNULL = FALSE)
  
  output$ex_df <- render_dt(data_in = ex_df,
                            rownames = FALSE,
                            list(target = 'cell', 
                                 disable = list(columns = c(1))))
  
}

shinyApp(ui, server)
  

Комментарии:

1. Это работает! Большое вам спасибо. Я действительно боролся с этой проблемой. Любопытно, почему следует выбрать второй подход с eventReactive вместо observeEvent?

2. Я использовал его здесь по 2 причинам: 1. eventReactive возвращает reactive (который в основном является функцией), так что вы можете легко передать ex_df (и не ex_df() ) на свой пользовательский render_dt , и это все еще работает (хотя вы, вероятно, могли бы также адаптировать свой render_dt , чтобы это также работало с reactivs$ex_df . 2. вы вызываете observeEvent не из-за его побочных эффектов, а потому, что вам действительно нужен измененный набор данных (то есть возвращаемое значение). Вы можете заставить его работать с observeEvent , но eventReactive специально разработан для этого, так что немного легче увидеть, чего вы хотите достичь с помощью своего кода.

3. Кстати: вы могли бы изучить возможность использования прокси, чтобы вам не всегда приходилось обновлять всю таблицу, а только измененное значение. Это выглядит немного приятнее