最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

Editable DT in R-Shiny - Stack Overflow

programmeradmin5浏览0评论

I'm working on a datatable in R-Shiny. I'd like to build a datatable that is editable in some columns. Moreover, I need the filter and search functions.

I have to use the server side rendering, because in my final setting I will have a very huge number of lines.

So my problem is that the table is rendered from a reactiveVal. So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.

So what can I do? Does anybody have an idea?

Here's a demonstration of my code, but with some fictive data and another context.

    library(shiny)
library(DT)

generate_data <- function(n = 100) {
  data.frame(
    ID = 1:n,
    FirstName = paste("FirstName", 1:n),
    LastName = paste("LastName", 1:n),
    Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
    PostalCode = sample(10000:99999, n, replace = TRUE),
    City = paste("City", sample(1:50, n, replace = TRUE)),
    VisitsPerYear = sample(1:20, n, replace = TRUE),
    Status = rep("active", n)
  )
}

ui <- fluidPage(
  titlePanel("Sample Data for Persons"),
  DTOutput("table")
)

server <- function(input, output, session) {
  testdata <- reactiveVal(generate_data(100))
  
  output$table <- renderDT({
    datatable(testdata(), 
              options = list(
                server = TRUE,
                pageLength = 10
              ), 
              editable = list(target = 'cell', disable = list(columns = 0:6))
    )
  })
  
  observeEvent(input$table_cell_edit, {
    info <- input$table_cell_edit
    i <- info$row
    j <- info$col
    v <- info$value
    
    data <- testdata()
    
    if (j == 7) {
      data[i, j] <- v
    }
    
    testdata(data)
  })
}

shinyApp(ui = ui, server = server)

I'm working on a datatable in R-Shiny. I'd like to build a datatable that is editable in some columns. Moreover, I need the filter and search functions.

I have to use the server side rendering, because in my final setting I will have a very huge number of lines.

So my problem is that the table is rendered from a reactiveVal. So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.

So what can I do? Does anybody have an idea?

Here's a demonstration of my code, but with some fictive data and another context.

    library(shiny)
library(DT)

generate_data <- function(n = 100) {
  data.frame(
    ID = 1:n,
    FirstName = paste("FirstName", 1:n),
    LastName = paste("LastName", 1:n),
    Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
    PostalCode = sample(10000:99999, n, replace = TRUE),
    City = paste("City", sample(1:50, n, replace = TRUE)),
    VisitsPerYear = sample(1:20, n, replace = TRUE),
    Status = rep("active", n)
  )
}

ui <- fluidPage(
  titlePanel("Sample Data for Persons"),
  DTOutput("table")
)

server <- function(input, output, session) {
  testdata <- reactiveVal(generate_data(100))
  
  output$table <- renderDT({
    datatable(testdata(), 
              options = list(
                server = TRUE,
                pageLength = 10
              ), 
              editable = list(target = 'cell', disable = list(columns = 0:6))
    )
  })
  
  observeEvent(input$table_cell_edit, {
    info <- input$table_cell_edit
    i <- info$row
    j <- info$col
    v <- info$value
    
    data <- testdata()
    
    if (j == 7) {
      data[i, j] <- v
    }
    
    testdata(data)
  })
}

shinyApp(ui = ui, server = server)
Share Improve this question edited Jan 17 at 16:10 jpsmith 17.7k6 gold badges22 silver badges45 bronze badges asked Jan 17 at 15:30 KTSBKTSB 1117 bronze badges
Add a comment  | 

1 Answer 1

Reset to default 0

So when I edit some values on page 20, then the table will be reloaded, and I'm back on page 1. This is a problem when I have to edit many columns in one line.

So what can I do? Does anybody have an idea?

First, I would set pageLength = nrow(testdata()) to always show your whole table. Secondly you can use stateSave = TRUE to remember the state of your table. I would also turn of rownames rownames = FALSE since you have the ID column anyway. Furthermore I would turn off the row selection as it behaves weird and sometimes overshadows the row value which you want to edit: selection = 'none'

This should do the trick, let me know if this helped. I also have another more fancy JavaScript solution ;)

Code (normal boring way)

library(shiny)
library(DT)


