【发布时间】：2021-02-06 07:53:57
【问题描述】：
我正在创建一个 ShinyApp 以将数据输入到作为数据库 (SQL) 一部分的表中。数据输入表单应该允许选择两个变量，而第二个变量取决于第一个变量（关于两个变量关系的信息存储在另一个数据表中）。如果我使用 selectizeGroupUI() 会产生以下错误：“在为函数“dbWriteTable”选择方法时评估参数“值”时出错：参数意味着不同的行数：0、1”。
如果我用 selectInput() 替换我想通过 selectizeGroupUI() 指定的两个变量，它不会产生任何错误并且工作正常（在代码中注释），但显然我不能使用条件子设置，这是我需要的。
创建数据库的 SQL 代码：
CREATE DATABASE TestSelectizeGroupUI;
USE TestSelectizeGroupUI;
DROP TABLE IF EXISTS data;
CREATE TABLE data(
data_id INT NOT NULL AUTO_INCREMENT,
study_id INT,
covariate_id INT,
quantity DECIMAL,
standard_deviation VARCHAR(50),
sample_size VARCHAR(50),
/* Keys */
primary key(data_id)
);
DROP USER IF EXISTS 'admin'@localhost;
CREATE USER 'admin'@localhost IDENTIFIED BY 'adminPassword!';
GRANT ALL PRIVILEGES ON TestSelectizeGroupUI.* TO 'admin'@localhost;
FLUSH PRIVILEGES;
R Shiny App 使用 ShinyWidget 和 SelectizeGroupUI 函数并产生上述错误。如果有人成功修复它，我将不胜感激。代码归功于 Niels van der Velden，因为我已经根据 https://www.nielsvandervelden.com/post/sql_datatable/editable-datatables-in-r-shiny-using-sql/ 改编了大部分代码
library(shiny)
library(DT)
library(shinyWidgets)
library(readxl)
library(dplyr)
library(DBI) #to connect to MariaDB
library(stringdist)
library(tidyr)
library(pool)
library(shinyjs) #connects shiny to java scripts
library(uuid) #tools fo generating and handling of universally unique identifiers
Sys.setenv(TZ='CET')
Sys.setenv(ORA_SDTZ='CET')
labelMandatoryDat <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
appCSS <- ".mandatory_star { color: black; }"
#Connect to MariaDB that is stored locally
beeDB <- dbConnect(RMariaDB::MariaDB(), user="admin",password="adminPassword!",dbname="TestSelectizeGroupUI")
covariates_example <- data.frame(study_id=c(1,1,2),covariate_id=c(1,2,3))
#1. User Interface
ui <- fluidPage(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
fluidRow(column(width=2,align="right",strong("Data:",style = "font-size:19px;"),
actionButton("display_button_data", "Display table"),
actionButton("add_button_data", "Add", icon("plus")))
),
br(),
fluidRow(width="100%",
dataTableOutput("data_table", width = "100%")
),
)
#2. Server Function
server <- function(input, output, session) {
data <- reactive({
input$submit_data
input$submit_edit_data
input$delete_button_data
dbReadTable(beeDB, "data")
})
fieldsMandatoryDat <- c("quantity")
observe({
mandatoryFilledDat <-
vapply(fieldsMandatoryDat,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilledDat <- all(mandatoryFilledDat)
shinyjs::toggleState(id = "submit_data", condition = mandatoryFilledDat)
})
#Entry form data: Function for the entry form that will pop-up in a model dialog when the Add_data is clicked.
entry_form_data <- function(button_id){
showModal(
modalDialog(
div(id=("entry_form_data"),
tags$head(tags$style(".modal-dialog{ width:600px}")), #Modify the width of the dialog
tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible}"))),
fluidPage(
fluidRow(
splitLayout(
cellWidths = c("200px", "100px", "250px"),
cellArgs = list(),
selectizeGroupUI(
id = "my-filters",
inline = FALSE,
params = list(
study_id = list(inputId = "study_id", title = "study_id", placeholder = 'select'),
covariate_id = list(inputId = "covariate_id", title = "covariate_id", placeholder = 'select')
)
),
#selectInput("study_id", "study_id",choices=c(1:3)),
#selectInput("covariate_id", "covariate_id",choices=c(1:5)),
numericInput("quantity", labelMandatoryDat("quantity"),NA,min=0.01,max=100000)),
numericInput("standard_deviation", "standard_deviation",NA,min=0.01,max=100000),
numericInput("sample_size", "sample_size",NA,min=1,max=100000),
helpText(labelMandatoryDat(""), paste("Mandatory fields.")),
actionButton(button_id, "Submit")
),
easyClose = TRUE
)
)
)
)
}
#Add Data: Function to save the data into df format.
formData_data <- reactive({
formData_data <- data.frame(
study_id=input$study_id,
covariate_id=input$covariate_id,
quantity=input$quantity,
standard_deviation = input$standard_deviation,
sample_size=input$sample_size,
stringsAsFactors = FALSE)
return(formData_data)
})
res_mod <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = covariates_example,
vars = c("study_id", "covariate_id")
)
#Function to append data to the SQL table
appendData_data <- function(data_data){
dbWriteTable(beeDB,"data",data_data,append=T)
}
#When add_data button is clicked it will activate the entry_form with an action button called submit. Priority is added in order to make sure that no reactive values are updated until the event is finished.
observeEvent(input$add_button_data, priority = 20,{
entry_form_data("submit_data")
})
#When the submit button is clicked the formdata is appended to the SQL table, the values in the form are reset and the modal is removed.
observeEvent(input$submit_data, priority = 20,{
appendData_data(formData_data())
shinyjs::reset("entry_form_data")
removeModal()
})
#display output table: Render the DataTable.
output$data_table <- DT::renderDataTable({
if(input$display_button_data == 0) {return()}
else{
table <- data() #req(res_mod()) #%>% select(-study_id) #show all columns, also study_id
table <- datatable(table,
rownames = FALSE,
caption = tags$caption("Data Table"),
options = list(searching = TRUE, lengthChange = TRUE, pageLength = 5, lengthMenu = c(5,10,50,100), dom = '<"top">t<"bottom"fli><"clear">')
)
}
})
#to automatically disconnect from database after closing shinyApp
values <- reactiveValues(sessionId = NULL)
values$sessionId <- as.integer(runif(1, 1, 100000))
output$sessionId <- renderText(paste0("Session id: ", values$sessionId))
session$onSessionEnded(function() {
observe(cat(paste0("Ended: ", values$sessionId)))
})
}
#3. Run the APP
shinyApp(ui = ui, server = server)
【问题讨论】：
标签： mysql r shiny grouping selectize.js