Brushing issue with facet_grid when scales="free",space="free"

[jiayi9]

In R Shiny, when we brush points in ggplot, there is something wrong with the facet_grid function when scales="free",space="free".

For example, the following code works fine.

    D = data.frame(x1 = c("X","X","X","Y","Y","Y"),
               x2 = c("a","a","b","c","c","c"),
               y = rnorm(6)
               )

    library(shiny)
    library(ggplot2)
    server <- function(input, session, output) {
      vals <- reactiveValues( keeprows = FALSE)

      observeEvent(input$brush_1,{
        Res=brushedPoints(D,input$brush_1,allRows = TRUE)
        vals$keeprows = Res$selected_
      })

      output$table1 = renderPrint({
        brushedPoints(D,input$brush_1,allRows = TRUE)
      })

      output$x = renderPrint({
        vals$keeprows
      })


      output$plot_1 = renderPlot({
        set.seed(123)

        D$selected = vals$keeprows

        ggplot(D,aes(x=x1,y=y)) + geom_boxplot(outlier.shape = NA) +
          facet_grid(.~x2) +
          geom_jitter(aes(color=selected,size=selected),width=0.2)+
          scale_color_manual(values = c("black","red"),guide=FALSE)
      })
    }

    ui <- fluidPage(
      plotOutput("plot_1",brush = brushOpts("brush_1",resetOnNew = FALSE)),
      verbatimTextOutput("table1"),
      verbatimTextOutput("x")
    )

    shinyApp(ui = ui, server = server)

But when we set scales="free",space="free", the selection goes wrong.

    D = data.frame(x1 = c("X","X","X","Y","Y","Y"),
               x2 = c("a","a","b","c","c","c"),
               y = rnorm(6)
               )
    library(shiny)
    library(ggplot2)


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


      vals <- reactiveValues( keeprows = FALSE)

      observeEvent(input$brush_1,{
        Res=brushedPoints(D,input$brush_1,allRows = TRUE)
        vals$keeprows = Res$selected_
      })


      output$table1 = renderPrint({
        brushedPoints(D,input$brush_1,allRows = TRUE)
      })



      output$x = renderPrint({
        vals$keeprows
      })


      output$plot_1 = renderPlot({
        set.seed(123)

        D$selected = vals$keeprows



        ggplot(D,aes(x=x1,y=y)) + geom_boxplot(outlier.shape = NA) +
          facet_grid(.~x2,scales="free",space="free") +
          geom_jitter(aes(color=selected,size=selected),width=0.2)+
          scale_color_manual(values = c("black","red"),guide=FALSE)
      })
    }

    ui <- fluidPage(

      plotOutput("plot_1",brush = brushOpts("brush_1",resetOnNew = FALSE)),
      verbatimTextOutput("table1"),
      verbatimTextOutput("x")

    )

    shinyApp(ui = ui, server = server)

How can we solve this issue?
http://stackoverflow.com/questions/40150136/r-shiny-brush-facet-grid-with-scales-free-space-free

[smouksassi]

I have the same issue.
this is code from the shiny examples slightly modified.
try to brush the left most facet at 2.49, 3.47 you will see nothing is returned and that is because the brush is registered as if it happened at the first wt2 level 1.51,2.49 where there is no data.

screenshot 1:

now uncheck the checkbox the brushed region is shown at the first level where there is no data:

require(shiny)
require(ggplot2)
mtcars$wt2 <- cut(mtcars$wt,4)
mtcars$mpg2 <- cut(mtcars$mpg,4)


ui <- basicPage(
  plotOutput("plot1",
             click = "plot_click",
             dblclick = "plot_dblclick",
             hover = "plot_hover",
             brush = "plot_brush"
  ),
  verbatimTextOutput("info"),
  verbatimTextOutput("info2")

)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars, aes(wt2,mpg))+
      geom_point()+
      facet_grid(~mpg2,scales="free_x")
  })

  #

  output$info <- renderText({
    xy_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
    }
    xy_range_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1), 
             " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
    }

    paste0(
      "click: ", xy_str(input$plot_click),
      "dblclick: ", xy_str(input$plot_dblclick),
      "hover: ", xy_str(input$plot_hover),
      "brush: ", xy_range_str(input$plot_brush)
    )
  })
  output$info2 <- renderPrint({
    brushedPoints(mtcars, input$plot_brush)
  })
}

shinyApp(ui, server)

Using
[1] ggplot2_2.2.0 shiny_0.14.2.9000

[wch]

@smouksassi I don't see a checkbox in your example.

The root cause is the way that ggplot converts the categorical/discrete x scales (in both of your examples) to numeric values. We're able to get the numeric x value, where each "tick" on the x axis is 1, 2, 3. etc., but then we have the problem of translating those values back to the categorical values. I'm not 100% sure offhand, but I don't think that the ggplot object has a straightforward way to get the mapping between numeric x value and categorical value for individual panels.

If this is very important, your best course of action for the time being may be to do the inverse mapping manually. Since you know which horizontal faceting value you have (coordinfo$mapping$panelvar1 or 2, and coordinfo$panelvar1 or 2), you can figure out for your data set which values appear in that facet, and then figure out how to map the numeric values (1, 2, 3, etc) to the appropriate categorical values, for that facet.

[smouksassi]

Hi Winston,
Thank you for taking the time to respond to this issue. I might not have pasted to latest code here is below with the check box. Sorry about that pasted now below.
I will think about what is the best way to program Nearpoints/ Brushed points for categorical ggplot axes with free scales.
Bests,
Samer

