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

Question

这是我的第一个闪亮应用程序，我刚刚使基础知识可用于允许用户从客户端的下拉菜单中进行选择，然后是测试代码的下拉菜单以接收一个选定测试的结果图。

我希望第二个下拉菜单与该客户端的可用测试代码更新（每个客户端都不存在）。另外，我希望能够悬停在图中的点上，并从原始dataframe中的行中接收更多信息。

我已经研究了工具提示和近点（）函数，但是我不确定是否可以在此数据上使用这些功能。我不确定在这一点上，以不同的方式导入数据是否会更容易（最终需要接受Excel文件或.CSV）。感谢您提供的任何帮助，请让我知道是否还有其他支持信息。

这是我的代码：

library(shiny)
library(scales)
library(ggplot2)
labData <- 
read.table("MockNLData.csv", 
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"] 
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"] 
<- "0"
#convert results to scientific notation
SciNotResult <- 
formatC(as.numeric(as.character(labData$ModResult)), 
format="e", digits=2)
ui <- fluidPage(
  headerPanel("Dilution History"), 
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId="client", label="Select Client 
Name", choices=levels(labData$Client.Name)
      ),
      selectInput(inputId="test", label="Select Test Code", 
choices=levels(labData$Analysis))
      ),
    mainPanel(
      plotOutput("line", hover="plot_hov"),
  verbatimTextOutput("info"))
    )
   )
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
   })
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
  })
#points to be plotted
points <- 
reactive({as.numeric(levels(subsetDF()$ModResult)) 
[subsetDF()$ModResult]
  })
#plot
  output$line <- renderPlot({
    qplot(seq_along(points()), points(), xlab ="Index", 
ylab ="Result")
  })
#hover information  
   output$info <- renderText({
   paste0("x=", input$plot_hov$x, "ny=", 
input$plot_hov$y)
  })
}
shinyApp(ui = ui, server = server)

这是数据的样子：MOCKNLDATA.CSV

编辑：我想出了更新菜单的updatesElectInput（）

Answer 1

将来，请确保您共享一个可重复的示例：）

由于您的代码不可再现，请在下面找到您可以理解的内容并适应您的案件。

在您的第一个问题上，如果我正确理解，您想在编程中生成一个非常适合的下拉列表（selectInput）。*Input S本质上只是您可以动态生成的HTML内容，就像图一样。您使用uiOutput（在UI中）和服务器中的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中这样做。以下是一些示例，绝不是全面列表：

• 绘图也将使您使您的ggplot2图表互动
• 高清另一个伟大的，经过良好测试的图书馆
• echarts4r echarts for r。
• Billboarder Billboard.js for R and Shiny

以下是使用高电度的示例。它们都遵循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不可用，因此无法提供。

Answer 2

我从上面的问题中了解的是：

1. 您想根据用户从上一个下拉菜单中选择的内容进行下一个下拉菜单。
2. 当鼠标在图上的点上时，它将显示行值。

所以，在这里我会给您可重现的例子，希望它对您有用。

• 在此示例中，我使用 RABBIT 数据集，来自库 Mass 。
• 要过滤数据以获取下一个下拉菜单，我使用 filter 从库中使用 dplyr （请参阅第30行）。
• 我使用反应性表达式来管理下一个下拉菜单（请参阅行29）。
• 我使用近点（）来管理悬停点（请参阅第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)