Keep Top Factors based on Grouped Weight

Viewed 20

Please have a look at the snippet at the end of the post. I am essentially looking for a cleaner way to obtain the same result. I have a tibble where the x column is a character vector (I did not translate it into a factor, but this is actually what it is). Each factor appears multiple times and it always has an associated numerical value (the w column in the tibble). I would like to keep the top 4 factors according to the sum of their associated w values and change everything else into an "other" factor. I achieve it below, but I wonder if there is a smarter way to do the same using e.g. forcats.

Any suggestion is appreciated

library(tidyverse)

df <- tibble(x=rep(letters[1:10], 10), w=seq(100))

df
#> # A tibble: 100 × 2
#>    x         w
#>    <chr> <int>
#>  1 a         1
#>  2 b         2
#>  3 c         3
#>  4 d         4
#>  5 e         5
#>  6 f         6
#>  7 g         7
#>  8 h         8
#>  9 i         9
#> 10 j        10
#> # … with 90 more rows

###detect the first 4 factors based on the w column

ff <- df |>
    group_by(x) |>
    summarise(w_tot=sum(w)) |>
    ungroup() |>
    arrange(desc(w_tot)) |>
    slice(1:4) |>
    pull(x)

ff
#> [1] "j" "i" "h" "g"

## recode the data

df_new <- df |>
    mutate(w=if_else(x %in% ff, x, "other"))

df_new
#> # A tibble: 100 × 2
#>    x     w    
#>    <chr> <chr>
#>  1 a     other
#>  2 b     other
#>  3 c     other
#>  4 d     other
#>  5 e     other
#>  6 f     other
#>  7 g     g    
#>  8 h     h    
#>  9 i     i    
#> 10 j     j    
#> # … with 90 more rows

Created on 2022-09-16 by the reprex package (v2.0.1)

1 Answers

It appears that I can pass a weight argument to fct_lump_n() so this works

library(tidyverse)
library(forcats)



df <- tibble(x=rep(letters[1:10], 10), w=seq(100))

df
#> # A tibble: 100 × 2
#>    x         w
#>    <chr> <int>
#>  1 a         1
#>  2 b         2
#>  3 c         3
#>  4 d         4
#>  5 e         5
#>  6 f         6
#>  7 g         7
#>  8 h         8
#>  9 i         9
#> 10 j        10
#> # … with 90 more rows

###detect the first 4 factors based on the w column

ff <- df |>
    group_by(x) |>
    summarise(w_tot=sum(w)) |>
    ungroup() |>
    arrange(desc(w_tot)) |>
    slice(1:4) |>
    pull(x)

ff
#> [1] "j" "i" "h" "g"

## recode the data

df_new <- df |>
    mutate(w=if_else(x %in% ff, x, "other"))

df_new
#> # A tibble: 100 × 2
#>    x     w    
#>    <chr> <chr>
#>  1 a     other
#>  2 b     other
#>  3 c     other
#>  4 d     other
#>  5 e     other
#>  6 f     other
#>  7 g     g    
#>  8 h     h    
#>  9 i     i    
#> 10 j     j    
#> # … with 90 more rows

df_new2 <- df |>
    mutate(x2=fct_lump_n(x,4, w))


df_new2
#> # A tibble: 100 × 3
#>    x         w x2   
#>    <chr> <int> <fct>
#>  1 a         1 Other
#>  2 b         2 Other
#>  3 c         3 Other
#>  4 d         4 Other
#>  5 e         5 Other
#>  6 f         6 Other
#>  7 g         7 g    
#>  8 h         8 h    
#>  9 i         9 i    
#> 10 j        10 j    
#> # … with 90 more rows

Created on 2022-09-16 by the reprex package (v2.0.1)

Related