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

时间：2018-09-10 20:48:21

标签： r shiny crud textinput selectize.js

我正在研究一个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 个答案:

答案 0 :(得分：0)

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)
相关问题
最新问题