Scatterplot Exclusion in Shiny Module

[Trevor Nederlof]

I am having issues with recreating the example at the link below in regards to having a scatter where points can be excluded. I am trying to do this inside a Shiny module. Below is the reproducible example...

I keep getting the following message: 

"Error in $<-.data.frame: replacement has 0 rows, data has 32" 

66: $<-.data.frame 

65: $<- 

64: brushedPoints 

63: observeEventHandler [/app.R#64] 

1: shiny::runApp

library(ggplot2)
library(scales)
library(shiny)
library(shinydashboard)


###### SCATTER GRAPHS ###############
scatter_graphUI <- function(id, tab_panel_name, height = "500px") {
  ns <- NS(id)

  tabPanel(tab_panel_name,
           plotOutput(ns("scatter_1"), height = height, click = ns("plot1_click"), brush = 
                        brushOpts(id = ns("plot1_brush"))),
           actionButton(ns("exclude_toggle"), "Toggle points"),
           actionButton(ns("exclude_reset"), "Reset")
  )
}

scatter_graph <- function(input, output, session, scatter_data, col_select) {

  vals <- reactiveValues()
  data_df <- reactive({
    scatter_df <- scatter_data()
    main_df <- scatter_df[,col_select]
    vals$keeprows = rep(TRUE, nrow(main_df))
    main_df
  })

  output$scatter_1 <- renderPlot({

    graph_df <- data_df()
    # Plot the kept and excluded points as two separate data sets
    keep    <- graph_df[vals$keeprows, , drop = FALSE]
    exclude <- graph_df[vals$keeprows, , drop = FALSE]

    final_df <- keep
    title = paste(colnames(final_df)[1], "vs", colnames(final_df)[2])
    axis_text = 12
    title_text = 16

    # create a generic graphing final_df
    colnames(final_df) <- c("xaxis","yaxis")
    colnames(exclude) <- c("xaxis","yaxis")

    # setup the graph
    gg <- ggplot(final_df, aes(x = xaxis, y = yaxis)) + geom_point()
    gg <- gg + geom_point(data = exclude, fill = NA, color = "black", alpha = 0.25)
    gg <- gg + stat_smooth(method = "lm", formula = y ~ poly(x, 2), size = 1)
    gg <- gg + theme_bw()
    gg
  })


  # Toggle points that are clicked
  observeEvent(input$plot1_click, {
    main_df <- data_df()
    res <- nearPoints(main_df, input$plot1_click, allRows = TRUE)
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  # Toggle points that are brushed, when button is clicked
  observeEvent(input$exclude_toggle, {
    main_df <- data_df()
    res <- brushedPoints(main_df, input$plot1_brush, allRows = TRUE)
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  # Reset all points
  observeEvent(input$exclude_reset, {
    main_df <- data_df()
    vals$keeprows <- rep(TRUE, nrow(main_df))
  })

}
########################################



header <- dashboardHeader(
  title = 'Test Dashboard'
)
body <- dashboardBody(
  tabItems(
    tabItem(tabName = "scatter_eval",
            tabBox(
              title = "Scatter",
              selected = "Selected",
              height = "600px", side = "right",
              scatter_graphUI("selected_scatter", "Selected")
            )
    )
  )
)

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Scatter Evaluation", icon = icon("th"), tabName = "scatter_eval")
  )
)

ui <- dashboardPage(skin = "blue",
                    header,
                    sidebar,
                    body
)


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

  callModule(scatter_graph, id ="selected_scatter", scatter_data = reactive(mtcars), 
             col_select = c(1,2))

}

shinyApp(ui = ui, server = server)

[Dean Attali]

It doesn't seem to be caused by the fact that it's inside a module.  I don't know much about brushing, but by simple debugging (put a `browser()` statement just before the failure, and stepped into the `brushedPoints()` function), I was able to see that there's some mismatch with the variable names. By commenting out the two lines that assign colnames and changing the plotting function to use `aes(x = mpg, y = cyl)`, it was fixed

[Trevor Nederlof]

Ah thank you Dean, I wasnt aware of the browser() way of debugging, very useful.

I was able to make this work now by ensuring the column names are all the same in my observeEvent statements (that seemed to be throwing the error since the data didnt match what was in the original graph.