r - 闪亮：将滑块与在图中单击的组相关联

Question

更新

我想我设法让它工作了——至少现在我知道如何从点击点获取组信息。看到这个gist

介绍

我正在构建一个闪亮的应用程序，我想在其中显示给定团队处理的所有产品的积压量。积压由两个因素驱动：进出的new项目数量，特定于每个产品。closed此外，每个产品都有一个关联的productivity值（在应用程序的不同部分需要）。

问题

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

2) 通过调整仅适用于选定产品的 和 % 滑块来new修改closed基本假设。productivity

3）这些基本假设的变化将反映在情节中。

这背后的建议规则可以在react_df()定义的注释部分找到。该图可以使用任何shiny友好的包构建，不一定是ggplot2.

我试过的

我是新来的闪亮。我尝试使用tooltip功能并开始研究plotOutput与双击相关的操作的参数，但无法使其工作：交互式绘图上 RStudio 资源中显示的示例（例如，这个或这个使用散点图并检索 x 或 y 值而不是组信息。你可以gist 在这里看到我的。

欢迎任何有用的提示！

应用程序

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)

标签： rggplot2shinyshinydashboard