Rshiny CRUD 应用程序：使用选择输入而不是文本输入时用户输入崩溃
Posted
技术标签:
【中文标题】Rshiny CRUD 应用程序：使用选择输入而不是文本输入时用户输入崩溃【英文标题】：Rshiny CRUD app: User Input crashes when using selectize input instead of text input 【发布时间】：2019-02-15 07:56:06 【问题描述】：我正在开发一个接受用户输入并提交到表格的 CRUD 应用程序。
由于某种原因，当我使用下拉选择选项而不是文本输入时。当我使用文本输入时，它很好并且可以正常工作。 SelectizeInput，使应用程序崩溃，由于某种原因我找不到错误。我哪里错了？
这是我的代码：
library(shiny)
library(shinyjs)
library(shinythemes)
######################### Get table metadata. For now, just the fields ##########################
######################## Further development: also define field types ##########################
####################### and create inputs generically ###########################
######## TABLE 1: ADD NEW PERSON
GetTableMetadata <- function()
fields <- c(
id = "Id",
name = "Tribe/Task Name",
category = "Category",
task_num = "Task Order",
client_facing = "Client Facing?",
completion = "Task Completed?"
)
result <- list(fields = fields)
return (result)
########################## CREATE, READ, UPDATE, DELETE #######################################
#### CRUD
# Find the next ID of a new record
GetNextId <- function()
if (exists("responses") && nrow(responses) > 0)
max(as.integer(rownames(responses))) + 1
else
return (1)
#C
CreateData <- function(data)
data <- CastData(data)
rownames(data) <- GetNextId()
if (exists("responses"))
responses <<- rbind(responses, data)
else
responses <<- data
#R
ReadData <- function()
if (exists("responses"))
responses
#U
UpdateData <- function(data)
data <- CastData(data)
responses[row.names(responses) == row.names(data),] <<- data
#D
DeleteData <- function(data)
responses <<-
responses[row.names(responses) != unname(data["id"]),]
#######################################################################################
# Cast from Inputs to a one-row data.frame
CastData <- function(data)
datar <- data.frame(
name = data["name"],
category = data["category"],
task_num = as.integer(data["task_num"]),
stringsAsFactors = FALSE,
client_facing = as.logical(data["client_facing"]),
completion = as.logical(data["completion"])
)
rownames(datar) <- data["id"]
return (datar)
# Return an empty, new record
CreateDefaultRecord <- function()
mydefault <-
CastData(list(
id = "0",
name = "",
category ="",
task_num = 2,
client_facing = FALSE,
completion = FALSE
))
return (mydefault)
# Fill the input fields with the values of the selected record in the table
UpdateInputs <- function(data, session)
updateTextInput(session, "id", value = unname(rownames(data)))
updateTextInput(session, "name", value = unname(data["name"]))
updateSelectizeInput(session, "category", value = unname(data["category"]))
updateTextInput(session, "task_num", value = unname(rownames(data)))
updateCheckboxInput(session, "client_facing", value = as.logical(data["client_facing"]))
updateCheckboxInput(session, "completion", value = as.logical(data["completion"]))
#######################################################################################
#######################################################################################
ui <- fluidPage(
#use shiny js to disable the ID field
shinyjs::useShinyjs(),
##
#data table
DT::dataTableOutput("responses", width = 300),
#input fields
tags$hr(),
shinyjs::disabled(textInput("id", "Id", "0")),
textInput("name", "Tribe/Task Name", ""),
selectizeInput("Category", label = "Category", choices = c(Choose = '', Tribal = 'Tribal', Individual = 'Individual', Other = 'Other'), FALSE),
textInput("task_num", "Task Order", ""),
checkboxInput("client_facing", "Client Facing?", FALSE),
checkboxInput("completion", "Task Completed?", FALSE),
#action buttons
actionButton("submit", "Submit"),
actionButton("new", "New"),
actionButton("delete", "Delete")
)
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(
#update after submit is clicked
input$submit
#update after delete is clicked
input$delete
ReadData()
, server = FALSE, selection = "single",
colnames = unname(GetTableMetadata()$fields)[-1])
# Shiny app with 3 fields that the user can submit data for
shinyApp(ui = ui, server = server)
【问题讨论】：
【参考方案1】：selectizeinput() 上的 ID 错误。它应该是带有小“c”的“类别”。这是因为GetTableMetadata() 中的名称具有“类别”作为名称。
updateSelectizeInput() 也没有值作为参数。
如果这能解决您的问题，请告诉我。
library(shiny)
library(shinyjs)
library(shinythemes)
######################### Get table metadata. For now, just the fields ##########################
######################## Further development: also define field types ##########################
####################### and create inputs generically ###########################
######## TABLE 1: ADD NEW PERSON
GetTableMetadata <- function()
fields <- c(
id = "Id",
name = "Tribe/Task Name",
category = "Category",
task_num = "Task Order",
client_facing = "Client Facing?",
completion = "Task Completed?"
)
result <- list(fields = fields)
return (result)
########################## CREATE, READ, UPDATE, DELETE #######################################
#### CRUD
# Find the next ID of a new record
GetNextId <- function()
if (exists("responses") && nrow(responses) > 0)
max(as.integer(rownames(responses))) + 1
else
return (1)
#C
CreateData <- function(data)
data <- CastData(data)
rownames(data) <- GetNextId()
if (exists("responses"))
responses <<- rbind(responses, data)
else
responses <<- data
#R
ReadData <- function()
if (exists("responses"))
responses
#U
UpdateData <- function(data)
data <- CastData(data)
responses[row.names(responses) == row.names(data),] <<- data
#D
DeleteData <- function(data)
responses <<-
responses[row.names(responses) != unname(data["id"]),]
#######################################################################################
# Cast from Inputs to a one-row data.frame
CastData <- function(data)
datar <- data.frame(
name = data["name"],
category = data["category"],
task_num = as.integer(data["task_num"]),
stringsAsFactors = FALSE,
client_facing = as.logical(data["client_facing"]),
completion = as.logical(data["completion"])
)
rownames(datar) <- data["id"]
return (datar)
# Return an empty, new record
CreateDefaultRecord <- function()
mydefault <-
CastData(list(
id = "0",
name = "",
category ="",
task_num = 2,
client_facing = FALSE,
completion = FALSE
))
return (mydefault)
# Fill the input fields with the values of the selected record in the table
UpdateInputs <- function(data, session)
updateTextInput(session, "id", value = unname(rownames(data)))
updateTextInput(session, "name", value = unname(data["name"]))
updateSelectizeInput(session, "category")
updateTextInput(session, "task_num", value = unname(rownames(data)))
updateCheckboxInput(session, "client_facing", value = as.logical(data["client_facing"]))
updateCheckboxInput(session, "completion", value = as.logical(data["completion"]))
#######################################################################################
#######################################################################################
ui <- fluidPage(
#use shiny js to disable the ID field
shinyjs::useShinyjs(),
##
#data table
DT::dataTableOutput("responses", width = 300),
#input fields
tags$hr(),
shinyjs::disabled(textInput("id", "Id", "0")),
textInput("name", "Tribe/Task Name", ""),
selectizeInput("category", label = "Category", choices = c(Choose = '', Tribal = 'Tribal', Individual = 'Individual', Other = 'Other'), FALSE),
textInput("task_num", "Task Order", ""),
checkboxInput("client_facing", "Client Facing?", FALSE),
checkboxInput("completion", "Task Completed?", FALSE),
#action buttons
actionButton("submit", "Submit"),
actionButton("new", "New"),
actionButton("delete", "Delete")
)
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(
#update after submit is clicked
input$submit
#update after delete is clicked
input$delete
ReadData()
, server = FALSE, selection = "single",
colnames = unname(GetTableMetadata()$fields)[-1])
# Shiny app with 3 fields that the user can submit data for
shinyApp(ui = ui, server = server)
【讨论】：
以上是关于Rshiny CRUD 应用程序：使用选择输入而不是文本输入时用户输入崩溃的主要内容，如果未能解决你的问题，请参考以下文章