Добавить тысячи столбцов, используя if_else / Summaze в цепочке dplyr? - PullRequest
Новая
       17

Добавить тысячи столбцов, используя if_else / Summaze в цепочке dplyr?

3 голосов
/ 05 февраля 2020

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

Я использую dplyr, чтобы сделать это, и код ниже работает отлично. Однако я жестко кодирую разные пороги (25 франшиз, 50 франшиз и т. Д. 1011 *.) И хотел бы найти решение, в котором я мог бы создать переменные для нескольких пороговых значений - например, для всех чисел от 25: 1000. Есть ли простой и программный c способ сделать это? Я пробовал циклы в цепочке dplyr, но борюсь с тем, как добавить новые переменные с принципиальными именами (имя должно включать порог для легкой ссылки в последующем коде). Спасибо за любую помощь!

примечание: не стесняйтесь редактировать заголовок / вопрос, чтобы сделать его более понятным. 

x <- data.frame("state" = c(rep("mi",12),
                            rep("tx",12)),
                "group" = c(rep("grp1",6),rep("grp2",6),
                            rep("grp3",6),rep("grp4",6)), 
                "year"  = c(rep(1990,3),rep(1991,3),rep(1992,3),rep(1993,3),
                            rep(1990,3),rep(1991,3),rep(1992,3),rep(1993,3)),
                "value" = c(seq(20,1200, by = 100),
                            seq(20,2400, by = 200)))

x_agg <- x %>%
  group_by(state, group, year) %>%
  summarise(value_tot = sum(value)) %>%
  mutate(val20   = ifelse(value_tot >= 20,   yes = 1, no = 0),
         val50   = ifelse(value_tot >= 50,   yes = 1, no = 0),
         val100  = ifelse(value_tot >= 100,  yes = 1, no = 0),
         val250  = ifelse(value_tot >= 250,  yes = 1, no = 0),
         val500  = ifelse(value_tot >= 500,  yes = 1, no = 0),
         val750  = ifelse(value_tot >= 750,  yes = 1, no = 0),
         val1000 = ifelse(value_tot >= 1000, yes = 1, no = 0)) %>%
  ungroup() %>%
  group_by(state, year) %>%
  summarise(val20   = as.numeric(any(val20 == 1)),
            val50   = as.numeric(any(val50 == 1)),
            val100  = as.numeric(any(val100 == 1)),
            val250  = as.numeric(any(val250 == 1)),
            val500  = as.numeric(any(val500 == 1)),
            val750  = as.numeric(any(val750 == 1)),
            val1000 = as.numeric(any(val1000 == 1)),) %>%
  ungroup()

Ответы [ 4 ]

2 голосов
/ 05 февраля 2020

Вот один из способов для вас. После объединения данных я переопределил группы, снова добавив year. Затем для каждой группы я хотел выполнить логические проверки. В каждой группе есть одно конкретное значение c value_tot. У меня были логические проверки этого значения с использованием значений критерия (т. Е. 20, 50, 100, 250, 500, 750 и 1000). Возвращенные логические значения преобразуются в числа и добавляются во фрейм данных со значениями критерия. К этому времени у вас есть кадр данных в каждой ячейке foo. Я использовал unnest и создал результат. Это все еще в длинном формате. Учитывая, что вы хотите широкоформатные данные, я использовал pivot_wider() в конце. 

library(tidyverse)

x %>%
group_by(state, group, year) %>%
summarise(value_tot = sum(value)) %>%
group_by(year, add = TRUE) %>% 
mutate(foo = list(tibble(check = sapply(c(20, 50, 100, 250, 500, 750, 1000),
                                        function(x) as.numeric(value_tot >= x)),
                         category = c(20, 50, 100, 250, 500, 750, 1000)))) %>% 
unnest(foo) %>% 
pivot_wider(id_cols = state:year, names_from = category, names_prefix = "val",
            values_from = "check")

  state group  year val20 val50 val100 val250 val500 val750 val1000
  <fct> <fct> <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>   <dbl>
1 mi    grp1   1990     1     1      1      1      0      0       0
2 mi    grp1   1991     1     1      1      1      1      1       1
3 mi    grp2   1992     1     1      1      1      1      1       1
4 mi    grp2   1993     1     1      1      1      1      1       1
5 tx    grp3   1990     1     1      1      1      1      0       0
6 tx    grp3   1991     1     1      1      1      1      1       1
7 tx    grp4   1992     1     1      1      1      1      1       1
8 tx    grp4   1993     1     1      1      1      1      1       1
2 голосов
/ 05 февраля 2020

