我需要一些关于如何在 RShiny 中正确地将查询发送到我的数据库的说明...
我构建了一个应用程序，任何人都可以在其中创建一个帐户，然后在将这些行保存到我的数据库之前在数据框中写入一些信息。
该应用程序在单个用户测试时运行良好，但在多个用户同时向我的数据库发送数据时会出现一些问题。所有发送的信息在 postgresql 中重复 2 到 10 次...
例如，如果我在 2 月 25 日添加观察日期为“A”的 5 个个体的独特观察，我将在我的数据库中得到 3 行(有时最多可以重复 10 行)而不是一行。 (如下表所示):
ID species date number username latitude longitude
1 A 2022-02-25 5 Wanderzen 45.2 2.6
2 A 2022-02-25 5 Wanderzen 45.2 2.6
3 A 2022-02-25 5 Wanderzen 45.2 2.6
这是我第一次构建与数据库交互的 Shiny 应用程序，我很确定我没有正确使用 pool 包......
** 我该怎么做才能解决这个问题？我应该为每个查询打开和关闭连接吗？**
这是一个显示我的问题的粗略代码示例:
library(shiny)
library(leaflet)
library(pool)
library(DT)
library(shinycssloaders)
library(RPostgres)
library(shinyjs)
pool <- DBI::dbConnect(
drv = dbDriver("PostgreSQL"),
dbname = "my_database",
host = "99.99.999.999",
user = Sys.getenv("userid"),
password = Sys.getenv("pwd")
)
ui <- fluidPage(
fluidRow(column(width=10,
wellPanel(
leafletOutput(outputId = "map", height = 470) %>% withSpinner(color="#000000"),
wellPanel(useShinyjs(),
fluidRow(DT::dataTableOutput(outputId ="obs_user") %>% withSpinner(color="#000000"))
)))))
server <- function(input, output, session){
values <- reactiveVal(NULL)
observe({
invalidateLater(1000)
query <- "select species, date, number, username, latitude, longitude from rshiny.data"
ret <- dbGetQuery(pool, query)
values(ret)})
dataframe1 <- reactiveValues(species = character(), date= character(), number = integer(), username=character(), latitude=numeric(), longitude=numeric())
observeEvent(input$map_click, {
click <- input$map_click
showModal(modalDialog(title = "add a new observation",
selectInput("species", "Species", choices = ''),
dateInput("date", "Observation date:"),
numericInput("number", "Number:",1),
textInput("username", "Username:"),
textInput("latitude", "Latitude:",click$lat),
textInput("longitude", "Longitude:",click$lng),
actionButton(inputId = "save_BDD",label = "Send to the database", style = "width:250px",
easyClose = TRUE, footer = NULL )))})
observeEvent(input$map_click, {
shinyjs::disable("latitude")
shinyjs::disable("longitude")
})
observeEvent(input$save_BDD, {
dataframe1$dm <- isolate({
newLine <- data.frame(species=input$species,
date=input$date,
number = input$number,
username = input$username,
latitude = input$latitude,
longitude =input$longitude)
rbind(dataframe1 $dm,newLine)})})
observeEvent(input$save_BDD,{
dbWriteTable(pool, c("rshiny", "data"), dataframe1$dm, row.names=FALSE, append = T)
dbExecute(pool, "UPDATE rshiny.data SET geom = ST_SetSRID(ST_MakePoint(longitude, latitude), 4326);")})
output$map <- renderLeaflet({
leaflet(data=values()) %>%
addTiles(group = "OSM") %>%
addAwesomeMarkers(data = values(),
lng = ~as.numeric(longitude), lat = ~as.numeric(latitude)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Esri World Imagery") })
output$obs_user <- DT::renderDataTable({
datatable(values())})
}
shinyApp(ui, server)
最佳答案
请在下面找到一个使用 library(RSQLite) 的可重现示例 - 只需切换回您的 postgres 连接/架构即可。
我认为问题与pool 无关。我想(没有你的数据库我无法验证)你对 rbind 的调用是有问题的 - 因为如果之前使用过 reactiveVal 它会发送多行。
此外，在这种情况下，创建一个跨 session react (这里是reactivePoll)来在 session 之间共享数据库信息，而不是让每个 session 每隔一段时间查询数据库，效率会更高。第二。
library(shiny)
library(leaflet)
library(pool)
library(DT)
library(shinycssloaders)
library(RPostgres)
library(shinyjs)
library(RSQLite) # for MRE only
# pool <- DBI::dbConnect(
# drv = Postgres(),
# dbname = "my_database",
# host = "99.99.999.999",
# user = Sys.getenv("userid"),
# password = Sys.getenv("pwd")
# )
# local postgres test:
# pool <- DBI::dbConnect(
# drv = Postgres(),
# dbname = "test",
# host = "localhost",
# user = "postgres",
# password = "postgres"
# )
pool <- dbConnect(RSQLite::SQLite(), ":memory:")
# cross-session reactivePoll
RP <- reactivePoll(intervalMillis = 1000, session = NULL, checkFunc = function(){
if (dbIsValid(pool) && dbExistsTable(pool, "dbtable")) {
query <- "SELECT count(*) FROM dbtable;"
dbGetQuery(pool, query)[[1]]
} else {
0L
}
}, valueFunc = function(){
if (dbIsValid(pool) && dbExistsTable(pool, "dbtable")) {
query <- "SELECT species, date, number, username, latitude, longitude FROM dbtable;"
dbGetQuery(pool, query)
} else {
NULL
}
})
ui <- fluidPage(fluidRow(column(
width = 10,
wellPanel(
leafletOutput(outputId = "map", height = 470) %>% withSpinner(color = "#000000"),
wellPanel(useShinyjs(),
fluidRow(
DT::dataTableOutput(outputId = "obs_user") %>% withSpinner(color = "#000000")
))
)
)))
server <- function(input, output, session) {
observeEvent(input$map_click, {
click <- input$map_click
showModal(
modalDialog(
title = "add a new observation",
selectInput("species", "Species", choices = ''),
dateInput("date", "Observation date:"),
numericInput("number", "Number:", 1),
textInput("username", "Username:"),
textInput("latitude", "Latitude:", click$lat),
textInput("longitude", "Longitude:", click$lng),
actionButton(
inputId = "save_BDD",
label = "Send to the database",
style = "width:250px",
easyClose = TRUE,
footer = NULL
)
)
)
})
observeEvent(input$map_click, {
shinyjs::disable("latitude")
shinyjs::disable("longitude")
})
observeEvent(input$save_BDD, {
newLine <- data.frame(
species = input$species,
date = input$date,
number = input$number,
username = input$username,
latitude = input$latitude,
longitude = input$longitude
)
if (dbExistsTable(pool, "dbtable")) {
dbWriteTable(pool,
"dbtable",
newLine,
row.names = FALSE,
append = TRUE,
overwrite = FALSE)
} else {
dbWriteTable(pool,
"dbtable",
newLine,
row.names = FALSE,
append = FALSE,
overwrite = TRUE)
}
# dbExecute(pool, "UPDATE rshiny.data SET geom = ST_SetSRID(ST_MakePoint(longitude, latitude), 4326);")
removeModal(session)
})
output$map <- renderLeaflet({
if(!is.null(RP())){
leaflet(data = RP()) %>%
addTiles(group = "OSM") %>%
addAwesomeMarkers(
data = RP(),
lng = ~ as.numeric(longitude),
lat = ~ as.numeric(latitude)
) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Esri World Imagery")
} else {
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Esri World Imagery")
}
})
output$obs_user <- DT::renderDataTable({
req(RP())
datatable(RP())
})
}
shinyApp(ui, server, onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup\n")
dbDisconnect(pool)
# poolClose(pool)
})
})
多 session 使用:
为避免从数据库角度来看重复条目，请使用 table constraints .您可以创建一个跨越表的所有 (ID) 相关列的主键。
关于r - 当多个用户使用 Rshiny 在 postgresql 数据库中保存数据时出现问题(创建了唯一行的许多重复项)，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/71348264/