Flexdashboard を使用して、Chris Glur http://ipub.com/apps/shiny_crud01/によって提案された CRUD アプリを再作成しようとしてい ます。
編集のためにデータテーブルで行を選択すると、いくつかの問題が発生します。データテーブルで選択した行のデータ要素が、左側のサイド パネルの入力要素に送信されません。
observeEventこれは、flexdashboard が以下のコードのセクションを処理していない問題なのか、それともデータテーブルの背後にある 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]
)
```