如何解决使用selectizeGroupUI创建数据输入表单以将数据输入数据表SQL
我正在创建一个ShinyApp，将数据输入到数据库（SQL）的表中。数据输入表单应允许选择两个变量，而第二个变量则取决于第一个变量（有关两个变量的关系的信息存储在另一个数据表中）。如果我使用selectizeGroupUI（），则会产生以下错误：'在选择函数'dbWriteTable'的方法时，在评估参数'value'时出错：参数暗示行数不同：0，1'。
如果我将要通过selectizeGroupUI（）用selectInput（）指定的两个变量替换，它不会产生任何错误并且可以正常工作（在代码中进行了注释），但是显然我不能使用条件子设置，这是我需要的。
创建数据库的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函数并产生上述错误。如果有人成功修复它，我将不胜感激。由于我根据https://www.nielsvandervelden.com/post/sql_datatable/editable-datatables-in-r-shiny-using-sql/
修改了大部分代码，因此代码的贡献归于Niels van der Veldenlibrary(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",max=100000),numericInput("sample_size","sample_size",min=1,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,{
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,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)
解决方法
我可以自己解决它，据我所知，通过selectizeGroupUI输入到输入表单中的输入不能由'input $ ....'调用，而必须通过'res_mod（）$。来调用。 。'，这是我用来存储所选输入的函数的名称。因此，我必须将引用selectselectGroupUI输入的前两行的名称为“ formData_data”的反应式从input $ ...更改为res_mod（）$。
library(shiny)
library(DT)
library(shinyWidgets)
library(readxl)
library(dplyr)
library(DBI) #to connect to MariaDB
library(stringdist)
library(tidyr)
library(pool) #Enables the creation of object pools,which make it less computationally expensive to fetch a new object. Currently the only supported pooled objects are 'DBI' connections.
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 and Edit_data buttons are pressed.
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}"))),#Necessary to show the input options
fluidPage(
fluidRow(
splitLayout(
cellWidths = c("200px","100px","250px"),cellArgs = list(),selectizeGroupUI(
id = "my-filters",params = list(
study_id = list(inputId = "study_id",label="study_id",title = "study_id",placeholder = 'select'),covariate_id = list(inputId = "covariate_id",label="covariate_id",title = "covariate_id",placeholder = 'select')
)
),# selectizeInput("study_id","study_id",choices=covariates_example$study_id),#selectizeInput("covariate_id","covariate_id",choices=covariates_example$covariate_id),numericInput("quantity",labelMandatoryDat("quantity"),NA,min=0.01,max=100000)),numericInput("standard_deviation","standard_deviation",max=100000),numericInput("sample_size","sample_size",min=1,helpText(labelMandatoryDat(""),paste("Mandatory fields.")),actionButton(button_id,"Submit")
),easyClose = TRUE
)
)
)
)
}
#Add Data: Function to save the data into df format. for the data data
formData_data <- reactive({
formData_data <- data.frame(
study_id=res_mod()$study_id,covariate_id=res_mod()$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_form2 with an action button called submit. Priority is added in order to make sure that no reactive values are updated untill 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,{
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()
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,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)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。