Параметры отображения в selectInput на основе предыдущего выбора пользователя после обработки таблицы в RShiny - PullRequest
0 голосов
/ 09 октября 2018

У меня есть блестящее приложение, которое отображает таблицу на основе вычислений суммы (строка первая) и коэффициентов строки первая (строка вторая) отфильтрованных значений базы данных.В текущей ситуации фильтрация и обработка таблицы работают точно так, как они должны, показывая результаты только того, что было выбрано, и всегда агрегируя данные, если не все фильтры были выбраны.

Однако мне бы хотелось, чтобы в раскрывающихся списках selectInput отображались только возможные варианты, основанные на том выборе, который уже был сделан пользователем, чтобы пользователю не нужно было угадывать, какие комбинации доступны, поскольку исходные данныебольше и с большим количеством комбинаций.

Пример:

Если в фильтре Campaign выбран Campaign F, отображаются только параметры «Цель 1» в фильтре «Цель» и коды 608, 609 в фильтре «Код»в то время как таблица отображает сумму и ставки по всем строкам, в которых есть «Кампания F».

Или, если выбрано «Цель 1», «Кампания А», «Кампания С» и «Кампания F» появятся в качестве параметров фильтра Кампания, но в таблице будет показана сумма значений для всех строк, которые«Цель 1».

Если я выберу «Цель 1» и «Кампания F», то останется только фильтр «Код», чтобы отобразить дополнительные параметры, а в таблице будут отображены результаты суммы соответствующих строк.И так далее.

Date        Objective   Campaign    Code    Metric_One  Metric_Two  Metric_Three    Metric_Four
2018-09-04  Objective 1 Campaign A  601     8273        7417        415             129
2018-09-04  Objective 2 Campaign B  602     2390        818         30              4
2018-09-04  Objective 2 Campaign B  603     2485        1354        34              7
2018-09-05  Objective 1 Campaign C  604     537513      532170      18693           2136
2018-09-05  Objective 2 Campaign D  605     13          13          3               1
2018-09-08  Objective 3 Campaign E  606     14855       12505       676             162
2018-09-08  Objective 3 Campaign E  607     24363       20270       790             180
2018-09-10  Objective 1 Campaign F  608     155         148         11              1
2018-09-10  Objective 1 Campaign F  609     1320        974         79              11

Единственная подсказка для меня - то, что это связано с реактивностью пользовательского интерфейса и, возможно, наблюдением за событием.Но я нашел только примеры с теми, в которых отображалась сама база данных или простые числа, и я не смог адаптировать их также для вычисления значений для таблицы.

Это код:

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600), 
class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"), 
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"), 
Code = c(601, 602, 603, 604, 605, 606, 607, 608,  609), 
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320), 
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974), 
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79), 
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))


ui <- dashboardPage(
  dashboardHeader(),

  dashboardSidebar(
    selectInput("objective", 
                "Objective:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Objective))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("name_campaign", 
                "Campaign Name:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("code", 
                "Code:", 
                choices = c("Nothing Selected" , sort(unique((campaigns$Code)))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected")
  ), # End () dashboard Sidebar

  dashboardBody(
    DT::dataTableOutput("BigNumberTable")
  ) # End () dashboardBody
) # End () dashboardPage


server <- function(input, output) { # Server

  line_one <- reactive({ 

    total_campaign <- campaigns

    if(input$objective != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Objective == input$objective)
    }

    if(input$name_campaign != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
    }

    if(input$code != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Code == input$code)
    }

    total_campaign <- total_campaign %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      summarise(Metric_One = sum(Metric_One),
                Metric_Two = sum(Metric_Two),
                Metric_Three = sum(Metric_Three),
                Metric_Four = sum(Metric_Four)) %>%
      mutate(Description = "") %>%
      mutate(Date = "") %>% 
      select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)

    total_campaign

  }) ## End () line_one

  line_two <- reactive({ 

    campaign_tx <- line_one()

    campaign_tx <- campaign_tx %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      mutate(TxMetric_One = "",
             TxMetric_Two = (Metric_Two/Metric_One)*100,
             TxMetric_Three = (Metric_Three/Metric_Two)*100,
             TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
      mutate(Date = "") %>%
      mutate(Description = "") %>%
      select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>% 
      dplyr::rename(Metric_One = TxMetric_One,
                    Metric_Two = TxMetric_Two,
                    Metric_Three = TxMetric_Three,
                    Metric_Four = TxMetric_Four)

    campaign_tx

  }) ## End () line_two

  # Table
  output$BigNumberTable <-  DT::renderDataTable({

    ## Bind the lines in one table

    all_table <- rbind(line_one(), line_two())

    datatable(all_table,
              rownames = NULL,
              colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
              filter = "none",
              options = list(dom = 't', 
                             scrollX = TRUE, 
                             ordering=F,
                             columnDefs = list(list(className = 'dt-center', targets = 0:5))))

  } # End {} renderDataTable
  ) # End () renderTable
} # End {} server function
# Run the application 
shinyApp(ui = ui, server = server)

