Shiny R: Search, edit, and export within reactive dataframe using brushedPoints

shiny
,
1

Shiny R: Search, edit, and export within reactive dataframe using brushedPoints

I am new to Shiny and have hacked away at this problem and am very close to solution (at least I think I am), but need a bit of help to get me over the finish line.

I have provided an example input data frame (data1) and the desired result (result) below to show where I would like to end up.

My actual data set includes ~1000 samples with each sample having approximately 150 rows of x-y coordinate data that I need to plot, examine, add information to, and then extract for further analyses.

As of now, I have setup a Shiny App that allows me to use radio buttons to select specific samples using “site” and “sample” identifiers and then plot the selected data. I also included a download button for the modified data table.

The App uses the brushedPoints function to allow me to select portions of the plot and then display the selected points in two tables: i) a data table that is editable and ii) a second data table that shows the edits in the data table that will be exported. The second data table might not be necessary, but it shows me how/if the edits are being incorporated into the data table that will be exported.

Currently, when I highlight data points and type in the “move” or “stay” columns in the top table, the edits fail to show up in the bottom table or in the downloaded csv file.

I identified the area of the code that appears to be the problem, but am unsure of the solution.

All recommendations are welcome.

Thanks for your time...

rm(list=ls())

# Loads the two packages need to run the code below
library(DT)
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)

# data

site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')
stay <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')

sub <- data.frame(site, sample, x, y, move, stay)

# example result 

site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'yes', 'na', 'no', 'na', 'down', 'na', 'up', 'na', 'na')
stay <- c(1, 20, 'na', 'na', 50, 'na', 69, 'na', 'na', 77)

result <- data.frame(site, sample, x, y, move, stay)

#================================================================================================

ui <- fluidPage(
  
  sidebarPanel(
    
    downloadButton("download","Download"),
    
    radioButtons("site", "Site",
                 choices = unique(sub$site)),
    
    radioButtons("sample", "Sample",
                 choices = unique(sub$sample))),
  
  mainPanel(
    plotOutput("plot1", brush = "plot_brush"),
    
    DTOutput("plot_brushed_points"),
    
    verbatimTextOutput("acutal_data")
    
  )
)


server <- function(input, output, session) {

# Change second radio button options based on first radio button
  observeEvent(input$site,{
    Choices = unique(sub$sample[sub$site == input$site])
    updateRadioButtons(session, "sample", choices = Choices)
  })

# Make data set reactive values
  sub_react = reactiveValues(data = sub)

# Get data for plot
  reactive_data <- reactive({
    selected_sample = input$sample
    filter(sub_react$data, sample == selected_sample)
  })

# Make plot
  output$plot1 <- renderPlot({
    
    our_data <- reactive_data()
    
    ggplot(our_data, aes(x = x, y = y)) + 
      geom_line(aes(), color = 'black') +
      geom_point(aes(size = 5))+
      geom_point(shape = 1 ,size = 5, colour = "black") +
      xlim(0, 10) +
      ylim(0, 100)
    
  })
  
# Display rows of data highlighted in plot
  dat <- reactive({
    our_data <- reactive_data()
    brushedPoints(our_data, input$plot_brush, xvar = "x", yvar = "y", allRows = FALSE)
  })

# Render highlighted data in plot
  output$plot_brushed_points = renderDT(dat(), selection = 'none', editable = TRUE)

# Show actual data frame to check edits are correct
  output$acutal_data <- renderPrint({dat()})
  
# Transfer edits from top table to bottom table

  ##############################################
  ## I suspect this is where the problem lies ##
  ##############################################
  proxy = dataTableProxy('plot_brushed_points')
  
  observeEvent(input$plot_brushed_points_cell_edit, {
    info = input$plot_brushed_points_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    sub_react$data[i, j] <- isolate(coerceValue(v, sub_react$data[i, j]))
    replaceData(proxy, sub_react$data, resetPaging = FALSE)
  })

# Download modified data table as a csv file
  output$download <- downloadHandler(
    filename = function() {
      paste0("Modified_data.csv")
    },
    content = function(con) {
      write.csv(sub_react$data, con, row.names = FALSE, na = "")
    }
  )
}

shinyApp(ui, server)
2

your reprex represented a bit of a red herring at first, with the error I got when I ran it do with coerceValue error on unseen factor levels, so I first fixed that with

sub <- data.frame(site, sample, x, y, move, stay,stringsAsFactors = FALSE)

after that I felt that I needed to rename a lot of your objects and simplify down to get an unerstanding of what objects were what. Then I was able to diagnose a mismatch between the subset of rows you selectively edit, and where they live within the larger dataset from which they were subset. I believe what I'm left with is a fix.


# Loads the two packages need to run the code below
library(DT)
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)

# data

site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')
stay <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')

sub <- data.frame(site, sample, x, y, move, stay,stringsAsFactors = FALSE
                  ) %>% rownames_to_column(var="rowname")




ui <- fluidPage(
  
  sidebarPanel(
    
    radioButtons("site", "Site",
                 choices = unique(sub$site)),
    
    radioButtons("sample", "Sample",
                 choices = unique(sub$sample))),
  
  mainPanel(
    plotOutput("plot1", brush = "plot_brush"),
    
    DTOutput("dt_of_brushed_points"),
    
    verbatimTextOutput("actual_data_brushed"),
    verbatimTextOutput("actual_data_full")
    
  )
)


