如何在閃亮的應用程序中使ggvis工具提示交互？

Question

在下面的示例中，我有一個互動式閃亮的ggvis choropleth，帶有彈出標簽，用於顯示每個州的收入。 用戶可以從下拉列表切換數據。

我的問題是如何使工具提示功能具有交互性。 即使用戶切換到第二個數據集，彈出標簽仍會顯示原始數據集的信息。 我試圖將其用於反應功能和其他幾種方式，但是它們都不起作用。 在下面的示例中，我僅在工具提示功能中使用df1，即可讓您運行並查看此應用程序。

謝謝你的幫助！

這是樣本數據

 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)) 

服務器代碼

 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代碼

 library(shiny) library(ggvis) shinyUI(fluidPage( fluidRow( column(3, wellPanel( selectInput("segment", "Choose segment:", choices = c("K 1", "K 2") ) ) ), column(9, ggvisOutput("visplot") ) ) )) 

更新：

這就是我嘗試過的。 我還在add_tooltip中使用values（）代替了值。 但這是行不通的。

 ###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

這是一個更簡單的mtcars示例，帶有layer_paths和grouping的組級別工具提示。 選擇不同的數據集時，圖形和工具提示信息都會更改。

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"))
  )
))

服務器：

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")

})