How to make ggvis tooltip interactive in shiny app? - r

Question

In the example below, I have an interactive shiny ggvis choropleth with pop up label for income in each state. Users can switch data from drop down list.
My question is how to make the tooltip function interactive. The pop up label still displays the information of the original data set, even though user switches to the second data set. I tried to put it into reactive function and several other ways, but they all doesn't work. In the example below, I just use df1 in tooltip function to let you run and have a look at this app.
Thanks for your help!
Here is sample data
mapdata1<-data.frame(
state=c("alabama","alaska","arizona","arkansas","california","colorado","connecticut","delaware","florida","georgia","hawaii","idaho","illinois","indiana","iowa","kansas","kentucky","louisiana","maine","maryland","massachusetts","michigan", "minnesota","mississippi","missouri","montana","nebraska","nevada","new hampshire","new jersey","new mexico","new york","north carolina","north dakota","ohio","oklahoma", "oregon","pennsylvania","rhode island","south carolina","south dakota","tennessee","texas","utah","vermont","virginia","washington","west virginia","wisconsin","wyoming"),
income=runif(50,min=100,max=9000))
mapdata2<-data.frame(
state=c("alabama","alaska","arizona","arkansas","california","colorado","connecticut","delaware","florida","georgia","hawaii","idaho","illinois","indiana","iowa","kansas","kentucky","louisiana","maine","maryland","massachusetts","michigan", "minnesota","mississippi","missouri","montana","nebraska","nevada","new hampshire","new jersey","new mexico","new york","north carolina","north dakota","ohio","oklahoma", "oregon","pennsylvania","rhode island","south carolina","south dakota","tennessee","texas","utah","vermont","virginia","washington","west virginia","wisconsin","wyoming"),
income=runif(50,min=50,max=14000))
Server code
library(rgdal)
library(ggplot2)
library(ggvis)
tf <- tempfile()
td <- tempdir()
download.file(url,tf, mode="wb")
unzip(tf, exdir=td)
usa <- readOGR(dsn=td, layer="cb_2014_us_state_20m")
shp <- usa[(!usa$STUSPS %in% c("AK","HI")),]
df<- fortify(shp)
df<- merge(df,cbind(id=rownames(shp#data),shp#data),by="id")
df$state <- tolower(df$NAME)
df1<- merge(df,mapdata1,by="state")
df1<- df1[order(df1$order),]
df2<- merge(df,mapdata2,by="state")
df2<- df2[order(df2$order),]
shinyServer(
function(input,output){
dataInput<-reactive({
switch(input$segment,
"K 1"=df1,
"K 2"=df2)
})
###tooltip function
values = function(x){
if(is.null(x)) return(NULL)
row = head(df1[df1$group == unique(x$group), ], 1)
paste0("State: ", row$state,"<br />",
"Income: ", row$income, "<br />")
}
###choropleth
vis<-reactive({
data<-dataInput()
data %>%
group_by(group) %>%
ggvis(~long, ~lat) %>%
hide_axis("x") %>%
hide_axis("y")%>%
add_tooltip(values,"hover")%>%
layer_paths(fill= ~income)
})
vis %>% bind_shiny("visplot")
}
)
ui code
library(shiny)
library(ggvis)
shinyUI(fluidPage(
fluidRow(
column(3,
wellPanel(
selectInput("segment",
"Choose segment:",
choices = c("K 1",
"K 2")
)
)
),
column(9,
ggvisOutput("visplot")
)
)
))
UPDATED:
This is what I tried. I also use values() in add_tooltip instead of values. But it doesn't work.
###tooltip function
values<-reactive({
data<-dataInput()
if(is.null(x)) return(NULL)
row = head(data[data$group == unique(x$group), ], 1)
paste0("State: ", row$state,"<br />",
"Income: ", row$income, "<br />")
})

Answer 1

Here is a simpler mtcars example with a group-level tooltip like yours with layer_paths and grouping. Both the graph and tooltip info change when a different dataset is selected.
ui
library(ggvis)
library(shiny)
shinyUI(fluidPage(
titlePanel("Plotting slopes"),
sidebarLayout(
sidebarPanel(
selectInput("segment", label = "Choose segment", choices = c("K 1", "K 2"))),
mainPanel(ggvisOutput("plot"))
)
))
server:
library(shiny)
library(ggvis)
mtcars$cyl = factor(mtcars$cyl)
df1 = subset(mtcars, am == 0)
df2 = subset(mtcars, am == 1)
shinyServer(function(input, output) {
dataInput = reactive({
switch(input$segment,
"K 1" = df1,
"K 2" = df2)
})
values = function(x){
if(is.null(x)) return(NULL)
dat = dataInput()
row = dat[dat$cyl %in% unique(x$cyl), ]
paste0("Ave Weight: ", mean(row$wt),"<br />",
"Ave Carb: ", mean(row$carb), "<br />")
}
vis1 = reactive({
dat = dataInput()
dat %>%
group_by(cyl) %>%
ggvis(~mpg, ~wt) %>%
layer_paths(stroke = ~cyl, strokeOpacity := 0.3,
strokeWidth := 5) %>%
add_tooltip(values, "hover")
})
vis1 %>% bind_shiny("plot")
})