server <- function(input, output, session) {
  
  # Change second radio button options based on first radio button
  observeEvent(input$site,{
    Choices = unique(sub$sample[sub$site == input$site])
    updateRadioButtons(session, "sample", choices = Choices)
  })
  
  # Make data set reactive values
  sub_react = reactiveValues(data = sub)
  
  # Get data for plot
  plot_subset_df <- reactive({
    selected_sample = input$sample
    filter(sub_react$data, sample == selected_sample)
  })
  
  # Make plot
  output$plot1 <- renderPlot({
    ggplot(plot_subset_df(), aes(x = x, y = y)) + 
      geom_line(aes(), color = 'black') +
      geom_point(aes(size = 5))+
      geom_point(shape = 1 ,size = 5, colour = "black") +
      xlim(0, 10) +
      ylim(0, 100)
    
  })
  
  # Display rows of data highlighted in plot
  brushed_df <- reactive({
 
    brushedPoints(plot_subset_df(), input$plot_brush, xvar = "x", yvar = "y", allRows = FALSE)
  })
  
  # Render highlighted data in plot
  output$dt_of_brushed_points = renderDT(brushed_df(), selection = 'none', editable = TRUE)
  
  # Show actual data frame to check edits are correct
  output$actual_data_brushed <- renderPrint({brushed_df()})
  output$actual_data_full <- renderPrint({sub_react$data})
  # Transfer edits from top table to bottom table
  
  proxy = dataTableProxy('dt_of_brushed_points')
  
  observeEvent(input$dt_of_brushed_points_cell_edit, {
    info = input$dt_of_brushed_points_cell_edit
    str(info)
    #rows and columns of your brushed subset DO NOT MATCH the whole sub_react_data 

    i = info$row
    j = info$col
    v = info$value
    row_to_change <-  brushed_df()[i,"rowname"]
    sub_react$data[row_to_change, j] <- isolate(coerceValue(v, sub_react$data[row_to_change, j]))
    replaceData(proxy, sub_react$data, resetPaging = FALSE)
  })
   
}

shinyApp(ui, server)
3

You are a legend!

I should have used more descriptive object names in the original code, apologies for wasting your time.

I had to make a few small modifications to the code to get it working. See below.

Thanks again!

rm(list=ls())

# Loads the two packages need to run the code below
library(DT)
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)

# data

site <- c('a','a','a','a','a','b','b','b','b','b')
sample <- c("1a", "1a", "1a", "1a", "1a","2b", "2b", "2b","2b", "2b")
x <- c(1, 2, 3, 4, 5, 6, 7, 8 , 9, 10)
y <- c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
move <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')
stay <- c('na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na', 'na')

# For some reason the line of code %>% rownames_to_column(var="rowname") was not working....so I modified with the following
sub <- data.frame(site, sample, x, y, move, stay,stringsAsFactors = FALSE) %>%
  mutate(., rownames = seq(n())) %>%
  select(rownames, everything())

ui <- fluidPage(
  
  sidebarPanel(
    
    radioButtons("site", "Site",
                 choices = unique(sub$site)),
    
    radioButtons("sample", "Sample",
                 choices = unique(sub$sample))),
  
  mainPanel(
    plotOutput("plot1", brush = "plot_brush"),
    
    DTOutput("dt_of_brushed_points"),
    
    verbatimTextOutput("actual_data_brushed"),
    
    verbatimTextOutput("actual_data_full")
    
  )
)


server <- function(input, output, session) {
  
  # Change second radio button options based on first radio button
  observeEvent(input$site,{
    Choices = unique(sub$sample[sub$site == input$site])
    updateRadioButtons(session, "sample", choices = Choices)
  })
  
  # Make data set reactive values
  sub_react = reactiveValues(data = sub)
  
  # Get data for plot
  plot_subset_df <- reactive({
    selected_sample = input$sample
    filter(sub_react$data, sample == selected_sample)
  })
  
  # Make plot
  output$plot1 <- renderPlot({
    ggplot(plot_subset_df(), aes(x = x, y = y)) + 
      geom_line(aes(), color = 'black') +
      geom_point(aes(size = 5))+
      geom_point(shape = 1 ,size = 5, colour = "black") +
      xlim(0, 10) +
      ylim(0, 100)
    
  })
  
  # Display rows of data highlighted in plot
  brushed_df <- reactive({
    
    brushedPoints(plot_subset_df(), input$plot_brush, xvar = "x", yvar = "y", allRows = FALSE)
  })
  
  # Render highlighted data in plot
  output$dt_of_brushed_points = renderDT(brushed_df(), selection = 'none', editable = TRUE)
  
  # Show actual data frame to check edits are correct
  output$actual_data_brushed <- renderPrint({brushed_df()})
  output$actual_data_full <- renderPrint({sub_react$data})
  # Transfer edits from top table to bottom table
  
  proxy = dataTableProxy('dt_of_brushed_points')
  
  observeEvent(input$dt_of_brushed_points_cell_edit, {
    info = input$dt_of_brushed_points_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    
    # changed brushed_df()[i, "rownames"] by removing "rownames" and referencing column 1
    row_to_change <-  brushed_df()[i, 1]
    sub_react$data[row_to_change, j] <- isolate(coerceValue(v, sub_react$data[row_to_change, j]))
    replaceData(proxy, sub_react$data, resetPaging = FALSE)
  })
  
}

shinyApp(ui, server)
1 Like
4

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.