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