有光泽：将滑块与在图表中单击的组相关联

Question

更新

我认为我设法做到了-至少现在我知道如何从点击的位置获取组信息。参见this gist

INTRO

我正在构建一个Shiny应用程序，我想在其中显示给定团队处理的所有产品的积压量。积压的原因有两个：分别针对每种产品的new项的数量和closed的项的数量。此外，每个产品都有一个关联的productivity值（应用程序的不同部分需要）。

问题

我希望能够： 1）单击特定产品，然后查看正在过滤到所选产品的表格，然后

2）通过调整仅适用于所选产品的new，closed和productivity％滑块来修改基本假设。

3）基本假设中的那些变化将反映在图中。

此建议的规则可以在react_df()定义的注释部分中找到。可以使用任何shiny友好的程序包（不一定是ggplot2）来构建图。

我尝试过的东西

我是Shiny的新手。我尝试使用tooltip功能，并开始研究plotOutput参数中与双击相关的动作，但无法使其起作用：交互式绘图中RStudio资源中显示的示例（例如{{3 }}或this one使用散点图并获取x或y值而不是组信息。您可以看到我的gist this one。

任何有用的提示都将受到欢迎！

APP

library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(DT)

new_vals <- c(50, 100, 200)
data <- data.frame(
  date = rep(as.Date(c('2018-01-01', '2018-02-01', '2018-03-01')),  4),
  country = c(rep('UK', 3), rep('US', 9)),
  team = c(rep('team A', 3),rep('team B', 6), rep('team C', 3)),
  prod = c(rep('prod1', 3),rep('prod2', 3), rep('prod3', 3), rep('prod4', 3)),
  new = c(new_vals, new_vals+50, new_vals - 50, new_vals+100),
  closed = c(new_vals-20, new_vals+30, new_vals - 30, new_vals+80), 
  productivity = rep(c(50, 70, 80, 40), each = 3),
  orig_backlog = rep(c(100, NA, NA), 4)
)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    uiOutput("edit_country"),
    uiOutput("edit_team")
  ),
  dashboardBody(
    fluidPage(
      fluidRow(
        column(4, 
               wellPanel(uiOutput("edit_productivity"))
        ),
        column(4,
               wellPanel(uiOutput("edit_new"))
        ),
        column(4, 
               wellPanel(uiOutput("edit_closed"))
        ))),
    fluidPage(plotOutput("ts_plot")),
    fluidPage(dataTableOutput("table"))

  )
)


server <- function(input, output) {


  react_data <- reactive({
    data %>% 
      filter(country == input$country,
             team == input$team) %>% 
      group_by(country, team, prod) %>% 
      mutate(
        #new = new + round((closed*input$new)/100,0),
        #closed = closed + round((closed*input$closed)/100,0),
        #productivity = productivity + round((closed*input$productivity)/100,0),
        new_minus_closed = new - closed,
        backlog = orig_backlog[1] + cumsum(new_minus_closed),
        backlog = ifelse(backlog < 0, 0, backlog)
      )  %>% 
      select(-orig_backlog) %>% 
      ungroup() %>% 
      replace(., is.na(.), 0)
  })


  output$edit_country <- renderUI({
    selectInput("country", "Choose Country",
                choices = unique(data$country),
                selected = 'US',
                multiple = FALSE)
    })

  output$edit_team <- renderUI({
    selectInput("team", "Choose Team",
                choices = data %>% 
                  filter(country == input$country) %>% 
                  select(team) %>% 
                  unique() %>% 
                  pull(team),
                selected = 'team B',
                multiple = FALSE)
  })


  output$edit_new <- renderUI({
    sliderInput("new", "Edit New",
                min = -100, max = 100, post  = " %",
                value = 0)
  })



  output$edit_productivity <- renderUI({
    sliderInput("productivity", "Edit Productivity",
                min = -100, max = 100, post  = " %",
                value = 0)

  })

  output$edit_closed <- renderUI({
    sliderInput("closed", "Edit Closed",
                min = -100, max = 100, post  = " %",
                value = 0)

  })

  output$ts_plot <- renderPlot({
      ggplot(react_data(), aes(date, backlog, group = prod, color = prod)) +
      geom_point() +
      geom_line() +
      labs(x = '') +
      theme_minimal()
    })

  output$table <- DT::renderDataTable({
    react_data() %>%
                    select(date, prod, new, closed, productivity) %>%
                    as.data.frame()

  })


}

shinyApp(ui, server)