在Shiny

时间:2018-07-31 10:21:55

标签: r ggplot2 shiny tooltip

我正在尝试使用ggplotly命令将工具提示添加到闪亮的仪表板中的ggplot条形图中。这是因为我已经使用ggplot2对视觉进行了编码,并且遇到了plotly问题,即数据的可视化方式。

现在,当我将鼠标悬停在每个栏上时,将显示工具提示。但是,工具提示值默认为1,并且条中包含的值未显示。我不确定是否必须定义工具提示以及该如何操作,或者这是否是技术故障(请参见下图)。

在诊断代码问题时,我会提供一些帮助,因为我可能会怀疑它的问题。

下面,我概述了样本数据集,UI,服务器和问题图像。我无法提供整个数据集,因为集合非常大且工作有些敏感。

数据集

Data <- data.frame(Loc_count = c(1,1,1,1,1,1,1,1,1,1),
               Hotel = c("A","B","C","D","E","F","G","H","I","J"),
               Region = c(rep("North",10)),
               Authority = c("Bolton","Manchester","Bolton","Bolton","Bradford","Manchester","Preston","Bolton","Preston","Manchester"),
               Town = c("Milton","Warrington","Milton","Leigh-on-Sea","Basildon Town","Gadden","Manchester Central","Marm Central","Marsh","Lemington Spa"),
               Service = c("Motel","Hotel","Motel","Hotel","Hotel","Bedsit","Hotel","Hotel","Hotel","Hotel"),
               Rating = c("Good","Excellent","Excellent","Good","Good","Good","RI","Inadequate","Inadequate","Good"),
               Beds = c(100,45,34,55,25,69,55,150,50,50)
               )

UI

ui <- fluidPage(

   # App title
   titlePanel("Hotel analyser"),

   # Sidebar layout with input and output definitions
   sidebarLayout(
      sidebarPanel(id = "sidebar",
                   # Input 1: Select geography
                   uiOutput("Geography"),
                   # Input 2: Select location
                   uiOutput("Location"),
                   # Input 3: Select service type
                   uiOutput("Service"),
                   # Input: Select y variables
                   radioButtons("y", "Choose Y variable",
                                c("Beds",
                                  "Locations"),
                                selected = "Locations")
      ),

      # Main panel for displaying outputs ----
      mainPanel(
         # Output: Tabset w/ plot, summary, and table ----
         tabsetPanel(type = "tabs",
                     tabPanel("Bar Chart", plotlyOutput("plot", height = "450px")),
                     tabPanel("Underlying data", dataTableOutput("table"))
         )
      )
   )
)

服务器

server <- function(input, output) {

      # Reactive output/inputs and datasets
      #Geography selection output
      output$Geography = renderUI({
         selectInput(inputId = "Geography",
                     label = "Select geography:", 
                     choices = c("Region","Authority","Town"),
                     selected = "Region")
      })

      Geography <- reactive(switch(input$Geography,
                                   "Region" = Data$Region,
                                   "Authority" = Data$Authority,
                                   "Town" = Data$Town))

      #Location selection output
      output$Location = renderUI({
         selectInput(inputId = "Location", 
                     label = "Select location:", 
                     choices = unique(Geography()),
                     selected = unique(Geography())[1]) 
      })
 datasub2 <- reactive({
     req(input$Location)
     filter(Data, Geography() %in% input$Location)
  })

  #Service selector
  output$Service = renderUI({

     selectInput(inputId = "Service",
                 label = "Select Service Type:",
                 choices = unique(datasub2()[,"Service"]),
                 selected = unique(datasub2()[,"Service"])[1])
  })

  datasub3 <- reactive({
     req(input$Location)
     filter(datasub2(), Service %in% input$Service)

 })

      y <- reactive(switch(input$y, 
                           "Beds" = datasub3()$Beds,
                           "Locations" = datasub3()$Loc_count))

      #  Bar chart
      output$plot = renderPlotly({

            ggplotly(ggplot(datasub3(), aes(x = Rating, y = y(), fill = Rating))+
     geom_bar(stat = "identity")+
     theme(legend.position=c(0.8,0.8))+
     labs(x = "X", y = "Y") +
     theme(legend.text = element_text(size=14, family="sans"))+
     theme(legend.title = element_text(family = "sans",size=16, face = "bold",colour = "#6c276a"))+
     theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid"))+
     theme(panel.grid.major = element_line(size = 0.5, linetype = 'dotted', colour = "white"))+
     theme(panel.grid.minor = element_line(size = 0.5, linetype= 'dotted', colour = "white"))+
     theme(axis.text.x = element_text(size=12, family="sans"))+
     theme(axis.text.y = element_text(size=12, family="sans"))+
     theme(plot.margin = unit(c(1,1,1,1), "cm"))+
     theme(plot.title = element_text(margin= margin(b=-15), family="sans",size=17,colour="black",face="bold", hjust=0))+
     theme(axis.text.x = element_text(angle=0, margin= margin(t=4)))+
     theme(axis.title.x = element_text(colour="#6c276a", face="bold", size=13))+
     theme(axis.title.y = element_text(colour="#6c276a",face="bold",size=13)))
      })

      # Generate an data table view of the data ----
      output$table <- renderDataTable({
         datasub3()[,1:7]
      }) 

   } 

# Create Shiny app ----
shinyApp(ui, server)

The issue with my tooltip

0 个答案:

没有答案