时间戳

首页 > 解决方案 > 带有 R 的交互式闪亮应用程序 - 悬停在点上并显示信息

r - 带有 R 的交互式闪亮应用程序 - 悬停在点上并显示信息

问题描述

我在 R 中工作以创建一个闪亮的应用程序。

这是我正在使用的示例数据：

data <- data.frame("name" = c("A", "A", "B", "B", "C", "C"),
                   "code_name" = c("A1", "A2", "B1", "B2", "C1", "C2"),
                   "x" = c(.13, .64, .82, .39, .51, .03),
                   "y" = c(.62, .94, .10, .24, .20, .84))

我正在尝试拥有一个 Shiny 应用程序，它允许用户从 column 中选择一个选项name，显示x和y值的散点图，并code_name在您将鼠标悬停在某个点附近时打印绘图下方列中的值。

这是代码ui：

library(ggplot2)
library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "x",
                  label = "Choose a Letter:",
                  choices = levels(data$name),
                  selected = "A")
    ),
    mainPanel(
      plotOutput(outputId = "scatterplot",
                 hover = hoverOpts(id ="plot_hover")),
      verbatimTextOutput("hover_info")
    )
  )
)

这是代码server：

server <- function(input, output) {
  output$scatterplot <- renderPlot({
    data %>%
      filter(name == input$x) %>%
      ggplot(aes(x, y)) +
      geom_point() +
      xlim(c(0, 1)) +
      ylim(c(0, 1))
    })

  output$hover_info <- renderPrint({
    if(!is.null(input$plot_hover)){
      hover = input$plot_hover
      dist = sqrt((hover$x-data$x)^2 + (hover$y-data$y)^2)
      cat("Name\n")
      if(min(dist) < 3)
        data$code_name[which.min(dist)]
    }
  })
}

然后，当然：

shinyApp(ui, server)

第一个输出对象 ，output$scatterplot按需要工作。它是x和y观察值的散点图，其中data$name是从 中选择的值input$x。

问题出在第二个对象上output$hover_info。我想要的是文本框结果renderPrint，仅打印code_name用于观察 where data$name == input$x。现在的方式是，如果我从下拉菜单中选择“A”，并将鼠标悬停在其中一个绘图点上，它会正确地打印该点code_name在绘图下方。但是，如果我将鼠标悬停在两个点附近的随机点上，它将获取其他name选项点之一的位置，并显示该观察值code_name。

例如，如果您按原样运行代码（name == "A"下拉菜单中的默认选择在哪里），并将鼠标悬停在坐标 x = 0.5, y = 0.5 附近，它将打印B2在绘图下方。我想避免这种情况。这里没什么大不了的，每个名称选择只有 2 个数据点，但是当使用具有更大数据集的相同框架时，它会变得非常混乱。

我一直试图filter在对象中包含某种类型的调用，output$hover_info以便它只考虑通过下拉菜单定义的观察结果，但每次尝试时都会出错。

有任何想法吗？谢谢！

标签： rggplot2web-applicationsshiny

解决方案

我通常推荐一种方法，您可以reactive为任何类型的用户操作数据创建一个对象，然后reactive在您的render*调用中引用该对象。我发现它比尝试在render*调用中完成所有事情的限制更少，更容易调试，并且更好地理解数据的反应性应该如何工作。

在这里，我创建了一个filtered_data响应式对象，该对象根据下拉列表进行过滤，然后进一步向下引用。您的代码无法正常工作的原因是因为您的dist计算是针对完整数据集而不是过滤后的数据集进行的。另外，我认为您的阈值 3 太宽了，所以我在这里将其更改为 0.3。

最后，注意req()代替的用法if(!is.null())，它更简洁，并且在我们希望它何时显示数据方面更加一致。

server <- function(input, output) {

  filtered_data <- reactive({
    filter(data, name == input$x)
  })

  output$scatterplot <- renderPlot({
    ggplot(filtered_data(), aes(x, y)) +
      geom_point() +
      xlim(c(0, 1)) +
      ylim(c(0, 1))
  })

  displayed_text <- reactive({
    req(input$plot_hover)
    hover <- input$plot_hover
    dist <- sqrt((hover$x - filtered_data()$x)^2 + (hover$y - filtered_data()$y)^2)

    if(min(dist) < 0.3) {
      filtered_data()$code_name[which.min(dist)]
    } else {
      NULL
    }
  })

  output$hover_info <- renderPrint({
    req(displayed_text())

      cat("Name\n")
      displayed_text()
  })
}

让我知道这是否符合您的要求。

推荐阅读