Отрегулируйте функцию так, чтобы она проходила не по всем строкам, а только по всем строкам внутри групп.

Question

рассмотрим набор данных игрушки и функцию ниже: В основном, он просматривает строки набора данных df и ищет совпадения в соответствии с некоторыми критериями. Если есть совпадение, наблюдения совпадают по номеру строки одного из совпадений.

 dataset <- data.frame(id_dom = c(20, 20, 20, 250, 250, 250, 
                                  254, 254, 254),        
                       p201 = c(1, NA, 2, NA, NA, NA, 2, 1, 2), 
                       V2009 = c(63, 42, 64, 26, 5, 4, 69, 30, 68)
                       )
match1 <- function(i, df) {
  j <- 1:nrow(df)
  
  if(!is.na(df$p201[i])){
    l <- df$p201[i]
  } else{
    
    k <-  abs(df$V2009[i] - df$V2009[j]) <= 1
    l <- ifelse(any(k), which(k), i)
  }
  
  return(l)
}

Вот как я применил бы функцию:

dataset2 <- dataset %>%
  group_by(id_dom,
           index = map_dbl(seq(nrow(.)), 
                            ~ .x %>% match1(df = dataset))) %>%
  mutate(p201 = (first(na.omit(V2009)) - 1)*100)

Как видите , моя конечная цель - объединить наблюдения по index и id_dom. По этой причине было бы намного быстрее (и я думаю, что это также дало бы немного лучшие результаты), если бы i проходил только по строкам каждого id_dom группа, а не весь набор данных.

Я бы предпочел ответ, который:

i) Группирует не по id_dom в функции match1, а в труба. ii) Это позволяет мне написать что-то вроде map_dbl(seq(nrow(.)), ~ .x %>% match1(df = . )) - так что, если я создам переменную V2009 раньше, мне не нужно было разрывать цепочку перед запуском функции.

Спасибо !

Answer 1

Вы можете передавать только те переменные, которые необходимы функции, вместо передачи фрейма данных. Вот упрощенная функция match2.

match2 <- function(x, y, val) {
    if(is.na(x))
      return(which.max(abs(y - val) <= 1))
    else return(x)
} 

, и ее можно использовать как:

library(dplyr)
library(purrr)
dataset3 <- dataset %>%
              group_by(id_dom, index = map2_dbl(p201, V2009, match2, V2009)) %>%
              mutate(p201 = (first(na.omit(V2009)) - 1)*100)

dataset3
# A tibble: 9 x 4
# Groups:   id_dom, index [6]
#  id_dom  p201 V2009 index
#   <dbl> <dbl> <dbl> <dbl>
#1     20  6200    63     1
#2     20  4100    42     2
#3     20  4100    64     2
#4    250  2500    26     4
#5    250   400     5     5
#6    250   400     4     5
#7    254  6800    69     2
#8    254  2900    30     1
#9    254  6800    68     2

Это дает результат, аналогичный dataset2, который можно проверить:

identical(dataset2, dataset3)
#[1] TRUE

Answer 2

Мы можем использовать cur_data вместо dataset в match после группировки по 'id_dom'

library(dplyr)
library(purrr)
dataset %>%
     # // grouped by id_dom
     group_by(id_dom) %>%
     # // create new group by looping over the sequence of rows
     # // apply the match1
     group_by(index = map_dbl(seq(n()), ~ 
         match1(.x, df = cur_data())), .add = TRUE) %>%
     # // update the p201
     mutate(p201 = (first(na.omit(V2009)) - 1)*100)

Или используйте group_split

dataset %>% 
   group_split(id_dom) %>%
   map_dfr(., ~ .x %>%
                group_by(index = map_dbl(row_number(),
                  ~ match1(.x, df = cur_data()))) %>%
                 mutate(p201 = (first(na.omit(V2009)) - 1)*100))