2

我试图使用 Flexdashboard 重新创建 Chris Glur http://ipub.com/apps/shiny_crud01/提出的 CRUD 应用程序。

当我在数据表中选择一行进行编辑时遇到了一些问题，数据表中所选行的数据元素不会发送到左侧侧面板上的输入元素。

在此处输入图像描述

我想知道这是否是 flexdashboard 没有处理observeEvent下面的代码部分的问题，或者数据表后面的 javascript 是否没有observeEvent准确处理。

# 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)
    }

  })

此代码将所选行中的数据发送到输入面板中的输入元素，但这在 Flexdashboard 中不起作用。

下面是我针对这个问题的完整 flexdashboard 代码。我将不胜感激有人可以提供一些反馈。提前致谢。

---
title: "CRUD Prototype"
author: "Missy"
output: 
  flexdashboard::flex_dashboard:

    theme: United
    social: menu
    source_code: embed

    vertical_layout: scroll
    smooth_scroll: true
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(shinyjs)

```

```{r}
CreateDefaultRecord <- function() {
  mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
  return (mydefault)
}


# This method casts from the inputs to a one-row data.frame. We use it, for instance, when the user 
#creates a new record by typing in values into the inputs, and then clicks “Submit”

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)
}


# This method takes the data as selected in the DataTable, and updates the inputs with the respective values

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"]))
}

# This function finds the next ID of a new record. In mysql, this could be done by an incremental index, 
# automatically. And then this method could be used to fetch the last insert ID. But here, we manage the ID ourselves:


GetNextId <- function() {
  if (exists("responses") && nrow(responses) > 0) {
    max(as.integer(rownames(responses))) + 1
  } else {
    return (1)
  }
}


#Create


CreateData <- function(data) {

  data <- CastData(data)
  rownames(data) <- GetNextId()
  if (exists("responses")) {
    responses <<- rbind(responses, data)
  } else {
    responses <<- data
  }
}


#Read

ReadData <- function() {
  if (exists("responses")) {
    responses
  }
}


#Update

UpdateData <- function(data) {
  data <- CastData(data)
  responses[row.names(responses) == row.names(data), ] <<- data
}

#Delete

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)
}

```

Inputs {.sidebar}
-----------------------------------------------------------------------

```{r , echo = F}

                                              shinyjs::useShinyjs()

                                              shinyjs::disabled(textInput("id", "Id", "0"))
                                              textInput("name", "Name", "")
                                              checkboxInput("used_shiny", "Used Shiny", FALSE)
                                              sliderInput("r_num_years", "R Years", 0, 25, 2, ticks = FALSE)


                                              actionButton("submit", "Submit")
                                              actionButton("new", "New")
                                              actionButton("delete", "Delete")

```

```{r}

 # 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)
    }

  })

```

Column 
-----------------------------------------------------------------------
```{r}

DT::renderDataTable({
    #update after submit is clicked
    input$submit
  input$new
    #update after delete is clicked
    input$delete
    ReadData()
  }, server = FALSE, selection = "single",
  colnames = unname(GetTableMetadata()$fields)[-1]
  )     

```
4

0 回答 0