require(shiny)
require(ggplot2)
mtcars$wt2 <- cut(mtcars$wt,4)
mtcars$mpg2 <- cut(mtcars$mpg,4)


ui <- basicPage(
  plotOutput("plot1",
             click = "plot_click",
             dblclick = "plot_dblclick",
             hover = "plot_hover",
             brush = "plot_brush"
  ),
  checkboxInput("freex","Free x Scales",value=TRUE),
  verbatimTextOutput("info"),
  verbatimTextOutput("info2")

)

server <- function(input, output) {
  output$plot1 <- renderPlot({
  p<-   ggplot(mtcars, aes(wt2,mpg))+
      geom_point()+
    facet_grid(~mpg2)

  if(input$freex)
    p<-  p+ facet_grid(~mpg2,scales="free_x")
  p
      })

  #

  output$info <- renderText({
    xy_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
    }
    xy_range_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1), 
             " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
    }

    paste0(
      "click: ", xy_str(input$plot_click),
      "dblclick: ", xy_str(input$plot_dblclick),
      "hover: ", xy_str(input$plot_hover),
      "brush: ", xy_range_str(input$plot_brush)
    )
  })
  output$info2 <- renderPrint({
    brushedPoints(mtcars, input$plot_brush)
  })
}

shinyApp(ui, server)

[tomsing1]

I ran into this problem today and implemented the solution Winston (@wch) outlined above. (At least I think that's what he had in mind.)

Perhaps it's useful to others, so here is my workaround for the example provided by Samer (@smouksassi) above. (I just added a few lines within the call to renderPrint.)

I used dplyr's filter_ command to subset the data.frame, but there are obviously other paths to apply the same rules.

require(shiny)
require(ggplot2)
require(dplyr)

mtcars$wt2 <- cut(mtcars$wt,4)
mtcars$mpg2 <- cut(mtcars$mpg,4)

ui <- basicPage(
  plotOutput("plot1",
             click = "plot_click",
             dblclick = "plot_dblclick",
             hover = "plot_hover",
             brush = "plot_brush"
  ),
  verbatimTextOutput("info"),
  verbatimTextOutput("info2")
  
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars, aes(wt2,mpg))+
      geom_jitter(width = 0.1) +  # a few plots overlap, so let's jitter a bit
      facet_grid(~mpg2,scales="free_x")
  })
  
  output$info <- renderText({
    xy_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
    }
    xy_range_str <- function(e) {
      if(is.null(e)) return("NULL\n")
      paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1), 
             " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
    }
    
    paste0(
      "click: ", xy_str(input$plot_click),
      "dblclick: ", xy_str(input$plot_dblclick),
      "hover: ", xy_str(input$plot_hover),
      "brush: ", xy_range_str(input$plot_brush)
    )
  })
  
  output$info2 <- renderPrint({
    req(input$plot_brush)  # only execute when points are brushed
    
    ##--- identify brushed subset of the mtcars data.frame without brushedPoints
    
    # I use shorter variable names for better readability
    facet.var <- input$plot_brush$mapping$panelvar1  # column used for faceting
    x.axis.var <- input$plot_brush$mapping$x  # column used for x-axis
    y.axis.var <- input$plot_brush$mapping$y  # column used fo y-axis
    facet.value <- input$plot_brush$panelvar1  # level of the brushed facet
    
    # First, subset the data.frame to those rows that match the brushed facet level
    mtcars <- dplyr::filter_(
        mtcars,
        sprintf("%s == '%s'", facet.var, facet.value))
    
    # Next, drop levels not used in the current facet
    mtcars <- droplevels(mtcars)
    
    # Finally, within this facet, identify points within the brushed ranges
    mtcars %>% 
      dplyr::filter(
        # interpret the factor levels as integers, to match how ggplot2
        # places them on the axes. The 'droplevels' call above ensures that
        # only levels that are present in the current facet are matched
        as.integer(mtcars[[x.axis.var]]) < input$plot_brush$xmax,
        as.integer(mtcars[[x.axis.var]]) > input$plot_brush$xmin,
        mtcars[[y.axis.var]] < input$plot_brush$ymax,
        mtcars[[y.axis.var]] > input$plot_brush$ymin
      )
  })
}

shinyApp(ui, server)

[alandipert]

It's not obvious to me how we could make this "just work" from Shiny, since the mapping operation outlined by @wch seems to require information about the ggplot object that we can't infer automatically.

I'll consult with the team and either outline a strategy to fix or close the issue, since workarounds have been provided.

[smouksassi]

this still does not work if we have the free scales with @tomsing1 code
let me know if you need a screenshot I added back the free x scale check box to do the test

[smouksassi]

thank you finally this is solved one small thing is that we get this warning to console :

Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.

[cpsievert]

@smouksassi if you could a produce a MRE that would be much appreciated!

[smouksassi]

hi Carson,
it is the same as above every time I click unclick the free x scales I get this line

[smouksassi]

might be related to jeroen/jsonlite#76 and I found this unanswered question
https://stackoverflow.com/questions/49534610/input-to-asjsonkeep-vec-names-true-is-a-named-vector-in-a-future-version-of-j?rq=1

[kevinrue]

Hi,
Here is a related MRE : iSEE/iSEE#325 (comment)
geom_tile instead of facet_grid, but the brushing issue is the same.
Any help would be appreciated!

[cpsievert]

@kevinrue that looks like a different issue, could you please file a new issue with a more precise description of the problem?

[kevinrue]

Will do, thanks for the reply!