search

plotly / plotly.R

An interactive graphing library for R
https://plotly-r.com
Other
2.55k stars 622 forks source link

Empty event payload for plotly_selected when using ggplotly on geom_tile #1820

Open holgerbrandl opened 4 years ago

holgerbrandl commented 4 years ago

In the example provided below, the heatmap is selectable on the x but the corresponding event payload is empty.

Expected: The selection should be part of the event payload. This works for other plots, e.g. see commented out histogram example in the provided code.

# Source https://rdrr.io/cran/plotly/src/inst/examples/shiny/event_data/app.R

library(plotly)
library(nycflights13)
library(shiny)
library(dplyr)
library(lubridate)

flights = flights %>% mutate(departure = make_datetime(year, month, day, hour, minute))

ui <- fluidPage(
radioButtons("plotType", "Plot Type:", choices = c("ggplotly", "plotly")),
plotlyOutput("plot"),
verbatimTextOutput("brushing"),
)

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

    output$plot <- renderPlotly({
        p <- if (identical(input$plotType, "ggplotly")) {
            ## works and gives correct results
            # ggplotly(ggplot(flights, aes(x = departure)) + geom_histogram())
            ## gives empty event data
            ggplotly(ggplot(head(flights, 10000), aes(x = departure, carrier, fill=arr_time)) + geom_tile())
        } else {
            plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nothing)
        }
        p %>%
            layout(dragmode = "select") %>%
            #  see https://webinars.cpsievert.me/20180220/#13
            event_register("plotly_selected")
    })

    observeEvent(event_data("plotly_selected"), {
        d <- event_data("plotly_selected")
      print("caught event from here as well")
      print(paste(str(d)))
    })

}

shinyApp(ui, server)
spflanagan commented 3 years ago

I'm having a similar issue (I think) with a plotly contour plot. I'm trying to display a contour plot and then reveal a table below it of just values within a brushed range, allowing the user to view additional metadata associated with that region.

I've tried to understand how to work with event_register() and event_data() by reading ch 17 of the plotly-r book, looking through the presentation on linking plotly graphs in shiny, and trying out suggestions from this post and this post without solving my issue.

In this minimal example, I'm trying to print the brushed output to see whether it works as well as the table. Any suggestions or help with this would be hugely appreciated!

library(shiny)
library(plotly)
library(shinydashboard)
library(rsconnect)
library(dplyr)
library(tidyr)

# simulate some data
dat<-data.frame(x=rnorm(100),
                y=rnorm(100),
                z=rnorm(100),
                metadata=sample(letters,100,replace=TRUE))

# Define UI for application 
ui <- dashboardPage(

    # Application title

    dashboardHeader(
        title="Testing contour + table brush",
        titleWidth=500
    ),
    dashboardSidebar(

        hr(),
        sidebarMenu(id="tabs",
                    menuItem("Plots", tabName="plot", icon=icon("line-chart"), selected=TRUE)
        ),
        hr(),
        conditionalPanel("input.tabs == 'plot'",
                         sliderInput("slider","placeholder", min=0, max=1, step=0.05, value=0.25,round=2),
                         width=250
        )

    ),
    dashboardBody(
        tabItems(
            tabItem(tabName="plot",
                    fluidRow(
                        column(8,
                               plotlyOutput('contours'))
                    ),
                    fluidRow(
                        column(8, verbatimTextOutput("brushing"))
                    ),
                    fluidRow(
                        column(8,
                               tableOutput('table'))
                    )
            )
        )
    )
)

# Define server logic required to create contour plot and table
server <- function(input, output) {

    # create the contour plot
    output$contours <- renderPlotly({

        # create contour plot
        fig1<-plot_ly(
            x = dat$x, 
            y = dat$y, 
            z = dat$z,
            customdata = dat$metadata,
            colorscale=list(seq(0,1,length.out = 9),
                            c('#ffffd9','#edf8b1','#c7e9b4','#7fcdbb','#41b6c4','#1d91c0','#225ea8','#253494','#081d58')),
            type = "contour",
            source="contourPlot"
        )
        # add axis labels
        x<-list(title="x")
        y<-list(title="y")
        fig1 <- fig1 %>% layout(xaxis=x,yaxis=y)

        # add label to contour names
        fig1 <- fig1 %>% colorbar(title = "z") %>%
            event_register('plotly_brushed')

    })

    # print brushing output

    observeEvent(event_data("plotly_brushed",source="contourPlot",priority="event"), {
        d <-  event_data('plotly_brushed',source="contourPlot",priority="event")
        print("caught event from here as well")
        print(paste(str(d)))
    })

    # create table from brushing
    output$table<-renderTable(event_data('plotly_brushed',source="contourPlot",priority="event"))

}

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

Session info:

R version 4.1.1 (2021-08-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C                           LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] tidyr_1.1.3          dplyr_1.0.7          rsconnect_0.8.24     shinydashboard_0.7.1 plotly_4.9.4.1       ggplot2_3.3.5        shiny_1.6.0         

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7        jquerylib_0.1.4   bslib_0.2.5.1     pillar_1.6.2      compiler_4.1.1    later_1.3.0       tools_4.1.1       digest_0.6.27     viridisLite_0.4.0 jsonlite_1.7.2    lifecycle_1.0.0  
[12] tibble_3.1.4      gtable_0.3.0      pkgconfig_2.0.3   rlang_0.4.11      crosstalk_1.1.1   yaml_2.2.1        fastmap_1.1.0     withr_2.4.2       httr_1.4.2        sass_0.4.0        generics_0.1.0   
[23] vctrs_0.3.8       htmlwidgets_1.5.3 grid_4.1.1        tidyselect_1.1.1  glue_1.4.2        data.table_1.14.0 R6_2.5.1          fansi_0.5.0       farver_2.1.0      purrr_0.3.4       magrittr_2.0.1   
[34] scales_1.1.1      promises_1.2.0.1  ellipsis_0.3.2    htmltools_0.5.2   mime_0.11         xtable_1.8-4      colorspace_2.0-2  httpuv_1.6.2      utf8_1.2.2        lazyeval_0.2.2    munsell_0.5.0    
[45] cachem_1.0.6      crayon_1.4.1