Sascha
Sascha

Reputation: 249

How to save changes in a subset of data in a Shiny app with editable DataTable?

(Aware of this and this post)

I'm working on a Shiny app where I need to use a DT::datatable to display and edit a subset of data, but I’m struggling with saving those changes. Specifically, I have a table that allows users to edit certain fields, and I want to save these edits to the original data (a shapefile).

Here is what I am trying to do:

I think the problem is the combination of filtered_data as filter of shapefile_clean and selected_street_table as reactive of selected_row. But I need those for the map to work (zooming to the specific street etc.)

Here's the relevant part of my code:

library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(sf)

# Simulate loading shapefile data
shapefile_clean <- data.frame(
  name = c("Street 1", "Street 2", "Street 3"),
  id = 1:3,
  Status = c("Ungeprüft", "Ungeprüft", "Ungeprüft"),
  Shape_Leng = c(1000, 2000, 3000),
  OSM_WAY_ID = c(101, 102, 103),
  fclass = c("residential", "secondary", "primary"),
  Stadtbezir = c("District 1", "District 2", "District 1"),
  geometry = c(NA, NA, NA)  # Placeholder for geometry
)

# Define UI
ui <- fluidPage(
  titlePanel("Example"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("stb", "Select District:", 
                  choices = unique(shapefile_clean$Stadtbezir),
                  selected = unique(shapefile_clean$Stadtbezir)[1]),
      
      DTOutput("data_table")  # Table with street names
    ),
    
    mainPanel(
      wellPanel(
        h4("Interactive leaflet map here as well, removed for simplicity")  # Placeholder text for the map
      ),
      
      DTOutput("selected_street_table")  # Table with selected street details
    )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  # Reactive expression to filter data based on selected Stadtbezir
  filtered_data <- reactive({
    shapefile_clean %>% filter(Stadtbezir == input$stb)
  })
  
  # Render DataTable with unique street names (no duplicates)
  output$data_table <- renderDT({
    df <- filtered_data() %>%
      distinct(name, .keep_all = TRUE)  # Keeps only the first occurrence of each unique street name
    
    df %>%
      select(name, id, Status) %>%
      datatable(selection = 'single', options = list(pageLength = 15))
  })
  
  # Define a reactive value for the selected row
  selected_row <- reactive({
    req(input$data_table_rows_selected)
    filtered_data()[input$data_table_rows_selected, ]
  })
  
  # Render the additional table with more details for the selected street, and make "Status" editable
  output$selected_street_table <- renderDT({
    req(selected_row())
    
    selected_row() %>%
      select( Shape_Leng, OSM_WAY_ID, fclass,  Status) %>%
      datatable(editable = list(target = 'cell', disable = list(columns = c(0:3))))  
  })
}

# Run the application
shinyApp(ui = ui, server = server)

Upvotes: 3

Views: 55

Answers (1)

Tim G
Tim G

Reputation: 4147

You can define your shapefile_clean and selected_row in a reactiveValues like:

rv <- reactiveValues(
    data = shapefile_clean,
    selected_row = NULL
  )

Instead of selected_row and shapefile_clean we can then reference rv.

Code

library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(sf)

# Simulate loading shapefile data
shapefile_clean <- data.frame(
  name = c("Street 1", "Street 2", "Street 3"),
  id = 1:3,
  Status = c("Ungeprüft", "Ungeprüft", "Ungeprüft"),
  Shape_Leng = c(1000, 2000, 3000),
  OSM_WAY_ID = c(101, 102, 103),
  fclass = c("residential", "secondary", "primary"),
  Stadtbezir = c("District 1", "District 2", "District 1"),
  geometry = c(NA, NA, NA)  # Placeholder for geometry
)

# Define UI
ui <- fluidPage(
  titlePanel("Street Management System"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("stb", "Select District:", 
                  choices = unique(shapefile_clean$Stadtbezir),
                  selected = unique(shapefile_clean$Stadtbezir)[1]),
      
      DTOutput("data_table")  # Table with street names
    ),
    
    mainPanel(
      wellPanel(
        h4("Interactive leaflet map here as well, removed for simplicity")
      ),
      
      DTOutput("selected_street_table")  # Table with selected street details
    )
  )
)

# Define server logic
server <- function(input, output, session) {
  # Create reactive values to store the data
  rv <- reactiveValues(
    data = shapefile_clean,
    selected_row = NULL
  )
  
  # Reactive expression to filter data based on selected Stadtbezir
  filtered_data <- reactive({
    rv$data %>% filter(Stadtbezir == input$stb)
  })
  
  # Render main DataTable (not editable)
  output$data_table <- renderDT({
    df <- filtered_data() %>%
      distinct(name, .keep_all = TRUE)
    
    datatable(
      df %>% select(name, id, Status),
      selection = 'single',
      options = list(pageLength = 15)
    )
  })
  
  # Store selected row
  observeEvent(input$data_table_rows_selected, {
    rv$selected_row <- input$data_table_rows_selected
  })
  
  # Render detailed table for selected street (with editable Status)
  output$selected_street_table <- renderDT({
    req(rv$selected_row)
    
    selected_data <- filtered_data()[rv$selected_row, ] %>%
      select(Shape_Leng, OSM_WAY_ID, fclass, Status)
    
    datatable(selected_data,
              selection = 'single',
              editable = list(target = "cell", disable = list(columns = c(1, 2, 3))),  # Only Status column is editable
              options = list(pageLength = 15))
  })
  
  # Handle cell edits for selected_street_table
  observeEvent(input$selected_street_table_cell_edit, {
    info <- input$selected_street_table_cell_edit
    new_value <- info$value
    
    # Get the ID of the edited row from the filtered data
    edited_id <- filtered_data()[rv$selected_row, "id"]
    
    # Update the main dataset
    rv$data <- rv$data %>%
      mutate(Status = ifelse(id == edited_id, new_value, Status))
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

out


Save into shapefile

If you want, you can add a button and make the current rv$data saveable:

# In UI
actionButton("save_changes", "Save Changes")

# In Server
observeEvent(input$save_changes, {
  # Save rv$data back to shapefile
  st_write(rv$data, "path_to_your_shapefile.shp", append=FALSE)
})

Upvotes: 1

Related Questions