当多个用户使用 Rshiny 将数据保存在 postgresql 数据库中时出现问题（创建了许多唯一行的重复项）

Question

我需要一些关于如何在 RShiny 中正确发送查询到我的数据库的说明...

我已经构建了一个应用程序，任何人都可以在其中创建帐户，然后在将这些行保存到我的数据库之前在数据框中写入一些信息。

当使用单个用户测试我的应用程序时，该应用程序运行得非常好，但当多个用户同时向我的数据库发送数据时，它会显示一些问题。所有发送的信息在 postgresql 中都会重复 2 到 10 次...

例如，如果我添加对物种“A”的 5 个个体的独特观察，观察日期为 2 月 25 日，我将得到 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

这是我第一次构建与数据库交互的闪亮应用程序，我很确定我没有正确使用 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)

Answer 1

请在下面找到一个使用 library(RSQLite) 的可重现示例 - 只需切换回您的 postgres 连接/架构即可。

我认为这个问题与pool无关。我猜（如果没有您的数据库，我无法验证）您对 rbind 的调用是有问题的 - 因为如果之前使用了reactiveVal，它会发送多行。

此外，在这种情况下，创建跨会话响应式（此处为reactivePoll）来在会话之间共享数据库信息比让每个会话每秒查询数据库要高效得多。

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

多会话使用：

为了避免从数据库角度出现重复条目​​，请使用 表约束。您可以创建一个跨越表中所有 (ID) 相关列的主键。