I'm trying to use click events using the plotly_click option in RShiny. What I want to do is: On clicking the plot, the dataset corresponding to the click event is displayed. So when I click on 'Office Supplies' in categories on the plot, dataset corresponding to category column='Office Supplies' is displayed. Similarly, when I drill down to sub category level and click on any of sub category in the plot, dataset corresponding to the sub category is displayed. But what I am not able to achieve is: that when I click on 'Back' action button, I see an empty data table and not data table corresponding to key 'Office Supplies' i.e. On clicking the back button, I see an empty table which is what I don't want. How should I do this?. Any help would be appreciated. Below is my code:
library(shiny)
library(plotly)
library(dplyr)
library(readr)
sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")
categories <- unique(sales$category)
sub_categories <- unique(sales$sub_category)
ids <- unique(sales$id)
ui <- fluidPage(
uiOutput("history"),
plotlyOutput("bars", height = 200),
plotlyOutput("lines", height = 300),
uiOutput('back'),
uiOutput("back1"),
dataTableOutput("click1")
)
server <- function(input, output, session) {
# These reactive values keep track of the drilldown state
# (NULL means inactive)
drills <- reactiveValues(category = NULL,
sub_category = NULL,
id = NULL)
# filter the data based on active drill-downs
# also create a column, value, which keeps track of which
# variable we're interested in
sales_data <- reactive({
if (!length(drills$category)) {
return(mutate(sales, value = category))
}
sales <- filter(sales, category %in% drills$category)
if (!length(drills$sub_category)) {
return(mutate(sales, value = sub_category))
}
sales <- filter(sales, sub_category %in% drills$sub_category)
mutate(sales, value = id)
})
# bar chart of sales by 'current level of category'
output$bars <- renderPlotly({
a<- sales
render_value(a)
d <- count(sales_data(), value, wt = sales)
p <- plot_ly(d,
x = ~ value,
y = ~ n,
source = "bars",key=~value) %>%
layout(yaxis = list(title = "Total Sales"),
xaxis = list(title = ""))
if (!length(drills$sub_category)) {
add_bars(p, color = ~ value,key=~value)
} else if (!length(drills$id)) {
add_bars(p,key=~value) %>%
layout(hovermode = "x",
xaxis = list(showticklabels = FALSE))
} else {
# add a visual cue of which ID is selected
add_bars(p,key=~value) %>%
filter(value %in% drills$id) %>%
add_bars(color = I("black")) %>%
layout(
hovermode = "x",
xaxis = list(showticklabels = FALSE),
showlegend = FALSE,
barmode = "overlay"
)
}
})
# control the state of the drilldown by clicking the bar graph
observeEvent(event_data("plotly_click", source = "bars"), {
x <- event_data("plotly_click", source = "bars")$x
if (!length(x))
return()
if (!length(drills$category)) {
drills$category <- x
} else if (!length(drills$sub_category)) {
drills$sub_category <- x
} else {
drills$id <- x
}
})
output$back <- renderUI({
if (!is.null(drills$category) && is.null(drills$sub_category)) {
actionButton("clear", "Back", icon("chevron-left"))
}
})
output$back1 <- renderUI({
if (!is.null(drills$sub_category)) {
actionButton("clear1", "Back", icon("chevron-left"))
}
})
observeEvent(input$clear,
drills$category <- NULL)
observeEvent(input$clear1,
drills$sub_category <- NULL)
render_value=function(df_1){
output$click1<- DT::renderDataTable({
s <- event_data("plotly_click",source="bars")
if (is.null(s)){
return(NULL)
}
else if(!is.null(drills$category) && is.null(drills$sub_category)){
ad<- df_1[df_1$category %in% s$key,]
return(DT::datatable(ad))
}
else if(!is.null(drills$sub_category)){
print(s$key)
ad<- df_1[df_1$sub_category %in% s$key,]
return(DT::datatable(ad))
}
})
}
}
shinyApp(ui, server)
As you did not provide sample data, I used gapminder data to test. When you click on 'back' button for sub_category, it is not recognizing the click event on the plot. Alternately, you can just output sales_data() as shown below.
library(shiny)
library(plotly)
library(dplyr)
library(readr)
library(gapminder)
#sales <- read_csv("https://plotly-r.com/data-raw/sales.csv")
sales <- gapminder
sales$category <- sales$continent
sales$sub_category <- sales$country
sales$id <- sales$year
sales$n <- sales$lifeExp
sales$sales <- sales$gdpPercap
categories <- unique(sales$category)
sub_categories <- unique(sales$sub_category)
ids <- unique(sales$id)
ui <- fluidPage(
# uiOutput("history"),
plotlyOutput("bars", height = 200),
# plotlyOutput("lines", height = 300),
uiOutput('back'),
uiOutput("back1"),
DTOutput("t1") ## working
,DTOutput("click1") ## not working
)
server <- function(input, output, session) {
# These reactive values keep track of the drilldown state
# (NULL means inactive)
drills <- reactiveValues(category = NULL,
sub_category = NULL,
id = NULL)
# filter the data based on active drill-downs
# also create a column, value, which keeps track of which
# variable we're interested in
sales_data <- reactive({
if (!length(drills$category)) {
return(mutate(sales, value = category))
}
sales <- filter(sales, category %in% drills$category)
if (!length(drills$sub_category)) {
return(mutate(sales, value = sub_category))
}
sales <- filter(sales, sub_category %in% drills$sub_category)
mutate(sales, value = id)
})
output$t1 <- renderDT({
if (is.null(drills$category) & is.null(drills$sub_category) ) return(NULL) ## comment out this line if you want all data to be displayed initially
sales_data()
})
# bar chart of sales by 'current level of category'
output$bars <- renderPlotly({
a<- sales
render_value(a)
d <- count(sales_data(), value, wt = sales)
p <- plot_ly(d,
x = ~ value,
y = ~ n,
source = "bars",key=~value) %>%
layout(yaxis = list(title = "Total Sales"),
xaxis = list(title = ""))
if (!length(drills$sub_category)) {
add_bars(p, color = ~ value,key=~value)
} else if (!length(drills$id)) {
add_bars(p,key=~value) %>%
layout(hovermode = "x",
xaxis = list(showticklabels = FALSE))
} else {
# add a visual cue of which ID is selected
add_bars(p,key=~value) %>%
filter(value %in% drills$id) %>%
add_bars(color = I("black")) %>%
layout(
hovermode = "x",
xaxis = list(showticklabels = FALSE),
showlegend = FALSE,
barmode = "overlay"
)
}
})
# control the state of the drilldown by clicking the bar graph
observeEvent(event_data("plotly_click", source = "bars"), {
x <- event_data("plotly_click", source = "bars")$x
if (!length(x))
return()
if (!length(drills$category)) {
drills$category <- x
} else if (!length(drills$sub_category)) {
drills$sub_category <- x
}else {
drills$id <- x
}
})
output$back <- renderUI({
if (!is.null(drills$category) && is.null(drills$sub_category)) {
actionButton("clear", "Back", icon("chevron-left"))
}
})
output$back1 <- renderUI({
if (!is.null(drills$sub_category)) {
actionButton("clear1", "Back", icon("chevron-left"))
}
})
observeEvent(input$clear,
{drills$category <- NULL})
observeEvent(input$clear1, {
drills$sub_category <- NULL})
render_value=function(df_1){
output$click1<- DT::renderDataTable({
s <- event_data("plotly_click",source="bars")
if (is.null(s)){
return(NULL)
}else if((!is.null(drills$category) && is.null(drills$sub_category))){
print(s$key)
ad<- df_1[df_1$category %in% s$key,]
return(DT::datatable(ad))
}else if(!is.null(drills$sub_category)){
#print(s$key)
ad<- df_1[df_1$sub_category %in% s$key,]
return(DT::datatable(ad))
}
})
}
}
shinyApp(ui, server)