I have a basic Shiny app that uses a ggvis() graphic. The app is given below.
I see in the documentation for ggvis() there is a handle_click(vis, on_click = NULL) function which can be passed. Further, the on_click is a callback function with arguments data, location and session.
What I would like to do is allow a user to click on one of the bars in the graph (one bar per month) and have it set input$monthSelect to the month of the bar they clicked on. If I were adding a tooltip, I could create a function which would take in the data from the layer being hovered over and I could reference data$x_ to get the month.
An example of this function is:
update_selection = function(data){
if(is.null(data)) return(NULL)
updateSelectInput(session
,"monthSelect"
,selected=data$x_)
}
and I add it to the ggvis through ggvis() %>% handle_click(update_selection(data)) but I get an error Error in func() : could not find function "fun".
How can I make a reactive graph?
library(ggvis)
library(dplyr)
library(tidyr)
library(ReporteRs)
data = cocaine
data = within(data,
{
month[month==1] = "January"
month[month==2] = "February"
month[month==3] = "March"
month[month==4] = "April"
month[month==5] = "May"
month[month==6] = "June"
month[month==7] = "July"
month[month==8] = "August"
month[month==9] = "September"
month[month==10] = "October"
month[month==11] = "November"
month[month==12] = "December"
}
)
server = function(input, output, session){
selectedState = reactive(input$stateSelect)
plotData = reactive({
data %>%
group_by(state,month) %>%
summarise(avgPotency = mean(potency)) %>%
ungroup() %>%
spread(month,avgPotency) %>%
mutate(January = ifelse(is.na(January),0,January)
,February = ifelse(is.na(February),0,February)
,March = ifelse(is.na(March),0,March)
,April = ifelse(is.na(April),0,April)
,May = ifelse(is.na(May),0,May)
,June = ifelse(is.na(June),0,June)
,July = ifelse(is.na(July),0,July)
,August = ifelse(is.na(August),0,August)
,September = ifelse(is.na(September),0,September)
,October = ifelse(is.na(October),0,October)
,November = ifelse(is.na(November),0,November)
,December = ifelse(is.na(December),0,December)
) %>%
filter(state==selectedState()) %>%
gather("month","AvgPotency",-state)
})
stateVis = reactive({
plotData() %>%
ggvis(x=~month,y=~AvgPotency)
})
stateVis %>% bind_shiny("cocaineCounts")
selectedMonth = reactive(input$monthSelect)
tableData = reactive({
data %>%
filter(state==selectedState() & month==selectedMonth())
})
output$cocaineTable = renderUI({
MyFTable = FlexTable(tableData(),
header.cell.props = cellProperties( padding = 2 ),
body.cell.props = cellProperties( padding = 2 ))
return(HTML(as.html(MyFTable)))
})
}
ui = shinyUI(
fluidPage(
column(6,
selectInput("stateSelect",label="Select a State:",choices = unique(data$state),selected=1)
,selectInput("monthSelect",label="Select a Month:",choices = c('January','February','March','April','May','June','July','August','September','October','November','December'),selected=1)
,ggvisOutput("cocaineCounts")
)
,column(6,
uiOutput(outputId = "cocaineTable")
)
)
)
shinyApp(ui = ui, server = server)
The function needs to be updated to accept three arguments:
update_selection = function(data,location,session){
if(is.null(data)) return(NULL)
updateSelectInput(session
,"monthSelect"
,selected=data$x_)
}
and handle_click() needs to be passed as ggvis() %>% handle_click(update_selection)
So the complete, working app is:
library(ggvis)
library(dplyr)
library(tidyr)
library(ReporteRs)
data = cocaine
data = within(data,
{
month[month==1] = "January"
month[month==2] = "February"
month[month==3] = "March"
month[month==4] = "April"
month[month==5] = "May"
month[month==6] = "June"
month[month==7] = "July"
month[month==8] = "August"
month[month==9] = "September"
month[month==10] = "October"
month[month==11] = "November"
month[month==12] = "December"
}
)
update_selection = function(data,location,session){
if(is.null(data)) return(NULL)
updateSelectInput(session
,"monthSelect"
,selected=data$x_)
}
server = function(input, output, session){
selectedState = reactive(input$stateSelect)
plotData = reactive({
data %>%
group_by(state,month) %>%
summarise(avgPotency = mean(potency)) %>%
ungroup() %>%
spread(month,avgPotency) %>%
mutate(January = ifelse(is.na(January),0,January)
,February = ifelse(is.na(February),0,February)
,March = ifelse(is.na(March),0,March)
,April = ifelse(is.na(April),0,April)
,May = ifelse(is.na(May),0,May)
,June = ifelse(is.na(June),0,June)
,July = ifelse(is.na(July),0,July)
,August = ifelse(is.na(August),0,August)
,September = ifelse(is.na(September),0,September)
,October = ifelse(is.na(October),0,October)
,November = ifelse(is.na(November),0,November)
,December = ifelse(is.na(December),0,December)
) %>%
filter(state==selectedState()) %>%
gather("month","AvgPotency",-state)
})
stateVis = reactive({
plotData() %>%
ggvis(x=~month,y=~AvgPotency) %>%
handle_click(update_selection)
})
stateVis %>% bind_shiny("cocaineCounts")
selectedMonth = reactive(input$monthSelect)
tableData = reactive({
data %>%
filter(state==selectedState() & month==selectedMonth())
})
output$cocaineTable = renderUI({
MyFTable = FlexTable(tableData(),
header.cell.props = cellProperties( padding = 2 ),
body.cell.props = cellProperties( padding = 2 ))
return(HTML(as.html(MyFTable)))
})
}
ui = shinyUI(
fluidPage(
column(6,
selectInput("stateSelect",label="Select a State:",choices = unique(data$state),selected=1)
,selectInput("monthSelect",label="Select a Month:",choices = c('January','February','March','April','May','June','July','August','September','October','November','December'),selected=1)
,ggvisOutput("cocaineCounts")
)
,column(6,
uiOutput(outputId = "cocaineTable")
)
)
)
shinyApp(ui = ui, server = server)