Настройка условного group_by

У меня есть набор данных, который выглядит так:

+----------+------------+-------+-------+
|  step1   |   step2    | step3 | step4 |
+----------+------------+-------+-------+
| Region 1 | District A | 1A    |   571 |
| Region 1 | District A | 1A    |   356 |
| Region 1 | District A | 1B    |   765 |
| Region 1 | District B | 1B    |   752 |
| Region 2 | District C | 2C    |   885 |
| Region 2 | District C | 2D    |    73 |
| Region 2 | District D | 2D    |   241 |
| Region 2 | District D | 2D    |   823 |
| Region 3 | District E | 3E    |   196 |
| Region 3 | District E | 3E    |   103 |
| Region 3 | District F | 3E    |   443 |
| Region 3 | District F | 3F    |   197 |
+----------+------------+-------+-------+

Я настроил следующий скрипт, который в том виде, в котором он написан, использует selectizeGroupServer для автоматической настройки фильтрации между шагами 1, 2 и 3, чтобы они были связаны друг с другом (т.е. если вы отфильтруете регион 1, он вернет только соответствующие параметры на шаге 2 и шаге 3.

Сценарий ниже возвращает результаты, которые я ищу, если вы хотите, чтобы он group_by_all был прямым. Таким образом, при первом запуске он покажет в виде графика все 11 результатов. Если я отфильтрую по региону 1, он вернет график всех четырех фигур на шаге 4, связанных с регионом 1.

Но я хочу настроить его таким образом, чтобы при выборе параметра он фактически группировался по параметру иерархии под ним. Поэтому, если я отфильтрую по региону 1, он вместо этого вернет два столбца: суммарный агрегат округа A (1692) и суммарный агрегат округа B (752). Если бы у меня были выбраны и регион 1, и район A, он вернул бы два столбца: совокупность 1A (927) и совокупность 1B, которая привязана к округу A (765).

Как я могу настроить его таким образом, чтобы выполнить это?

library(highcharter)
library(shiny)
library(shinyWidgets)
library(dplyr)

step1 <- c('Region 1', 'Region 1', 'Region 1', 'Region 1', 'Region 2', 'Region 2', 'Region 2', 'Region 2', 'Region 3', 'Region 3', 'Region 3', 'Region 3')
step2 <- c('District A', 'District A', 'District A', 'District B', 'District C', 'District C', 'District D', 'District D', 'District E', 'District E', 'District F', 'District F')
step3 <- c('1A', '1A', '1B', '1B', '2C', '2D', '2D', '2D', '3E', '3E', '3E', '3F')
step4 <- c(571,356,765,752,885,73,241,823,196,103,443,197)

ui <- fluidPage(
  fluidRow(
    column(
      width = 5, offset = 1,
      panel(
        selectizeGroupUI(
          id = "foo",
          params = list(
            Step1 = list(inputId = "step1", title = "Step1:"),
            Step2 = list(inputId = "step2", title = "Step2:"),
            Step3 = list(inputId = "step3", title = "Step3:")
          ))
      ),
      highchartOutput(outputId = "table")
    )
  )
)

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

  abc <- callModule(
    module = selectizeGroupServer,
    id = "foo",
    data = df,
    vars = c("step1", "step2", "step3")
  )

  output$table <- renderHighchart({

    bar <- abc()

    xyz <- bar %>% filter(is.null(input$step1) | step1 %in% input$step1,
                        is.null(input$step2) | step2 %in% input$step2,
                        is.null(input$step3) | step3 %in% input$step3) %>% group_by_all() %>% summarise(results = sum(step4))


    highchart() %>% hc_add_series(data = xyz, type = "column", hcaes(y = results),
                                  showInLegend = TRUE) %>% hc_add_theme(hc_theme_flat())


  })


}

Спасибо!


