Search code examples
rpostgresqlshinyr-dbi

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

I need some clarification on how to properly send queries to my database within RShiny...

I have build-up an application in which anyone can create an account and then write some informations in a dataframe before saving those rows to my database.

The app works perfectly well when testing my it with a single user but shows some issues when several users send data to my database at the same time. All the informations sends are duplicated 2 to 10 times in postgresql...

For instance if I add an unique observation of 5 individuals of species "A" with an observation date on the 25th of february I will get 3 rows (sometimes it can be up to 10 duplicates) in my database instead of one. (like shown in the table below):

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

It's the first time I'm building a Shiny App interacting with a database and I'm pretty sure I'm not using the pool package properly...

** What have I to do to solve this issue ? Shall I open and close a connection for each query ?**

Here is a coarce code sample that shows my problem:

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

  • Below please find a reproducible example using library(RSQLite) - just switch back to your postgres connection / schema.

    I don't think the issue is pool related. I guess (I can't verify without your DB) your call to rbind is problematic - as it sends multiple lines if the reactiveVal was used before.

    Furthermore, in a case like this it is much more efficient to create a cross-session reactive (here reactivePoll) to share the DB information among sessions, instead of having each session query the DB every second.

    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 usage: result

    To avoid duplicated entries from the DB perspective please use table constraints. You could create a primary key spanning all (ID) relevant columns of the table.