Question

我正在R中创建一个Shiny App。

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

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 App，允许用户从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的文本框结果，用于观察data$name == input$x。现在的方式是，如果我从下拉菜单中选择“ A”，并将鼠标悬停在一个绘制的点上，它将正确地在绘图下打印该点的code_name。但是，如果我将鼠标悬停在两个点附近的随机点上，它将拾取其他name个选项点之一的位置，并显示该观测值的code_name。

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

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

有什么想法吗？谢谢！

Answer 1

我通常建议您使用一种方法来创建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()
  })
}

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

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

1 个答案: