2

theshold <- c(0.001, 0.5, 0.1)

df$a df$b df$c - Recode levels based on level frequency of less than first threshold

df$x df$y df$x - Recode levels based on level frequency of less than second threshold

df$d df$e df$f - Recode levels based on level frequency of less than third threshold

Damien Conway
  • 41
  • 4
  • Please provide some sample data to accompany this. I imagine it'll be relatively straight-forward, I just don't want to take the time to guess at values and such (it's certainly likely I'll guess incorrectly, I'd rather get it right, and you know best :-). – r2evans Mar 31 '22 at 13:22
  • If it has already been coded as a factor variable and you now want to recode the factor, that may not be possible since the original values are not contained in the factor levels. – dcarlson Mar 31 '22 at 13:26
  • 1
    [here](https://stackoverflow.com/questions/62475357/aggregate-with-adjacent-group-if-value-falls-below-a-threshold) is a related, though perhaps not exactly the same post. It might provide some guidance, though. – DaveArmstrong Mar 31 '22 at 13:31

3 Answers3

4

You're looking for fct_lump_prop() from forcats.

library(forcats)
library(dplyr)

dat <- data.frame(base = c("A", "A", "A",
                           "B", "B",
                           "C",
                           "D"))

dat |> mutate(base0.2 = fct_lump_prop(base, 0.2),
              base0.3 = fct_lump_prop(base, 0.3))

Output

#>   base base0.2 base0.3
#> 1    A       A       A
#> 2    A       A       A
#> 3    A       A       A
#> 4    B       B   Other
#> 5    B       B   Other
#> 6    C   Other   Other
#> 7    D   Other   Other

Created on 2022-03-31 by the reprex package (v2.0.0)

Andrea M
  • 2,314
  • 1
  • 9
  • 27
1

There may be an easier tidy way of doing this, but you could write a little function that would implement this:

set.seed(519)
x <- sample(LETTERS[1:5], 1000, prob=c(.01,.1,.29,.3,.3), replace=TRUE)
x <- as.factor(x)
recode_thresh <- function(x, threshold = .15){
  tab <- table(x)/sum(table(x))
  levs <- levels(x)
  levs <- c(levs, "other")
  x <- as.character(x)
  if(any(tab < threshold)){
    x <- ifelse(x %in% names(tab)[which(tab < threshold)], "other", x)
  }
  levs <- intersect(levs, unique(x))
  factor(x, levels=levs)
}
x2 <- recode_thresh(x, threshold=.15)
table(x)/1000
#> x
#>     A     B     C     D     E 
#> 0.014 0.106 0.294 0.276 0.310
table(x2)/1000
#> x2
#>     C     D     E other 
#> 0.294 0.276 0.310 0.120

Created on 2022-03-31 by the reprex package (v2.0.1)

DaveArmstrong
  • 18,377
  • 2
  • 13
  • 25
0

with Andreas suggestion and further reading, i came up with the following which worked a treat. thanks

agg_cats_thresholds <- c(0.01, 0.05, 0.005, 0.001)
agg_cats_thresholds <- as.data.frame(agg_cats_thresholds)

#create the lists of variables

factor_columns1 <- c("a", "b","c", "d", "e")
factor_columns2 <- c("f")
factor_columns3 <- c("g")
factor_columns4 <- c("h", "i", "j", "k")

# Use fct_lump_prop to reduce the levels of the various factor variables

churn.ml[factor_columns1] <- lapply(churn.ml[factor_columns1], 
                           fct_lump_prop, prop = agg_cats_thresholds[1,] 
,other_level = 'other')

churn.ml[factor_columns2] <- lapply(churn.ml[factor_columns2], 
                                fct_lump_prop, prop = 
agg_cats_thresholds[2,] ,other_level = 'other')

churn.ml[factor_columns3] <- lapply(churn.ml[factor_columns3], 
                                fct_lump_prop, prop = 
agg_cats_thresholds[3,] ,other_level = 'other')
Damien Conway
  • 41
  • 4