R Dataframe 跨列组级摘要

Question

我有一个像下面这样的数据框（真实数据有更多的人和地点）：

Year   Player    Location
2005   Phelan    Chicago 
2007   Phelan    Boston 
2008   Phelan    Boston 
2010   Phelan    Chicago  
2011   Phelan    Boston  
        
2002   John      New York 
2006   John      New York 
2007   John      Boston 
2009   John      Chicago

我想计算位置级别度量，但仍考虑玩家级别信息。具体来说，我想为每个位置计算一个加权度量，描述有多少个不同的先前位置导致当前位置。

比如芝加哥，2005年Phelan就来了，然后就走了。留在波士顿后，他 return 于 2010 年接受教育。约翰在纽约和波士顿逗留后于 2009 年来到芝加哥。请注意，一个人可以离开并 return 到同一个地方（例如 Phelan 的芝加哥），对于这种情况，我只想考虑最近的停留以避免 double/multiple 计数。

Phelan最近一次去芝加哥之前，在芝加哥待了2年（2005-2006，假设2006年Phelan待在芝加哥），在波士顿待了3年（2007-2009，假设2009年Phelan待在波士顿）。在约翰最近一次留在芝加哥之前，他在纽约呆了 5 年（2002-2006），在波士顿呆了 2 年（2007-2008）。对于芝加哥来说，根据Phelan和John之前在芝加哥的经历，积累了2+3+5+2=12年的以往经验。这12年中，芝加哥有2年，波士顿有5年，纽约有5年。然后我们可以通过 (2/12)^2+(5/12)^2+(5/12)^2=0.375 计算芝加哥的度量。这个数字是芝加哥的加权度量，描述了有多少个不同的先前位置导致芝加哥。

波士顿方面，Phelan在最近一次留在波士顿之前，在芝加哥待了3年（2005-2008，2009），在波士顿待了3年（2007-2009）。在约翰最近一次留在波士顿之前，他在纽约呆了 5 年（2002-2006 年）。然后我们可以通过 (3/11)^2+(3/11)^2+(5/11)^2=0.355.

计算纽约的度量

下面是示例输出：

Location       Weighted Measure
Chicago        0.375
Boston         0.355
New York       NA

Answer 1

这是一个相当冗长的方法，使用 tidyr、dplyr 和 data.table::rleid

创建一个更完整的 df 版本，称为 df_complete，它可以填补任何缺失的（假设年份），并标记每个玩家在每个位置的最终访问

library(tidyr); library(dplyr); library(data.table)

df_complete = df %>% 
  group_by(Player) %>%
  complete(Year = seq(min(Year), max(Year),1)) %>%
  fill(Location) %>% 
  mutate(tag = data.table::rleid(Location)) %>%
  group_by(Player,Location) %>%
  mutate(tag=max(tag)==tag) %>% 
  ungroup()

接下来，对于原始帧 df 中的每个唯一位置，我们使用 lapply() 来：

按玩家限制在到达该位置之前有经验的行
按先前位置计算年份
估计加权测量值(wt)，如果没有经验NA
return单排框

我们将上述步骤包装在 do.call(rbind,...) 调用中 return 结果

do.call(
  rbind,
  lapply(unique(df$Location), \(loc) {
  ct = df_complete %>% 
    group_by(Player) %>% 
    mutate(minyear = min(Year[Location==loc & tag])) %>% 
    ungroup() %>% 
    filter(is.finite(minyear),Year<minyear) %>% 
    count(Location) %>% 
    pull(n)

  wt = if_else(length(ct)>0, sum((ct/sum(ct))^2), as.double(NA))
           
  data.frame(Locations = loc,"Weighted Measure" = wt)
}))

输出：

  Locations Weighted.Measure
1   Chicago        0.3750000
2    Boston        0.3553719
3  New York               NA

Answer 2

这是一个扩展到所有 player-years 的答案，计算在那一年之前在每个先前位置花费了多少年，过滤到只有移动的年份，然后计算分数：

library(tidyverse)

df <- tribble(~Year,   ~Player,    ~Location,
              2005,   "Phelan",    "Chicago", 
              2007,   "Phelan",    "Boston", 
              2008,   "Phelan",    "Boston", 
              2010,   "Phelan",    "Chicago",  
              2011,   "Phelan",    "Boston" , 
              2002,   "John",    "New York", 
              2006,   "John",    "New York", 
              2007,   "John",    "Boston", 
              2009,   "John",    "Chicago")

locations <- unique(df$Location)

df %>% 
  group_by(Player) %>% 
  complete(Year = full_seq(Year, 1)) %>% 
  fill(Location) %>% 
  arrange(Player, Year) %>% 
  add_column(!!!set_names(rep(NA_real_, length(locations)), locations)) %>% 
  mutate(across(-c(Year, Location), ~lag(cumsum(Location == cur_column()))),
         move = Location != lag(Location)) %>% 
  filter(move) %>% 
  group_by(Location, Player) %>% 
  slice_tail(n = 1) %>% 
  pivot_longer(all_of(locations)) %>% 
  group_by(Location, name) %>% 
  summarise(yrs = sum(value)) %>% 
  summarise(score = sum(map_dbl(yrs, ~.^2))/ sum(yrs)^2)

#> # A tibble: 2 × 2
#>   Location score
#>   <chr>    <dbl>
#> 1 Boston   0.355
#> 2 Chicago  0.375

^{由 reprex package (v2.0.1)}

于 2022-05-26 创建

R Dataframe 跨列组级摘要

R Dataframe Cross-Column Group-Level Summary

r

dataframe

dplyr