团队数量增加的动态排名答案

【问题标题】：Dynamic rankings with increasing number of teams团队数量增加的动态排名
【发布时间】：2015-08-27 03:16:59
【问题描述】：

我的数据的小代表：

Date <- as.Date(rep(c("2015-05-14", "2015-05-15","2015-05-16"),c(4,2,1)))
TEAM1 <- c("GSW","SAS","MIL","ATL","GSW","SAC","LAL")
TEAM2 <- c("HOU","MIN","NOP","LAL","SAS","TOR","GSW")
PCW_TEAM1 <- c(0.88,0.72,0.34,0.46,0.87,0.28,0.24)
PCW_TEAM2 <- c(0.67,0.31,0.52,0.23,0.74,0.48,0.90)
df <- data.frame(cbind(Date,TEAM1,TEAM2,PCW_TEAM1,PCW_TEAM2), stringsAsFactors=F)
df

    Date TEAM1 TEAM2 PCW_TEAM1 PCW_TEAM2
 1 16569   GSW   HOU      0.88      0.67
 2 16569   SAS   MIN      0.72      0.31
 3 16569   MIL   NOP      0.34      0.52
 4 16569   ATL   LAL      0.46      0.23
 5 16570   GSW   SAS      0.87      0.74
 6 16570   SAC   TOR      0.28      0.48
 7 16571   LAL   GSW      0.24       0.9

想象一下这是 NBA 赛季的前 7 场比赛。第一个日期 (16569) 有四场比赛，因此排名将超过 8。但是，一旦我们添加下一个日期 (16570)，就会有两场比赛，而且只有两支新球队，因为 GSW 和 SAS 已经在第一场比赛日期。

我想根据最后可用日期的获胜百分比对独特的团队进行排名。输出如下所示：

   Date TEAM1 TEAM2 PCW_TEAM1 PCW_TEAM2 RANK_TEAM1 RANK_TEAM2
1 16569   GSW   HOU      0.88      0.67          1          3
2 16569   SAS   MIN      0.72      0.31          2          7
3 16569   MIL   NOP      0.34      0.52          6          4
4 16569   ATL   LAL      0.46      0.23          5          8
5 16570   GSW   SAS      0.87      0.74          1          2
6 16570   SAC   TOR      0.28      0.48          9          5
7 16571   LAL   GSW      0.24       0.9         10          1

请注意，在第 5 行，GSW 的获胜百分比为 0.87，排名为 1。在第一行，获胜百分比更高 (0.88)，但也是 GSW。

在此示例中，有 7 场比赛和 10 支独特的球队。根据真实数据，有 30 个独特的团队。

unique(c(TEAM1,TEAM2))
[1] "GSW" "SAS" "MIL" "ATL" "SAC" "LAL" "HOU" "MIN" "NOP" "TOR"

我想创建一个向量来收集每个独特团队的最后可用获胜百分比，然后根据该信息对团队进行排名，但不知道如何去做，或者这是否是最佳方法。

【问题讨论】：

标签： r dynamic indexing rank

【解决方案1】：

我认为以长格式处理这些数据会更容易。下面代码中的总体思路是扩展数据，以便每个团队在每个日期都有一个条目（在他们不参加比赛时填充 NA 值）。然后，按团队对数据进行分组，并将获胜百分比向前推进以填充 NA 值（使用 zoo 中的 na.locf）以确定每个日期的排名。然后，转换回宽格式。

## Rearrange the data into a long format
long <- do.call(rbind, lapply(1:2, function(i)
    setNames(df[,c("Date", grep(i, names(df), value=T))], c("Date", "TEAM", "PCW"))))
long$index <- rep(1:nrow(df))  # used to transform back to wide

## Expand to include an entry for each team at each date
dat <- merge(expand.grid(Date=unique(long$Date), TEAM=unique(long$TEAM)), long, all=T)

## Fill in the NA values for each team, carrying forward previous win%
library(zoo)  # na.locf
dat <- cbind(do.call(rbind, lapply(split(dat, dat$TEAM), function(x)
    transform(x, PCW=na.locf(PCW, na.rm=F)))))

## Then, group by date and order (I would leave it in this form)
library(dplyr)
dat %>% group_by(Date) %>%
  mutate(RANK=match(TEAM, TEAM[order(PCW, decreasing = T)])) -> res

## Put it back into wide format
out <- do.call(rbind, lapply(split(res[,-which(names(res)=="index")], res$index), function(x)
    setNames(cbind(x[1,], x[2,-1]), c("Date", paste0(names(x)[-1], 1), paste0(names(x)[-1], 2)))))
#    Date TEAM1 PCW1 RANK1 TEAM2 PCW2 RANK2
# 1 16569   GSW 0.88     1   HOU 0.67     3
# 2 16569   SAS 0.72     2   MIN 0.31     7
# 3 16569   MIL 0.34     6   NOP 0.52     4
# 4 16569   ATL 0.46     5   LAL 0.23     8
# 5 16570   GSW 0.87     1   SAS 0.74     2
# 6 16570   SAC 0.28     9   TOR 0.48     5
# 7 16571   GSW  0.9     1   LAL 0.24    10

请注意，我没有采取预防措施来确保 TEAM1 和 TEAM2 保持正确的顺序，例如，在最后一行中，与您期望的输出相比，团队被切换了。

【讨论】：

【解决方案2】：

TEAMs <- c(TEAM1,TEAM2)
teamsall <- unique(TEAMs)
PCWs <- c(PCW_TEAM1,PCW_TEAM2)
Dates <- c(Date,Date)
u = order(sapply(1:length(teamsall),function(x) {u=match(TEAMs,teamsall)==x;PCWs[u][which.max(Dates[u])]}),decreasing=T)
df$RANK1 = match(TEAM1,teamsall[u])
df$RANK2 = match(TEAM2,teamsall[u])
df

我认为这可能是其中一种方式。

【讨论】：