闪亮模块内的可编辑 DT

Question

I would like to have an editable DT inside a shiny module. When I change a value in the DT, then the table updates and it is empty with the message inside the datatable:

"No matching records found"

My code is as follows:

Modules:

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)
  })

}

app in flexdashboard:

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

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

It works well without modules, but I can't get the same results with shiny modules.

Thanks

Answer 1

This works if you remove rownames = FALSE :

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

If you don't want row names, you have to also set rownames = FALSE in the renderDataTable :

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

And then you have to add 1 to 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)
  })

Full code of the Rmd flexdashboard:

---
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

Working from your code, the issue is that the proxy needs the global session (and not the module session). See my other answer for an alternative approach.

You can simply pass the global session to the module via an argument.

This works:

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)
  })

}

You now have to add the global session in the module call.

With a shiny app:

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

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

shinyApp(ui = ui, server = server)

With a flexdashboard:

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

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

If you want to use your updated table in the rest of your app, simply return reactive(x) from your module and capture it when you call the module.

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

Answer 3

The following gives me an editable table and captures the edited table in a reactive for further use in the application:

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)

Answer 4

Good Morning

In my code source, i use globalsession but i have the same problem

library(shiny)
library(DT)
# Data frame df1
# n = 10
# df1 = data.frame(
#   month = month.abb[1:n],
#   YN = rep(c("[Null]", TRUE), times = c(5, 5)),
#   ID = seq_len(n),
#   stringsAsFactors = FALSE
# )
# df1[10,3] <- "[Null]"


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


modDt <-  function(input, output, session, df1, globalSession){ # Server module
  
  shinyInput = function(FUN, len, id, value, ...) {
    if (length(value) == 1)
      value <- rep(value, len)
    inputs = character(len)
    for (i in seq_len(len)) {
      inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
    }
    inputs
  }
  # Function for null value
  nullValue <- function(selectedColumn, df) {
    for (columIndex in selectedColumn) {
      df <- subset(df, df[, columIndex] != "[Null]")
      
    }
    
    df
  }
  
  # obtain the values of inputs
  shinyValue = function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value = input[[paste0(id, i)]]
      
      if (is.null(value))
        TRUE
      else
        value
    }))
  }
  
  # Data frame with checkbox in the first row  
  df2 = rbind(ID = shinyInput(
    checkboxInput,
    ncol(df1),
    'ID_',
    value = FALSE,
    width = '1px'
  ),
  df1)
  # Reactive function
  loopData = reactive({
    df2[1, ] <<-
      shinyInput(
        checkboxInput,
        ncol(df1),
        'ID_',
        value = shinyValue('ID_', ncol(df1)),
        width = '1px'
      )
    
    
    checked <- shinyValue('ID_',  ncol(df1))
    
    changed <- which((checked) != 0)
    
    
    df2 = nullValue(changed, df2)
  })
  
  output$x1 = DT::renderDataTable(
    isolate(loopData()),
    filter = "top",
    escape = FALSE,
    selection = 'none',
    options = list(
      dom = 't',
      paging = FALSE,
      ordering = FALSE,
      preDrawCallback = JS(
        'function() { Shiny.unbindAll(this.api().table().node()); }'
      ),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    )
  )
  
  proxy = dataTableProxy('x1',session=globalSession)
  
  observe({
    replaceData(proxy, loopData())
    print("yes")
  })
  
}
ui <- fluidPage(
  modDtUi("editable")
)

server <- function(input, output, session) {
  callModule(modDt,"editable", df1 = iris[,-5], globalSession = session)
}

shinyApp(ui = ui, server = server)