ggvis和shiny:add_tooltip在一个闪亮的应用程序中有多个带有add_tooltip的ggvis图时显示错误的信息

时间:2014-10-03 15:41:03

标签: shiny ggvis

我发现一个奇怪的情况是,当一个闪亮的应用程序中有多个带有add_tooltip的ggvis图时,add_tooltip会显示错误的信息。实际上,add_tooltip在第一个ggvis中显示的顺序/项是正确的,但在第二个或第三个ggvis图中是错误的。底部是一个带有mtcars的简单版本示例。有什么建议吗?

非常感谢,

ui.R for add_tooltip_test

library(shiny)
library(ggvis)

shinyUI(fluidPage(

  h5("add_tooltip test"),

  sidebarLayout(

      sidebarPanel(

    checkboxInput(inputId="byVS", label="Selet vs value", value = FALSE),

        conditionalPanel(
                    condition = "input.byVS == true",
                   selectizeInput(
                inputId = "VS", 
                label = "Select a value",
                multiple = FALSE,
                choices = c(0,1),
                    selected=c(0)
                )
        ),


    checkboxInput(inputId="byAM", label="Selet am value", value = FALSE),

        conditionalPanel(
                    condition = "input.byAM == true",
                selectizeInput(
            inputId = "AM", 
            label = "Select a value",
            multiple = FALSE,
            choices = c(0,1),
                selected=c(0)
                )
        )

      ),

      mainPanel(

     uiOutput("plot1_ui"),
            ggvisOutput("plot1")        

       )
  )
 ))

server.R for add_tooltip_test

library(shiny)
library(ggvis)
library(dplyr)

shinyServer(function(input, output, session) {

vis <- reactive({

    if(input$byVS == FALSE && input$byAM == FALSE){

            myplotdata <- mutate(mtcars, carName=rownames(mtcars), id=1:nrow(mtcars))

            my_values <- function(x) {

                    if(is.null(x)) return(NULL)
                    row <- myplotdata[myplotdata$id == x$id, ]
                    row$carName

          }

            myplotdata %>%
                ggvis(x= ~hp, y= ~mpg) %>%
                layer_points(key := ~id,  fill = ~factor(cyl)) %>%
                add_tooltip(my_values,"hover") %>%
                group_by(cyl) %>%
                layer_model_predictions(model = "lm", strokeDash = ~factor(cyl))        


    }else if(input$byVS == FALSE && input$byAM == TRUE){

            amplotdata <- subset(mtcars, am == input$AM)

            amplotdata <- mutate(amplotdata, carName=rownames(amplotdata), id=1:nrow(amplotdata))

            am_values <- function(x) {

                    if(is.null(x)) return(NULL)
                    row <- amplotdata[amplotdata$id == x$id, ]
                    row$carName

            }

            amplotdata %>% 
                ggvis(x= ~hp, y= ~mpg) %>%
                layer_points(key := ~id,  fill = ~factor(cyl)) %>%
                add_tooltip(am_values,"hover") %>%
                group_by(cyl) %>%
                layer_model_predictions(model = "lm", strokeDash = ~factor(cyl))


    }else if(input$byVS == TRUE){

            vsplotdata <- subset(mtcars, vs == input$VS)

            vsplotdata <- mutate(vsplotdata, carName=rownames(vsplotdata), id=1:nrow(vsplotdata))

            vs_values <- function(x) {

                    if(is.null(x)) return(NULL)
                    row <- vsplotdata[vsplotdata$id == x$id, ]
                    row$carName

            }

            vsplotdata %>% 
                ggvis(x= ~hp, y= ~mpg) %>%
                layer_points(key := ~id,  fill = ~factor(cyl)) %>%
                add_tooltip(vs_values,"hover") %>%
                group_by(cyl) %>%
                layer_model_predictions(model = "lm", strokeDash = ~factor(cyl)) 
    }
})

vis %>% bind_shiny("plot1", "plot1_ui")   

})

0 个答案:

没有答案