Блестящий: связать слайдер с группой, на которой щелкнули в сюжете - PullRequest
Новая
       11

Блестящий: связать слайдер с группой, на которой щелкнули в сюжете

0 голосов
/ 12 февраля 2019

ОБНОВЛЕНИЕ

Я думаю, что мне удалось заставить его работать - по крайней мере, теперь я знаю, как получить информацию о группе из точки нажатия.См. this gist

INTRO

Я создаю блестящее приложение, в котором я хочу отобразить объем невыполненных работ по всем продуктам, с которыми работает данная команда.Отставание обусловлено двумя факторами: количество поступивших new элементов и выходящих closed, характерных для каждого продукта.Кроме того, каждому продукту соответствует значение productivity (необходимое в другой части приложения).

ВОПРОС

Я хочу иметь возможность: 1) щелкнуть по конкретному товару и увидеть, как таблица фильтруется по выбранному товару, и

2) изменить базовые предположения.отрегулировав ползунки new, closed и productivity%, которые будут применяться только к выбранному продукту.

3) Эти изменения в базовых допущениях будут затем отражены на графике.

Предлагаемое правило за этим может быть найдено в комментируемой части определения react_df().Сюжет может быть построен с использованием любого shiny дружественного пакета, не обязательно ggplot2.

ЧТО Я ПРОБОВАЛ

Я новичок в Shiny.Я попытался использовать функциональность tooltip и начал искать plotOutput аргументы для действий, связанных с двойным щелчком, но не смог заставить его работать: примеры, показанные в ресурсах RStudio на интерактивных графиках (например, этот * 1036)* или этот использует диаграммы рассеяния и получает значения 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)
...