вы можете использовать lapply для создания списка функций и mutate_at для их применения. Я начинаю с x, который вы предоставляете. Просто измените seq_val, чтобы получить последовательность чисел, которую вы хотите проверить. 

seq_val <- seq(1000, 10000, by = 1000)
val_funs <- lapply(seq_val, function(x) (function(a) as.integer(a >= x)))
names(val_funs) <- paste0("val", seq_val)

agg1 <- x %>%
  group_by(state, group, year) %>%
  summarise(value_tot = sum(value)) %>%
  ungroup() %>%
  mutate_at(
    "value_tot", 
    val_funs
  )

agg1 вывод: 

# A tibble: 8 x 14
  state group  year value_tot val1000 val2000 val3000 val4000 val5000 val6000
  <fct> <fct> <dbl>     <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
1 mi    grp1   1990       360       0       0       0       0       0       0
2 mi    grp1   1991      1260       1       0       0       0       0       0
3 mi    grp2   1992      2160       1       1       0       0       0       0
4 mi    grp2   1993      3060       1       1       1       0       0       0
5 tx    grp3   1990       660       0       0       0       0       0       0
6 tx    grp3   1991      2460       1       1       0       0       0       0
7 tx    grp4   1992      4260       1       1       1       1       0       0
8 tx    grp4   1993      6060       1       1       1       1       1       1
# … with 4 more variables: val7000 <dbl>, val8000 <dbl>, val9000 <dbl>,
#   val10000 <dbl>

Затем summarise_at с any

agg1 %>%
  group_by(state, year) %>%
  summarise_at(
    vars(matches("val[^u]")),
    function(x) as.numeric(any(x == 1))
  )

вывод: 

# A tibble: 8 x 12
# Groups:   state [2]
  state  year val1000 val2000 val3000 val4000 val5000 val6000 val7000 val8000
  <fct> <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
1 mi     1990       0       0       0       0       0       0       0       0
2 mi     1991       1       0       0       0       0       0       0       0
3 mi     1992       1       1       0       0       0       0       0       0
4 mi     1993       1       1       1       0       0       0       0       0
5 tx     1990       0       0       0       0       0       0       0       0
6 tx     1991       1       1       0       0       0       0       0       0
7 tx     1992       1       1       1       1       0       0       0       0
8 tx     1993       1       1       1       1       1       1       0       0
# … with 2 more variables: val9000 <dbl>, val10000 <dbl>
1 голос
/ 05 февраля 2020

Я бы попробовал, как здесь, с lapply и join на таблицах с кратным числом. В treshold вы определяете столбцы. 

library("dplyr")

x <- data.frame("state" = c(rep("mi",12),
                            rep("tx",12)),
                "group" = c(rep("grp1",6),rep("grp2",6),
                            rep("grp3",6),rep("grp4",6)), 
                "year"  = c(rep(1990,3),rep(1991,3),rep(1992,3),rep(1993,3),
                            rep(1990,3),rep(1991,3),rep(1992,3),rep(1993,3)),
                "value" = c(seq(20,1200, by = 100),
                            seq(20,2400, by = 200)))

treshold <- c(20, 50, 100, 250, 500, 750, 1000)

lapply(as.list(treshold), function(tres){

  name <- paste0("val", tres)

  x %>% 
    group_by(state, group, year) %>% 
    summarise(value_tot = sum(value)) %>%
    mutate(!!name := as.integer(value_tot >= tres)) %>% 
    ungroup() %>% 
    group_by(state, year) %>%
    summarise(!!name := as.numeric(any(!!sym(name) == 1)))

}) %>% Reduce(function(d1, d2) full_join(d1, d2, by = c("state", "year")), .)
0 голосов
/ 05 февраля 2020 
valueExceeds <- function(df, n){
    variableName <- paste0("val", n)
    df %>%
        group_by(state, group, year) %>%
        summarise(value_tot = sum(value)) %>%
        mutate(!!variableName := as.integer(value_tot >= n))
}

x %>%
    valueExceeds(20)

выводит это 

  state group  year value_tot val20
  <fct> <fct> <dbl>     <dbl> <int>
1 mi    grp1   1990       360     1
2 mi    grp1   1991      1260     1
3 mi    grp2   1992      2160     1
4 mi    grp2   1993      3060     1
5 tx    grp3   1990       660     1
6 tx    grp3   1991      2460     1
7 tx    grp4   1992      4260     1
8 tx    grp4   1993      6060     1
...