Table not loading on click event in R shiny

Question

I am plotting countries on map using plotly and r shiny. I would like subset of data containing rows about the country to appear in the form of data table on clicking on country on a map. But I am unable to implement it. I get the table but there is not data displayed in the table. Any help would be appreciated!

Mapbox_Token= 'Mapbox token'

library(plotly)
library("readxl")
library(dplyr)
library(readxl)
library(writexl)
library(shiny)
library(htmlwidgets)


data_1<- read.csv(".file.csv")
print(data_1)
library(formattable)

Sys.setenv("MAPBOX_TOKEN" = Mapbox_Token) # for Orca

ui <- fluidPage(
         
 plotlyOutput(outputId = "Plot"),
 DT::dataTableOutput('click')

)

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

 output$Plot <- renderPlotly({
   df=read.csv("file2.csv")
   render_value(data_1)
   fig <- df%>% plot_mapbox(lat = ~lat, lon = ~lng,split = ~Country, 
size=0, type= 'scattermapbox',mode='markers',hoverinfo="none",showlegend=F,source='subset'
) 
fig <- fig %>% layout(title = 'No Of Companies',font= 
list(color='white'),plot_bgcolor = '#191A1A', paper_bgcolor = 
'#191A1A',mapbox = list(style = 'dark'),legend = list(orientation ='v',font = list(size = 6)),margin = list(l = 25, r = 25,b = 75, t = 25,pad = 
2))
fig<-fig %>% add_annotations(text ='Map shows number of 
companies by country. The size of the circles correspond to 
the number of 
companies.',x=0.5,y=-0.2,showarrow=FALSE,font=list(color='red'))
fig<- fig %>% add_markers(text = ~paste(paste('Country:',Country), 
paste("Number of Companies:",Name ), paste("Dataset:", Url),sep = " 
<br />"), size=~Name, hoverinfo = "text",marker=list(sizeref=0.1, 
sizemode="area"),showlegend=T)%>% 
onRender(fig, "function(el) {el.on('plotly_click', function(d) {var 
url = d.points[0].customdata;window.open(url);});}")

fig <- fig %>% config(mapboxAccessToken = Sys.getenv("MAPBOX_TOKEN"))

  })

  render_value=function(df){
    output$click <- renderDataTable({
      s <- event_data("plotly_click",source = "subset")
      print(s$y)
      return(DT::datatable(data_1[data_1$Country==s$y,])) 

    })
  }
 }
 shinyApp(ui,server)

Answer 1

I agree with Limey that it is difficult to see through your example and it is impossible to reproduce it. Also, your question could be a duplicate of this question.

However, I have often stumbled upon the - let's say expandable - documentation of R plotly maps. Therefore I created a complete MWE:

library(shiny)
library(plotly)
library(rjson)
library(DT)


ui <- fluidPage(

    # Application title
    titlePanel("Customdata for plotly maps"),

    # Sidebar 
    sidebarLayout(
        sidebarPanel(
            # see ?event_data for all choices
            radioButtons("event", "plotly's event", 
                         choiceNames = c("plotly_hover", "plotly_unhover", "plotly_click", "plotly_doubleclick",
                                         "plotly_selected", "plotly_selecting"), 
                         choiceValues = c("plotly_hover", "plotly_unhover", "plotly_click", "plotly_doubleclick",
                                          "plotly_selected", "plotly_selecting"))
        ),

        # Show map and table
        mainPanel(
           plotlyOutput("map"),
           DTOutput('tbl')
        )
    )
)