Спасибо за любую помощь и помощь.

1 Ответ

0 голосов
/ 09 октября 2018

Нечто подобное поможет, заметьте, что я в основном использовал observeEvent

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600), 
                                             class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                            Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"), 
                            Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"), 
                            Code = c(601, 602, 603, 604, 605, 606, 607, 608,  609), 
                            Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320), 
                            Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974), 
                            Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79), 
                            Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))


ui <- dashboardPage(
  dashboardHeader(),

  dashboardSidebar(
    selectInput("objective", 
                "Objective:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Objective))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("name_campaign", 
                "Campaign Name:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("code", 
                "Code:", 
                choices = c("Nothing Selected" , sort(unique((campaigns$Code)))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected")
  ), # End () dashboard Sidebar

  dashboardBody(
    DT::dataTableOutput("BigNumberTable")
  ) # End () dashboardBody
) # End () dashboardPage


server <- function(input, output,session) { # Server

  observeEvent(input$objective,{
    req(input$objective)
    if(input$objective == "Nothing Selected"){
      return()
    }
    updateSelectInput(session,"name_campaign", choices =  c("Nothing Selected",campaigns$Campaign[campaigns$Objective %in% input$objective]),selected = "Nothing Selected")
  })

  observeEvent(c(input$objective,input$name_campaign),{
    req(input$objective)
    req(input$name_campaign)
    if(input$objective == "Nothing Selected" || input$name_campaign == "Nothing Selected"){
      return()
    }
    updateSelectInput(session,"code", choices =  c("Nothing Selected",campaigns$Code[campaigns$Objective %in% input$objective & campaigns$Campaign %in% input$name_campaign]),selected = "Nothing Selected")
  })


  line_one <- reactive({ 
    req(input$name_campaign)
    req(input$code)
    total_campaign <- campaigns

    if(input$objective != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Objective == input$objective)
    }

    if(input$name_campaign != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
    }

    if(input$code != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Code == input$code)
    }

    total_campaign <- total_campaign %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      summarise(Metric_One = sum(Metric_One),
                Metric_Two = sum(Metric_Two),
                Metric_Three = sum(Metric_Three),
                Metric_Four = sum(Metric_Four)) %>%
      mutate(Description = "") %>%
      mutate(Date = "") %>% 
      select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)

    total_campaign

  }) ## End () line_one

  line_two <- reactive({ 

    campaign_tx <- line_one()

    campaign_tx <- campaign_tx %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      mutate(TxMetric_One = "",
             TxMetric_Two = (Metric_Two/Metric_One)*100,
             TxMetric_Three = (Metric_Three/Metric_Two)*100,
             TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
      mutate(Date = "") %>%
      mutate(Description = "") %>%
      select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>% 
      dplyr::rename(Metric_One = TxMetric_One,
                    Metric_Two = TxMetric_Two,
                    Metric_Three = TxMetric_Three,
                    Metric_Four = TxMetric_Four)

    campaign_tx

  }) ## End () line_two

  # Table
  output$BigNumberTable <-  DT::renderDataTable({

    ## Bind the lines in one table

    all_table <- rbind(line_one(), line_two())

    datatable(all_table,
              rownames = NULL,
              colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
              filter = "none",
              options = list(dom = 't', 
                             scrollX = TRUE, 
                             ordering=F,
                             columnDefs = list(list(className = 'dt-center', targets = 0:5))))

  } # End {} renderDataTable
  ) # End () renderTable
} # End {} server function
# Run the application 
shinyApp(ui = ui, server = server)

enter image description here

...