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

Question

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

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

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

例如，如果我在 2 月 25 日添加观察日期为 2 月 25 日的物种“A”的 5 个个体的独特观察，我将在我的数据库中得到 3 行（有时最多可以重复 10 行）而不是一。（如下图 table 所示）：

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 它会发送多行。

此外，在这种情况下，创建一个 cross-session 反应式（这里是 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)
  })
})

Multi-session用法：

为避免从数据库角度看出现重复条目，请使用 table constraints。您可以创建一个跨越 table.

的所有 (ID) 相关列的主键

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

Issue when several users are saving data in postgresql database with Rshiny (many duplicates of an unique row are created)

r

postgresql

shiny

r-dbi