在Shiny中创建悬停信息框和反应下拉菜单

时间:2019-03-11 02:09:04

标签: r ggplot2 shiny

这是我的第一个Shiny应用程序,我已经了解了一些基础知识,它允许用户从客户端的下拉菜单中进行选择,然后从测试代码的下拉菜单中进行选择,以接收所选测试的结果图

我希望第二个下拉菜单使用该客户端的可用测试代码进行更新(每个客户端均不存在所有测试代码)。另外,我希望能够将鼠标悬停在绘图中的点上,并从原始数据框中的行中接收更多信息。

我已经研究了工具提示和nearPoints()函数,但是由于这些数据已经被操纵,因此我不确定它们是否可以用于此数据。我不确定这时是否可以更轻松地以其他方式导入数据(最终将需要接受excel文件或.csv)。感谢您能够提供的任何帮助,请告诉我是否有我可以提供的其他支持信息。

这是我的代码:

{{1}}

数据如下所示: MockNLData.csv

编辑:我想出了使用updateSelectInput()更新菜单

2 个答案:

答案 0 :(得分:0)

将来,请确保您分享一个可重复的示例:)

由于您的代码不可复制,请在下面找到一些您可以理解并适应您的情况的内容。

关于第一个问题,如果我理解正确,那么您想以编程方式生成一个完全可行的下拉列表(selectInput)。本质上,*Input就是可以动态生成的HTML内容,就像绘图一样。您可以通过uiOutput(在用户界面中)和renderUI在服务器中进行此操作。

library(shiny)

ui <- fluidPage(
  selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
  uiOutput("column"), # dynamic column selector
  verbatimTextOutput("selected_column")

)

server <- function(input, output, session){

  data <- reactive({
    if(input$dataset == "cars")
      return(cars)
    else
      return(mtcars)
  })

  output$column <- renderUI({
    # build your selectInput as you normally would
    selectInput("column_selector", "Select a column", choices = colnames(data()))
  })

  output$selected_column <- renderPrint({
    # use input$column_selector!
    print(input$column_selector)
  })

}

shinyApp(ui, server)

关于第二个问题,您想要的是一个互动情节。有很多软件包可以让您在R和Shiny中做到这一点。以下是一些示例,但绝不是完整的列表:

  • plotly,这也使您可以使ggplot2图表具有交互性
  • highcharter另一个出色的,经过良好测试的库
  • echarts4r R的ECharts。
  • billboarder billboard.js(用于R和Shiny)

下面是一个使用highcharter的示例。它们在Shiny中都遵循相同的原理,即*Output函数和render*函数。

library(shiny)
library(highcharter)

ui <- fluidPage(
  highchartOutput("chart")
)

server <- function(input, output, session){

  output$chart <- renderHighchart({
    hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
  })

}

shinyApp(ui, server)

编辑

以下是关于闪烁错误的问题。您需要需要req)所需的输入。在下面启动应用程序时,错误将闪烁,取消对req(input$y)行的注释,它将消失。

library(shiny)

ui <- fluidPage(
    uiOutput("sel"),
    plotOutput("plot")
)

server <- function(input, output){
    output$sel <- renderUI({
        numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
    })

    output$plot <- renderPlot({
        # req(input$y)
        hist(runif(input$y, 1, 10))
    })
}

shinyApp(ui, server)

本质上,由于您的绘图依赖于动态生成的输入(在不到一秒钟的时间内),因此该输入在呈现时不可用,因此使用req可以避免这种情况。

答案 1 :(得分:0)

从您的上述问题中我了解到的是:

  1. 您要根据用户从上一个下拉菜单中选择的内容来制作下一个下拉菜单。
  2. 将鼠标悬停在绘图上的点上时,将显示行值。

因此,在这里,我将为您提供可复制的示例,希望它对您有用。

  • 在此示例中,我使用库 MASS 中的兔子数据集。
  • 要为下一个下拉菜单过滤数据,我使用库中的过滤器 dplyr (请参阅第30行)。
  • 我使用反应表达式来管理下一个下拉菜单(请参见第 29)。
  • 我使用 nearPoints()管理悬停点(请参见第55行)。
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)


ui <- fluidPage(
 titlePanel("Rabbit dataset from MASS library"),



 fluidRow(
   column(4, selectInput("var", 
                         "Animal:",
                         unique(sort(Rabbit$Animal)))),
   column(4, uiOutput("selected_var")),
   column(4, uiOutput("selected_var1")),
   column(12, plotOutput("selected_var2", hover = "plot_hover")),
   column(12, verbatimTextOutput("info"))

 )
)


server <- function(input, output) {

 ###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER

 dataset3 <- reactive({
   unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
 })

 output$selected_var <- renderUI({
   selectInput("var1", "Treatment:", c(dataset3()))
 })

 dataset4 <- reactive({
   Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
 })

 output$selected_var1 <- renderUI({
   selectInput("var2", "Run:", c(dataset4()))
 })

 ####

 output$selected_var2 <- renderPlot({ 

   ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
 })

 ###HOVER POINT USING nearPoints()

 output$info <- renderPrint({
   nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
 })

}


shinyApp(ui = ui, server = server)