问题
I want to CRUD(Create, read,update and delete) in a table in shiny app. it update and delete perfectly but when I want to add new record it does not show the input from slider when the textinput is filled. Sometimes it only shows the default of sliderInput which is 2 when the value of name is NULL.
ui <- fluidPage(
#use shiny js to disable the ID field
shinyjs::useShinyjs(),
#DT::dataTableOutput("responses"),
shinyjs::disabled(textInput("id", "Id", "0")),
textInput("name", "Name", ""),
checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
sliderInput("r_num_years", "Number of years using R", 0, 25, 2, ticks = FALSE),
actionButton("submit", "Submit",icon = icon("plus-circle"),class = "btn-primary"),
# Delete button
actionButton(inputId = "delete", label = "Delete", icon = icon("minus-circle"),class = "btn-primary"),
#NEW button
actionButton("new", "Reset",icon = icon("refresh"),class = "btn-primary"),
box(
title = "KPIs", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
DT::dataTableOutput("responses"), tags$hr()
)
)
Methods of Load Data and save data
UpdateInputs <- function(data, session) {
updateTextInput(session, "id", value = unname(rownames(data)))
updateTextInput(session, "name", value = unname(data["name"]))
updateCheckboxInput(session, "used_shiny", value = as.logical(data["used_shiny"]))
updateSliderInput(session, "r_num_years", value = as.integer(data["r_num_years"]))
}
CastData <- function(data) {
datar <- data.frame(name = data["name"],
used_shiny = as.logical(data["used_shiny"]),
r_num_years = as.integer(data["r_num_years"]),
stringsAsFactors = FALSE)
rownames(datar) <- data["id"]
return (datar)
}
CreateDefaultRecord <- function() {
mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
return (mydefault)
}
GetNextId <- function() {
if (exists("responses") && nrow(responses) > 0) {
max(as.integer(rownames(responses))) + 1
} else {
return (1)
}
}
CreateData <- function(data) {
data <- CastData(data)
rownames(data) <- GetNextId()
if (exists("responses")) {
responses <<- rbind(responses, data)
} else {
responses <<- data
}
}
ReadData <- function() {
if (exists("responses")) {
responses
}
}
UpdateData <- function(data) {
data <- CastData(data)
responses[row.names(responses) == row.names(data), ] <<- data
}
DeleteData <- function(data) {
responses <<- responses[row.names(responses) != unname(data["id"]), ]
}
GetTableMetadata <- function() {
fields <- c(id = "Id",
name = "Name",
used_shiny = "Used Shiny",
r_num_years = "R Years")
result <- list(fields = fields)
return (result)
}
Server.r is as following:
server <- function(input, output, session) {
# input fields are treated as a group
formData <- reactive({
sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
})
# Click "Submit" button -> save data
observeEvent(input$submit, {
if (input$id != "0") {
UpdateData(formData())
} else {
CreateData(formData())
UpdateInputs(CreateDefaultRecord(), session)
}
}, priority = 1)
# Press "New" button -> display empty record
observeEvent(input$new, {
UpdateInputs(CreateDefaultRecord(), session)
})
# Press "Delete" button -> delete from data
observeEvent(input$delete, {
DeleteData(formData())
UpdateInputs(CreateDefaultRecord(), session)
}, priority = 1)
# Select row in table -> show details in inputs
observeEvent(input$responses_rows_selected, {
if (length(input$responses_rows_selected) > 0) {
data <- ReadData()[input$responses_rows_selected, ]
UpdateInputs(data, session)
}
})
# display table
output$responses <- DT::renderDataTable(server = FALSE, selection = "single",
colnames = unname(GetTableMetadata()$fields)[-1], {
#update after submit is clicked
input$submit
#update after delete is clicked
input$delete
ReadData()
})
}
shinyApp(ui,server)
The Error message that I got is :
Warning in
[<-.factor
(*tmp*
, ri, value = 22L) : invalid factor level, NA generated
来源:https://stackoverflow.com/questions/33820575/how-to-add-edit-delete-of-table-in-shiny-app