Rshiny CRUD 应用程序：使用选择输入而不是文本输入时用户输入崩溃

关键词：

【中文标题】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)

【讨论】：

创建 CRUD 视图而不创建控制器

...发布时间】：2014-07-2306:01:43【问题描述】：在C#MVC5Internet应用程序中，是否可以在不创建控制器的情况下为控制器创建CRUD视图。我问这个是因为我已经有一个控制器，但是我已经更改了模型结构，所以我希望只创建视图。这可能... 查看详情

Rshiny：如何将 renderUI 输出传递给 Selectinput 中的 chocies 参数

】Rshiny：如何将renderUI输出传递给Selectinput中的chocies参数【英文标题】：Rshiny:HowtopassrenderUIoutputtochociesparameterinSelectinput【发布时间】：2015-11-2707:03:32【问题描述】：我正在尝试在server.UI中输入renderUI输出作为selectInput中的选择=参... 查看详情

R Shiny：向数据表添加新列

...1-2307:19:03【问题描述】：我正在使用Rshiny来创建机器学习应用程序。该应用程序使用输入小部件来创建测试观测值，然后将其馈送到随机森林模型并在单击操作按钮时输出估计值。我想将选择的输入数据以及估计值和时间戳存储... 查看详情

使用 JQuery 聚焦输入字段而不选择当前值文本

】使用JQuery聚焦输入字段而不选择当前值文本【英文标题】：FocusinputfieldwithJQuerywithoutselectingcurrentvaluetext【发布时间】：2010-12-1722:25:30【问题描述】：$("#myinputfield").focus();在已设置值的输入字段上执行此操作会导致选择当前值。... 查看详情

C++：使用程序集询问用户输入而不按回车？ [复制]

】C++：使用程序集询问用户输入而不按回车？[复制]【英文标题】：C++:Askuserinputwithoutpressingenterusingassembly?[duplicate]【发布时间】：2017-04-1719:21:11【问题描述】：我想创建一个菜单，用户只需按下一个按钮并从屏幕上的选项中进行... 查看详情

根据文件选择保存和加载用户选择 - R Shiny

...2019-04-0115:53:59【问题描述】：我正在尝试创建一个简单的应用程序，它充当GUI来研究具有相同变量但具有不同版本和内容的不同文件。我无法提供一个应用程序，每次用户打开应用程序时，他们都不必在他们离开的地方再次输入... 查看详情

闪亮：更新输入而不触发反应？

...转发给相关的反应器。问题和底层用例类似于以下问题：Rshiny-possibleissuewi 查看详情

wellPanel Rshiny 在滚动时被输入选项切断

...问题描述】：RshinywellPanel不透明度问题如何确保我闪亮的应用程序的wellPanel不会被UI中的其他元素截断？我希望用户滚动并且包含标题的wellPanel将在excel中像冻结的行一样。谢谢！library 查看详情

在组合框中使用向下/向上箭头键选择数据而不更新数据，直到点击选项卡或输入 MS Access

】在组合框中使用向下/向上箭头键选择数据而不更新数据，直到点击选项卡或输入MSAccess【英文标题】：UsingDown/UpArrowkeyincomboboxtoselectdatawithoutupdatingthedatauntilhittingtaborenterMSAccess【发布时间】：2020-05-1215:24:55【问题描述】：在组... 查看详情

面向业务的大量数据输入 (CRUD) 应用程序的 GUI 设计的良好示例 [关闭]

】面向业务的大量数据输入(CRUD)应用程序的GUI设计的良好示例[关闭]【英文标题】：GoodexamplesofGUIdesignforbusiness-oriented,heavydata-entry(CRUD)applications[closed]【发布时间】：2010-10-2408:18:52【问题描述】：我在哪里可以找到制作精良的企业... 查看详情

R Shiny：修改选择后保留/保留反应输入的值

】RShiny：修改选择后保留/保留反应输入的值【英文标题】：RShiny:Keep/retainvaluesofreactiveinputsaftermodifyingselection【发布时间】：2016-11-0123:34:54【问题描述】：在用户修改另一个selectInput(multiple=T)选项中的选择后，我试图将用户选择的... 查看详情

使用 PhoneNumberFormattingTextWatcher 而不输入国家/地区呼叫代码

...ngcode【发布时间】：2015-12-1603:42:39【问题描述】：在我的应用程序的登录面板中，我将国家/地区呼叫代码和剩余号码划分为两个可编辑的TextView，如下所示：我想在右侧的TextVi 查看详情

在我的应用程序中播放本地音频文件而不使用输入类型文件

】在我的应用程序中播放本地音频文件而不使用输入类型文件【英文标题】：PlaylocalaudiofilesinMyappwithoutusingtheinputtypefile【发布时间】：2019-08-1602:06:41【问题描述】：我正在创建一个电子应用程序，并且想在不使用输入类型文件的... 查看详情

运行 R Shiny 应用程序时如何在数据表函数中编辑列名？

】运行RShiny应用程序时如何在数据表函数中编辑列名？【英文标题】：HowtoeditcolumnnamesindatatablefunctionwhenrunningRshinyapp?【发布时间】：2019-07-1208:58:51【问题描述】：我在RShiny中使用DT包中的数据表函数，我希望我的应用程序的用户... 查看详情

通过 R Shiny 中的先前输入限制输入的选项

...】：2021-02-1021:25:59【问题描述】：我正在构建一个闪亮的应用程序，并想知道如何根据第一个输入中选择的选项自动限制选择输入的选择。该应用程序如下所示：library(shiny)library(shinyWidgets)library(dslabs)libra 查看详情

更新 R Shiny 中的 DT 列过滤器选择

...iny【发布时间】：2019-07-1717:29:27【问题描述】：我的RShiny应用程序中有一个使用DT包的数据表。该表启用了列过滤器。偶尔，我会使用replaceData函数替换数据表中的数据。发生这种情况时，数据会更新，但列过滤器中的选择仍然... 查看详情

Rshiny：我想让用户选择 3 个图表

】Rshiny：我想让用户选择3个图表【英文标题】：Rshiny:Iwanttoallowuserstoselect3graphs【发布时间】：2021-10-0413:15:49【问题描述】：在我的服务器函数中，我有一段代码旨在让用户看到三个图表之一。x=reactive(if(input$Option=="Byrating")output$M... 查看详情

如何使用 rasphone.exe 获得 *** 连接而不总是提示输入密码

...我有一个使用rasphone.exe接口连接Windows***（不是Open***）的应用程序。我可以成功建立连接，但每次都提示输入密码。有没有办法让 查看详情