редактируемый DT внутри блестящего модуля

Question

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

"Не найдено подходящих записей"

Мой код выглядит следующим образом:

Модули:

modDtUi <- function(id){ # UI module
  ns = NS(id)
  DT::dataTableOutput(ns('x1'))
} 


modDt <-  function(input, output, session, data){ # Server module

  x <- data
  output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE)

  proxy <- dataTableProxy('x1', session = session)

  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    str(info)
    print(info)
    i = info$row
    j = info$col
    v = info$value
    x[i, j] <<- DT::coerceValue(v, x[i, j])
    replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
  })

}

приложение в flexdashboard:

```{r}
modDtUi("editable")
```

```{r}
callModule(modDt,"editable", data = iris)
```

Хорошо работает без модулей, но я не могу получить тот же результат с блестящими модулями.

Спасибо

Answer 1

Это работает, если вы удаляете rownames = FALSE:

replaceData(proxy, x, resetPaging = FALSE)#, rownames = FALSE)

Если вам не нужны имена строк, вы также должны установить rownames = FALSE в renderDataTable:

  output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE, 
                                   rownames = FALSE)

И затем вы должны добавить 1 к info$col:

  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    i = info$row
    j = info$col + 1
    v = info$value
    x[i, j] <<- DT::coerceValue(v, x[i, j])
    replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
  })

Полный код гибкой панели управления Rmd:

---
title: "Untitled"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(DT)

modDtUi <- function(id){ # UI module
  ns = NS(id)
  DT::dataTableOutput(ns('x1'))
} 

modDt <-  function(input, output, session, data){ # Server module

  x <- data
  output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE, 
                                   rownames = FALSE)

  proxy <- dataTableProxy('x1', session = session)

  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    i = info$row
    j = info$col + 1
    v = info$value
    x[i, j] <<- DT::coerceValue(v, x[i, j])
    replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
  })

}
```

Column {data-width=650}
-----------------------------------------------------------------------

### Editable table

```{r}
modDtUi("editable")
```

```{r}
callModule(modDt, "editable", data = iris)
```

Answer 2

Исходя из вашего кода, проблема в том, что прокси-серверу нужен глобальный сеанс (а не сеанс модуля). Смотрите мой другой ответ для альтернативного подхода.

Вы можете просто передать глобальный session в модуль через аргумент.

Это работает:

library(shiny)
library(DT)

modDtUi <- function(id){ # UI module
  ns = NS(id)
  DT::dataTableOutput(ns('x1'))
}


modDt <-  function(input, output, session, data, globalSession){ # Server module

  x <- data
  output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE)

  proxy <- dataTableProxy('x1', session = globalSession)

  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    str(info)
    print(info)
    i = info$row
    j = info$col
    v = info$value
    x[i, j] <<- DT::coerceValue(v, x[i, j])
    replaceData(proxy, x, resetPaging = FALSE)
  })

}

Теперь вам нужно добавить глобальный сеанс в вызов модуля.

С блестящим приложением:

ui <- fluidPage(
  modDtUi("editable")
)

server <- function(input, output, session) {
  callModule(modDt,"editable", data = iris, globalSession = session)
}

shinyApp(ui = ui, server = server)

С гибкой приборной панелью:

```{r}
modDtUi("editable")
```

```{r}
callModule(modDt, "editable", data = iris, globalSession = session)
```

Если вы хотите использовать обновленную таблицу в остальной части вашего приложения, просто верните reactive(x) из вашего модуля и перехватите его при вызове модуля.

editable_iris <- callModule(modDt,"editable", data = iris, globalSession = session)

Answer 3

Следующее дает мне редактируемую таблицу и записывает отредактированную таблицу в реактив для дальнейшего использования в приложении:

library(shiny)
library(DT)

modDtUi <- function(id){ # UI module
  ns = NS(id)
  DT::dataTableOutput(ns('x1'))
}


modDt <-  function(input, output, session, data){ # Server module

  output$x1 <- DT::renderDataTable(data, selection = 'none', editable = TRUE, server = TRUE)
  proxy <- dataTableProxy('x1', session = session)

  updatedData <- eventReactive(input$x1_cell_edit, {
    info = input$x1_cell_edit
    if (!is.null(info)) {
      str(info)
      data[info$row, info$col] <<- DT::coerceValue(info$value,
                                                   data[info$row, info$col])
    }
    data
  }, ignoreNULL = FALSE)

  return(updatedData)
}

ui <- fluidPage(
  modDtUi("editable"),
  tags$hr(),
  "Proof it works: the table below updates on edit.",
  shiny::tableOutput("proof")
)

server <- function(input, output) {
  editable_dt <- callModule(modDt,"editable", data = iris)

  output$proof <- renderTable({
    editable_dt() %>%
      summarise_if(is.numeric, mean)
  })

}

shinyApp(ui = ui, server = server)