generate_data <- function(n = 100) {
  data.frame(
    ID = 1:n,
    FirstName = paste("FirstName", 1:n),
    LastName = paste("LastName", 1:n),
    Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
    PostalCode = sample(10000:99999, n, replace = TRUE),
    City = paste("City", sample(1:50, n, replace = TRUE)),
    VisitsPerYear = sample(1:20, n, replace = TRUE),
    Status = rep("active", n)
  )
}

ui <- fluidPage(
  titlePanel("Sample Data for Persons"),
  DTOutput("table")
)

server <- function(input, output, session) {
  testdata <- reactiveVal(generate_data(100))
  
  output$table <- renderDT({
    datatable(testdata(), 
              options = list(
                pageLength = nrow(testdata()),
                stateSave = TRUE,
                dom = 'Bfrtip'  # Adds better control options
              ),
              selection = 'none',  # Disable row selection
              editable = list(target = 'cell', disable = list(columns = 0:6)),
              rownames = FALSE
    )
  }, server = FALSE)  # Move server option here
  
  observeEvent(input$table_cell_edit, {
    info <- input$table_cell_edit
    i <- info$row
    j <- info$col
    v <- info$value
    print(j)
    data <- testdata()
    
    if (j == 7) {
      data[i, j] <- v
      testdata(data)
    }
  })
}

shinyApp(ui = ui, server = server)

Fancy way

library(shiny)
library(DT)

generate_data <- function(n = 100) {
  data.frame(
    ID = 1:n,
    FirstName = paste("FirstName", 1:n),
    LastName = paste("LastName", 1:n),
    Address = paste("Street", sample(1:99, n, replace = TRUE), sample(1:99, n, replace = TRUE)),
    PostalCode = sample(10000:99999, n, replace = TRUE),
    City = paste("City", sample(1:50, n, replace = TRUE)),
    VisitsPerYear = sample(1:20, n, replace = TRUE),
    Status = rep("active", n)
  )
}

ui <- fluidPage(
  titlePanel("Sample Data for Persons"),
  tags$head(
    tags$style(HTML("
      .dataTable td.status-cell {
        padding: 0 !important;
      }
      .dataTable td.status-cell input {
        width: 100%;
        border: none;
        background: transparent;
        margin: 0;
        padding: 8px;
        height: 100%;
      }
    "))
  ),
  DTOutput("table")
)

server <- function(input, output, session) {
  testdata <- reactiveVal(generate_data(100))
  
  output$table <- renderDT({
    datatable(
      testdata(),
      options = list(
        pageLength = nrow(testdata()),
        stateSave = TRUE,
        dom = 'Bfrtip',
        columnDefs = list(
          list(
            targets = 7,
            className = 'status-cell'
          )
        ),
        initComplete = JS("
          function(settings, json) {
            var table = settings.oInstance.api();
            var container = table.table().container();
            
            $(container).on('click', 'td.status-cell', function() {
              var cell = $(this);
              if (!cell.find('input').length) {
                var value = cell.text();
                cell.html('<input type=\"text\" value=\"' + value + '\">');
                cell.find('input').focus();
              }
            });
            
            $(container).on('blur', 'td.status-cell input', function() {
              var input = $(this);
              var value = input.val();
              var cell = input.closest('td');
              var row = table.row(cell.parent()).index();
              Shiny.setInputValue('table_cell_edit', {
                row: row + 1,
                col: 7,
                value: value
              });
            });
            
            // Initialize all status cells with input fields
            table.cells('.status-cell').every(function() {
              var cell = $(this.node());
              var value = cell.text();
              cell.html('<input type=\"text\" value=\"' + value + '\">');
            });
          }
        ")
      ),
      selection = 'none',
      editable = FALSE,
      rownames = FALSE
    )
  }, server = FALSE)
  
  observeEvent(input$table_cell_edit, {
    info <- input$table_cell_edit
    i <- info$row
    j <- info$col
    v <- info$value
    
    data <- testdata()
    
    if (j == 7) {
      data[i, j] <- v
      testdata(data)
    }
  })
}

shinyApp(ui = ui, server = server)
发布评论

评论列表(0)

  1. 暂无评论