调整 function 使其不是遍历所有行，而是仅遍历组内的所有行

Question

考虑下面的玩具数据集和 function： 基本上，它遍历数据集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)
}

这就是我应用 function 的方式：

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 function 中，而是放在 pipe 中。 ii) 这使我可以编写类似于map_dbl(seq(nrow(.)), ~.x %>% match1(df =. ))的东西 - 这样如果我之前创建V2009变量，我就不需要在运行 function 之前断开链条。

谢谢！

Answer 1

您可以只传递 function 中需要的变量，而不是传递 dataframe。 这是一个简化的 function 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

通过 'id_dom' 分组后，我们可以在match中使用cur_data而不是dataset

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))