Get top rows of a data.frame weighted by cumulated column values

Viewed 48

Let's say we have a date.frame containing a column with numbers. Now I only want to filter those rows which make up the top 75% regarding to the numeric column.

Here's an example and a clumsy solution:

library(tidyverse)

d <- tribble(
  ~name, ~value,
  "A", 40,
  "B", 20,
  "C", 10,
  "D", 10,
  "E",  5,
  "F",  5,
  "G",  3,
  "H",  3,
  "I",  3,
  "J",  1,
)

d %>% 
  arrange(desc(value)) %>% 
  mutate(
    relative_value = value / sum(value),
    cum_relative_value = cumsum(relative_value)
  ) %>% 
  filter(lag(cum_relative_value) <= 0.75 | is.na(lag(cum_relative_value))) 
#> # A tibble: 4 x 4
#>   name  value relative_value cum_relative_value
#>   <chr> <dbl>          <dbl>              <dbl>
#> 1 A        40            0.4                0.4
#> 2 B        20            0.2                0.6
#> 3 C        10            0.1                0.7
#> 4 D        10            0.1                0.8

Created on 2021-04-30 by the reprex package (v1.0.0)

As you can see I calculate the percentage of the cumulated values and filter with respect to this value. I have to use lag() to get the row which surpasses the 0.75 bound and is.na() to get the first row.

This really feels clumsy. I thought there should be a solution with slice_* or fct_lump_prop() but I can't figure it out.

So is there any nice "dplyr"-way?

3 Answers

What about this?

d %>%
  arrange(-value) %>%
  filter(
    lag(cumsum(prop.table(value)), default = 0) <= 0.75
  )

which gives

# A tibble: 4 x 2
  name  value
  <chr> <dbl>
1 A        40
2 B        20
3 C        10
4 D        10

There seems to be no such function. But the code could be simplified as follows:

d %>%
    arrange(desc(value)) %>%
    filter(cumsum(cumsum(value)/sum(value) >= 0.75) <= 1)
# # A tibble: 3 x 2
#   name  value
#   <chr> <dbl>
# 1 A        40
# 2 B        20
# 3 C        10
# 4 D        10

While I think the proposed solutions are quite reasonable and sensible, I've tried to figure out a way of doing this with fct_lump. However, I can't justify why I set the prop argument to 0.05 considering you wanted the top 0.75 cumulative frequencies, except for the fact that I added up the cumulative sums of values and realized all frequencies fewer than 5 percent will lead to the desired output:

library(dplyr)
library(forcats)

d %>% 
  mutate(name = fct_lump(name, prop = 0.05, w = value)) %>%
  filter(name != "Other")

# A tibble: 4 x 2
  name  value
  <fct> <dbl>
1 A        40
2 B        20
3 C        10
4 D        10

I again admit this is not sensible approach to the problem and I would happily delete this solution. I just wanted to show how it is done with forcats package funcitons.

Related