这在任何方面都不是微不足道的：

library(dplyr)
library(tidyr)
library(purrr)
library(tibble)
library(janitor)
library(gt)

df1 <- df %>% 
  group_by(Location) %>% 
  mutate(attempts = sum(!is.na(Success)),
         yeses = sum(Success == "yes", na.rm = TRUE),
         Success_rate = (yeses/attempts)*100) 
  
df2 <- df1 %>% 
  summarise(avgother = mean(Success_rate)) %>% 
  mutate(avgother = map_dbl(row_number(), ~mean(avgother[-.x])))
  )

df %>% 
  group_by(Location) %>% 
  summarise(attempts = sum(!is.na(Success)),
         yeses = sum(Success == "yes", na.rm = TRUE),
         Success_rate = (yeses/attempts)*100) %>% 
  bind_cols(avgother= round(df2$avgother, 1)) %>% 
  mutate(comp.avg = Success_rate - avgother) %>% 
  mutate(`attempts` = paste0("(N=", attempts, ")"),
         Success_rate = paste0(round(Success_rate, 1), "%")) %>% 
  select(-yeses) %>% 
  mutate(comp.avg = ifelse(comp.avg >0, paste0("(+",round(comp.avg, 1),")"), paste0("(",round(comp.avg,1),")"))) %>% 
  t() %>% 
  as.data.frame() %>% 
  rownames_to_column("Location") %>% 
  row_to_names(row_number = 1) %>% 
  gt()

来自@TarJae的回答很好，类似的方法与下面的flextable。

library(dplyr)
library(flextable)

temp <- df |> 
  group_by(Location) |> 
  summarise(Attempts = sum(!is.na(Success)), 
            Successful = sum(ifelse(Success=="yes", 1,0), na.rm = T)) |> 
  ungroup() |> 
  mutate(success_rate = round(Successful / Attempts, 3)*100) |> 
  mutate(excl.mean = (sum(success_rate) - success_rate)/(n()-1)) |> 
  mutate(comp.avg = round(success_rate - excl.mean,1)) |> 
  mutate(success_rate = paste0(formatC(signif(success_rate,digits=3),
                                digits=3,format="fg", flag="#"), "%"),
         comp.avg = ifelse(comp.avg >=0,
                           paste0("(+", comp.avg, ")"),
                           paste0("(", comp.avg, ")"))
         ) |> 
  select(-c(Successful, excl.mean)) |> 
  t() |> 
  as.data.frame()

temp <- cbind(Col1 = c("Location", "# of attempts", "Success rate", "comp. avg."),
              temp)

ft <- flextable(temp)
ft <- theme_vanilla(ft)
ft <- delete_part(ft, part = "header")
ft <- hline_top(ft)
ft <- border_inner_v(ft)
ft <- border_outer(ft)
ft