аккуратное решение для исключения group_by

Question

Мне нужно рассчитать чистые оценки промоутеров для сотрудников на основе результатов опроса клиентов.В приведенном ниже примере я знаю, как использовать group_by для применения функции для получения баллов за группу или за каждого отдельного сотрудника.Однако, что мне нужно, это групповой балл, исключая сотрудника.Я не могу понять, как это сделать с помощью dplyr или tidyr.

# toy example
library(dplyr)
net_promoter_score <- function(v) ((sum(v>=9,na.rm=T)-sum(v<=6,na.rm=T))/sum(!is.na(v))*100)
set.seed(1)
df <- data.frame( employee = sample(c("John","Vera","Amy","Bruce"),100,replace = T),
                  customer_service_score = sample(0:10,100,replace=T,prob=c(0.15,0.15,rep(0.15/7,7),0.25,0.3))
                  )
df <- df %>%
  mutate(group = ifelse(employee %in% c("John","Vera"),"A","B"))
df %>% head
  employee customer_service_score group
1     Vera                      1     A
2     Vera                      9     A
3      Amy                     10     B
4    Bruce                      3     B
5     John                      1     A
6    Bruce                     10     B

# example of peer net promoter score calculated for group A without Amy.  I need this done for all employees.
Amy_peer_score = df %>% filter(employee!="Amy",group=="A\B") %>% select(customer_service_score) %>% net_promoter_score
Amy_peer_score
[1] -11.11111

Answer 1

Один из вариантов - сгруппировать по «group», затем перебрать unique «employee», найти строки «customer_service_score», где «employee» не является уникальным «employee», и применить net_promoter_score

library(tidyverse)
df %>% 
    group_by(group) %>%
    summarise(score = list(map(unique(employee), ~ 
        tibble(employee_excluded = .x,   
          score = net_promoter_score(customer_service_score[employee != .x]))))) %>% 
    unnest %>% 
    unnest
# A tibble: 8 x 3
#  group employee_excluded score
#  <fct> <fct>             <dbl>
#1 A     Amy                58.1
#2 A     Vera               46.2
#3 A     Bruce              59.1
#4 A     John               45.2
#5 B     Vera               22.2
#6 B     Bruce              26.5
#7 B     John               37.8
#8 B     Amy                45.9

---

Или используя data.table

library(data.table)
setDT(df)[, .(employee_excluded = unique(employee),
    score = unlist(lapply(unique(employee), 
    function(x) net_promoter_score(customer_service_score[employee != x])))),
            group]

---

Если мы используем измененную функцию

net_promoter_score <- function(d,col_name) {
  ((sum(d[[col_name]]>=9,na.rm=TRUE)-
    sum(d[[col_name]]<=6,na.rm=TRUE))/sum(!is.na(d[[col_name]]))*100)
 }

, тогда мы можемизменить код

df %>%
    group_by(group) %>%
    nest %>%
    mutate(data = map(data, ~ 
           .x %>% 
             distinct(employee) %>% 
             pull(employee) %>% 
             map_df(function(x) 
                .x %>% 
                   filter(employee != x) %>%
                   summarise(employee_excluded = x,
                             score = net_promoter_score(., 
                               "customer_service_score"))) )) %>% 
     unnest
# A tibble: 8 x 3
#  group employee_excluded score
#  <fct> <fct>             <dbl>
#1 A     Amy                58.1
#2 A     Vera               46.2
#3 A     Bruce              59.1
#4 A     John               45.2
#5 B     Vera               22.2
#6 B     Bruce              26.5
#7 B     John               37.8
#8 B     Amy                45.9