Интерактивное приложение Shiny с R - Наведение над точками и отображение информации

Question

Я работаю в 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))

Я пытаюсь создать блестящее приложение, которое позволяет пользователям выбирать один из параметров в столбце 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()
  })
}

Дайте мне знать, соответствует ли это тому, что вы искали.