# Define server logic required 
server <- function(input, output, session) {

    
    output$map <- renderPlotly({

        # see https://plotly.com/r/choropleth-maps/

        url <- 'https://raw.githubusercontent.com/plotly/datasets/master/election.geojson'
        geojson <- rjson::fromJSON(file=url)
        url2<- "https://raw.githubusercontent.com/plotly/datasets/master/election.csv"
        df <- read.csv(url2)
        g <- list(
            fitbounds = "locations",
            visible = FALSE
        )
        fig <- plot_ly(source = "map") 
        fig <- fig %>% add_trace(
            type="choropleth",
            geojson=geojson,
            customdata = df$district_id, # specify whatever var from df you want
            locations= df$district,
            z=df$Bergeron,
            colorscale="Viridis",
            featureidkey="properties.district"
        )
        fig <- fig %>% layout(
            geo = g
        )
        fig <- fig %>% colorbar(title = "Bergeron Votes")
        fig <- fig %>% layout(
            title = "2013 Montreal Election"
        )
        fig %>% event_register(event = input$event)
        
            })
    
    output$tbl = renderDT(
        selected <- event_data(event = input$event, source = "map")    
        )

}

# Run the application 

shinyApp(ui = ui, server = server)

There is no need for your onRender(), just specify customdata (which you didn't?) and use event_register() with event_data()

Answer 2

@thmsckh. I have been able to solve the problem of table loading on clicking the markers.But I am encountering a new problem. This is the MWE that I have created to illustrate the problem. When I choose from the drop down menu, and click on a marker, table for the point appears but when I switch to other option on the drop down menu, the table from previous option remians. How do I solve this problem?

library(plotly)
library(dplyr)
library(shiny)
library(htmlwidgets)
library(DT)
library(ggplot2)
a<- datasets::mtcars
print(a)

ui <- fluidPage( 
  selectInput("var","Select a map type:",choices=list("Select","Map1","Map2")),
  plotlyOutput(outputId = "Plot"),
  DT::dataTableOutput('click'),
  DT::dataTableOutput('click1')

)

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

  Plot1 <- reactive({
    render_value(a)
    fig <- plot_ly(
      type = 'scatter',
      x = mtcars$hp,
      y = mtcars$qsec,
      source="subset1",
      customdata=rownames(mtcars),
      text = paste("Make: ", rownames(mtcars),
                   "<br>hp: ", mtcars$hp,
                   "<br>qsec: ", mtcars$qsec,
                   "<br>Cyl: ", mtcars$cyl),
      hoverinfo = 'text',
      mode = 'markers',
      transforms = list(
        list(
          type = 'groupby',
          groups = mtcars$cyl,
          styles = list(
            list(target = 4, value = list(marker =list(color = 'blue'))),
            list(target = 6, value = list(marker =list(color = 'red'))),
            list(target = 8, value = list(marker =list(color = 'black')))
          )
        )
      )
    )

    fig
  })

  Plot2<- reactive({
    render_value1(a)
    fig <- plot_ly(mtcars, x = ~disp, color = I("black"), source = 
 "subset2",customdata=rownames(mtcars))
    fig <- fig %>% add_markers(y = ~mpg, text = rownames(mtcars), showlegend = 
FALSE)
    fig <- fig %>% add_lines(y = ~fitted(loess(mpg ~ disp)),
                             line = list(color = '#07A4B5'),
                             name = "Loess Smoother", showlegend = TRUE)
    fig <- fig %>% layout(xaxis = list(title = 'Displacement (cu.in.)'),
                          yaxis = list(title = 'Miles/(US) gallon'),
                          legend = list(x = 0.80, y = 0.90))

    fig

  })

  varinput<- reactive({
    switch(input$var,
           "Map1"=Plot1(),
           "Map2"=Plot2()
    )
  })

  output$Plot<- renderPlotly({
    varinput()
  })

  render_value=function(df_1){
    output$click <- renderDataTable({
      s <- event_data("plotly_click",source="subset1")
      print(s)
      return(DT::datatable(df_1[rownames(df_1) %in% 
 s$customdata,c('mpg','cyl',"hp","drat","wt","qsec")])) 
  
    })
  }
  render_value1=function(df_2){
    output$click1 <- renderDataTable({
      s <- event_data("plotly_click",source="subset2")
      print(s)
      return(DT::datatable(df_2[rownames(df_2) %in% 
s$customdata,c('mpg','cyl',"hp","drat","wt","qsec")])) 
  
    })
  }
}
shinyApp(ui,server)