Запустите те же коды с данными и именами переменных, измененными в R - PullRequest
1 голос
/ 28 мая 2019

Мне нужно запустить очень похожие коды для 3 разных наборов данных. Мои текущие коды выглядят так:

## data a
a_dat2 <- merge(a_dat, zip, by = "zip", all.x = T)
a_dat2 <- a_dat2 %>%
group_by(zip) %>%
summarize(dist_a_min = min(dist))
## data b
b_dat2 <- merge(b_dat, zip, by = "zip", all.x = T)
    b_dat2 <- b_dat2 %>%
     group_by(zip) %>%
summarize(dist_b_min = min(dist))
## data c
c_dat2 <- merge(c_dat, zip, by = "zip", all.x = T)
    c_dat2 <- c_dat2 %>%
     group_by(zip) %>%
summarize(dist_c_min = min(dist))

Коды для набора данных 3 одинаковы, за исключением того, что имя данных различается: a_dat, b_dat, c_dat. Имя переменной dist также меняется: dist_a_min, dist_b_min, dist_c_min. Какую функцию / цикл можно использовать для сокращения кодов, чтобы мне не нужно было копировать и вставлять каждый набор данных отдельно?

1 Ответ

3 голосов
/ 28 мая 2019

Можно было бы разместить элементы в list с mget, выполнить цикл по list с imap, объединить (?left_join) с набором данных zip, сгруппированные по zip иполучить min из 'dist' при создании имени столбца на основе подстроки имени идентификатора

library(tidyverse)
mget(ls(pattern = "_dat2$")) %>%
        imap(~ left_join(.x, zip, by = 'zip') %>%
             group_by(zip) %>%
             summarise((! str_c('dist_', substr(.y, 1, 1), '_min')  :=  min(dist)))

Или другой вариант - создать функцию для повторяющихся задач

joinSumm <- function(dat, groupName, colName, data2) {
    groupName <- enquo(groupName)
    colName <- enquo(colName)
    nm1 <- str_c('dist_', str_sub(rlang::as_name(enquo(dat)), 1, 1), '_min')
    dat %>%
       left_join(data2, by = rlang::as_name(groupName)) %>%
        group_by(!! groupName) %>%
        summarise((!! nm1) := min(!! colName))

  }
joinSumm(a_dat2, zip, dist, zip)
joinSumm(b_dat2, zip, dist, zip)

Воспроизводимый пример со встроенным набором данных iris (без части соединения)

list(a_dat = iris, b_dat = iris, c_dat = iris) %>% 
      imap(~ .x %>% 
            group_by(Species) %>%
            summarise(!! str_c('dist_', substr(.y, 1, 1), '_min') := min(Sepal.Length)))
#$a_dat
# A tibble: 3 x 2
#  Species    dist_a_min
#  <fct>           <dbl>
#1 setosa            4.3
#2 versicolor        4.9
#3 virginica         4.9

#$b_dat
# A tibble: 3 x 2
#  Species    dist_b_min
#  <fct>           <dbl>
#1 setosa            4.3
#2 versicolor        4.9
#3 virginica         4.9

$c_dat
# A tibble: 3 x 2
#  Species    dist_c_min
#  <fct>           <dbl>
#1 setosa            4.3
#2 versicolor        4.9
#3 virginica         4.9
...