person gooponyagrinch    schedule 14.12.2019    source источник
comment
Раскрытие информации: этот вопрос был задан мной.   -  person Rui Barradas    schedule 15.12.2019
comment
@akrun - что ты имеешь в виду под dput? Вы можете увидеть, как выглядит df в таблице выше.   -  person gooponyagrinch    schedule 15.12.2019
comment
@akrun только что отредактировал скрипт, чтобы его было легко добавить в фрейм данных или, как вы считаете, лучше всего настроить его.   -  person gooponyagrinch    schedule 15.12.2019
comment
Ах, да, конечно. Спасибо, что поймали это. Отредактировал мой первоначальный пост.   -  person gooponyagrinch    schedule 15.12.2019
comment
@akrun Почему ты удалил свои комментарии?   -  person gooponyagrinch    schedule 15.12.2019
comment
Потому что вы его уже отформатировали и он больше не нужен   -  person akrun    schedule 15.12.2019
comment
Ах понял хаха. Спасибо. С нетерпением ждем вашего ответа!   -  person gooponyagrinch    schedule 15.12.2019
comment
Одна вещь, которую я пытаюсь понять, это то, как здесь меняются input. В вашем случае вы делаете filter с |. Если вам нужна иерархическая группа, это намного проще с library(data.table);dt1 <- as.data.table(df1); rollup(dt1, j = sum(step4), by = c("step1", "step2", "step3")), а затем выполните filter   -  person akrun    schedule 15.12.2019
comment
Также возможен вариант filter с filter_at   -  person akrun    schedule 15.12.2019
comment
Давайте продолжим обсуждение в чате.   -  person gooponyagrinch    schedule 15.12.2019
comment
@akrun Что бы вы ни думали, это лучший способ ответить на него, вы можете вносить любые изменения, которые хотите!   -  person gooponyagrinch    schedule 15.12.2019
comment
@akrun, кажется, ты знаешь это намного лучше, чем я, поэтому я более чем открыт для того, чтобы услышать, как ты это напишешь. Не беспокойтесь о том, чтобы полностью соблюдать мой первоначальный сценарий.   -  person gooponyagrinch    schedule 15.12.2019
comment
Извините, я попробовал, у меня появились другие вещи. Я должен идти. Я надеюсь, что вы получите ответ от кого-нибудь или еще попробуете позже. Спасибо   -  person akrun    schedule 15.12.2019
comment
@akrun Спасибо. Я буду продолжать попытки, но мне, вероятно, понадобится ваша помощь (при условии, что кто-то еще не ответит).   -  person gooponyagrinch    schedule 15.12.2019
comment
Уэлп, похоже, я не получаю ответа на этот вопрос :(   -  person gooponyagrinch    schedule 16.12.2019


Ответы (2)


Во-первых, нам нужно выяснить, по какому столбцу группировать. В этом случае я предполагаю, что это первый столбец с более чем 1 вариантом. Остальной код очень похож, за исключением того, что group_by_all заменяется на group_by_at.

output$table <- renderHighchart({

        bar <- abc()

        # find out which column to group by (first column with more than 1 distinct value)
        summ_column <- bar %>%
            summarise_all(~ length(unique(.))) %>% {colnames(.)[.>1]} %>% first()

        xyz <- bar %>% group_by_at(summ_column) %>% summarise(results = sum(step4))


        highchart() %>% hc_add_series(data = xyz, type = "column", hcaes(y = results),
                                      showInLegend = TRUE) %>% hc_add_theme(hc_theme_flat())


    })

Это не сработает, если вы выберете более 1 значения для одного параметра, но это решение должно быть очень похожим.

person Bas    schedule 16.12.2019

Похоже, вы ищете aggregate. Пожалуйста, проверьте следующее:

library(highcharter)
library(shiny)
library(shinyWidgets)
# library(dplyr)

DF <- data.frame(
  step1 = c('Region 1', 'Region 1', 'Region 1', 'Region 1', 'Region 2', 'Region 2', 'Region 2', 'Region 2', 'Region 3', 'Region 3', 'Region 3', 'Region 3'),
  step2 = c('District A', 'District A', 'District A', 'District B', 'District C', 'District C', 'District D', 'District D', 'District E', 'District E', 'District F', 'District F'),
  step3 = c('1A', '1A', '1B', '1B', '2C', '2D', '2D', '2D', '3E', '3E', '3E', '3F'),
  step4 = c(571,356,765,752,885,73,241,823,196,103,443,197),
  stringsAsFactors = FALSE)

ui <- fluidPage(
  fluidRow(
    column(
      width = 5, offset = 1,
      panel(
        selectizeGroupUI(
          id = "foo",
          params = list(
            Step1 = list(inputId = "step1", title = "Step1:"),
            Step2 = list(inputId = "step2", title = "Step2:"),
            Step3 = list(inputId = "step3", title = "Step3:")
          ))
      ),
      highchartOutput(outputId = "table")
    )
  )
)

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

  abc <- callModule(
    module = selectizeGroupServer,
    id = "foo",
    data = DF,
    vars = c("step1", "step2", "step3")
  )

  output$table <- renderHighchart({
    req(abc())
    bar <- aggregate(step4 ~ step1+step2, abc(), sum)
    highchart() %>% hc_add_series(data = bar, type = "column", hcaes(y = step4), showInLegend = TRUE) %>% hc_add_theme(hc_theme_flat())
  })

}

shinyApp(ui, server)

Результат

person ismirsehregal    schedule 16.12.2019