随着时间的推移保留前 n% 的数据

Question

我有一个图表，其中包含每个 NHL 球员随时间推移的累积进球数：

如您所见，当前图表上的玩家太多了。我只想保留前 10% 的数据（比如说），但回顾往年。例如，如果一名球员在 1995 年不在前 10%，但到 2000 年将进入前 10%，我想保留该球员的所有观察结果。

这是我尝试过的：

playerID <- c(1,2,3,1,2,3,1,2,3,1,2,3)
year <- c(2002,2000,2000,2003,2001,2001,2000,2002,2002,2001,2003,2003)
goals <- c(25,21,27,31,39,34,42,44,46,59,55,53)
my_data <- data.frame(playerID, year, goals)

cumulative_data <- my_data %>%
  group_by(playerID) %>%
  arrange(playerID, year) %>%
  mutate(cumsum_goals=cumsum(goals))

ggplot(data=subset(cumulative_data, percent_rank(cumsum_goals) > .90), aes(x=year, y=cumsum_goals, group=playerID)) +
  geom_line() +
  xlab("Year") +
  ylab("Total Goals")

但这只给出了总体数据的前 10%，而不是按年计算的前 10%。

Answer 1

在挑选前 10% 时，您只需要担心每个玩家的最终总数，即总和。您可以在单独的表中计算，然后使用它来过滤绘图的数据：

top_players = my_data %>%
    group_by(playerID) %>%
    summarize(total_goals = sum(goals)) %>%
    # Cutoff of 0.9 won't work in the example dataset so have changed
    #  it to 0.5, change back to 0.9 for full dataset
    mutate(top10 = percent_rank(total_goals) > 0.5) %>%
    filter(top10)

ggplot(cumulative_data %>% filter(playerID %in% top_players$playerID),
       aes(x=year, y=cumsum_goals, group=playerID)) +
    geom_line() +
    xlab("Year") +
    ylab("Total Goals")

Answer 2

你的 10% 可以用 2 种方式解释：在任何给定年份中进入前 10% 的球员或在当年累计目标中进入前 10% 的球员。我从您对by 的使用（在WILL BE in the top 10% by 2000）和您对cumsum() 的使用中得知您的意思是后者。

为了更好地说明，我将您的截止值更改为 40%（否则不会选择您的任何球员）和 goals 数据（您的值彼此如此接近以至于很难只有一些选择的球员。你的价值观也被排序了，随着时间的推移，球员每年进的球更多，这可能会混淆对结果中排序内容的解释。

library(tidyverse)

# Your data
playerID <- rep(1:3, 4)
year <- c(2002, 2000, 2000, 2003, 2001, 2001, 2000, 2002, 2002, 2001, 2003, 2003)
goals <- c(0, 55, 34, 0, 39, 27, 5, 44, 46, 0, 21, 40) # I changed some values
my_data <- data.frame(playerID, year, goals)

# Create a vector of unique seasons to pass to purrr::map()
seasons <- unique(my_data$year)

# Create a function which selects players above the cutoff for any given season
# (taking into account all seasons up to that one)
select_player <- function(season) {
  total_goals <- my_data %>%
    filter(year <= season) %>%
    summarise(sum(goals)) %>%
    simplify()
  my_data %>%
    filter(year <= season) %>%
    group_by(playerID) %>%
    summarise(rank = sum(goals) / total_goals) %>%
    filter(rank >= 0.4) %>% # change this to 0.9 if you want a 10% cutoff
    select(playerID) %>%
    simplify()
}

# Pass your seasons vector and your function to purrr::map()
# to get the result for all years in a vectorized fashion 
# (equivalent of a for loop but in a functional programming framework).
# And select unique values of the result to combine all years.
# This is your list of selected playerIDs.
selection <- unique(as_vector(map(seasons, select_player)))

# Create a data frame with your selection and the cumsums to plot
my_data_select <- 
  my_data %>%
  filter(playerID %in% selection) %>%
  arrange(playerID, year) %>%
  group_by(playerID) %>% 
  mutate(cumsum_goals = cumsum(goals))

# Plot your selection
ggplot(my_data_select, aes(x = year, y = cumsum_goals, group = playerID)) +
  geom_line() +
  xlab("Year") +
  ylab("Total Goals")