jeudi 29 octobre 2020

CheckboxInput with Edit table in DT R Shiny

I tried to combine editing table by adding, deleting row in DT table with checkboxInput(). It is not quite correct.

If I didn't add editing feature, it returned correct, but if I added editing feature,it didn't response after I added another row. I got stuck for a while, I will appreciate any help from you guys

library(shiny)
library(shinyjs)
library(DT)

# Tab 2 UI code.
tab2UI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "Tab 2",
    fluidRow(
      #uiOutput(ns('cars')),
      h2('The mtcars data'),
      DT::dataTableOutput(ns('mytable2')),
      uiOutput(ns("edit_1")),
      h2("Selected"),
      tableOutput(ns("checked"))
    )
  )
}


# Tab 2 server code.
tab2Server <- function(input, output, session) {
  ns <- session$ns
  
  # Helper function for making checkboxes.
  shinyInput = function(FUN, len, id, ...) {
    inputs = character(len)
    for (i in seq_len(len)) {
      inputs[i] = as.character(FUN(ns(paste0(id, i)), label = NULL, ...))
    }
    inputs
  }
  

  # Update table records with selection.
  subsetData <- reactive({
    sel <- mtcars[1:5,]
     
  })
  
  values <- reactiveValues(df = NULL)
  
  observe({
    values$df <- subsetData()
   })
  
 
  
  # Datatable with checkboxes.
  output$mytable2 <- DT::renderDataTable(
    datatable(
      data.frame(values$df,Favorite=shinyInput(checkboxInput,nrow(values$df), "cbox_", width = 10)),
      editable = TRUE,
      selection = 'single', 
      escape = FALSE,
      options = list(
        paging = FALSE,
        preDrawCallback = JS('function() {Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() {Shiny.bindAll(this.api().table().node()); }')
      )
    )
  )
  
  
  
  observeEvent(input$add.row_1,{
    
   # print(paste0("Row selected",input$mytable2_rows_selected))
    
    if (!is.null(input$mytable2_rows_selected)) {
      
      td <- values$df
      
      
      tid_n = as.numeric(input$mytable2_rows_selected)
      tid = as.numeric(input$mytable2_rows_selected) + 1
      
      
      if(tid_n == nrow(td)){
        td<- rbind(data.frame(td[1:tid_n, ]),
                   data.frame(td[tid_n, ]))
      }else{
        td<- rbind(data.frame(td[1:tid_n, ]),
                   data.frame(td[tid_n, ]),
                   data.frame(td[tid: nrow(td), ]))
      }
       
 
      td <- data.frame(td)
      print(td)
      values$df <- td
      
    }
  })
  

  output$edit_1 <- renderUI({
    tagList(
      actionButton(inputId = ns("add.row_1"), label = "Add Row", icon = icon("plus"),class = "example-css-selector",style = "background-color:gray; border-color:gray;color:white;height:31px;"),
      actionButton(inputId = ns("delete.row_1"), label = "Delete Row", icon = icon("minus"),class = "example-css-selector",style = "background-color:gray; border-color:gray;color:white;height:31px;"),br(),br()
    )
  })
  
  # Helper function for reading checkbox.
  shinyValue = function(id, len) {
    values <- unlist(lapply(seq_len(len), function(i) {
      value = input[[paste0(id, i)]]
      if (is.null(value)) NA else value
    }))
    return(values)
  }
  
  # Output read checkboxes.
  observe({

    len <- nrow(values$df)
  
    output$checked <- renderTable({
      data.frame(selected=shinyValue("cbox_", len))
    })
  })
  

}

# Define UI for application.
ui <- fluidPage(
  useShinyjs(),
  navbarPage(
    'Title',
    tab2UI("tab2")
  )
)

# Define server.
server <- function(input, output, session) {

  # Call tab2 server code.
  callModule(tab2Server, "tab2")
}

# Run the application
shinyApp(ui = ui, server = server)



Aucun commentaire:

Enregistrer un commentaire