10
$\begingroup$

Wondering if anyone has run across a package/function in R that will combine levels of a factor whose proportion of all the levels in a factor is less than some threshold? Specifically, one of the first steps in data preparation I conduct is to collapse sparse levels of factors together (say into a level called 'Other') that do not constitute at least, say, 2% of the total. This is done unsupervised and is done when the objective is to model some activity in marketing (not fraud detection, where those very small occurrences could be extremely important). I am looking for a function that will collapse levels until some threshold proportion is met.

UPDATE:

Thanks to these great suggestions I wrote a function pretty easily. I did realize though that it was possible to collapse levels with proportion < the minimum and still have that recoded level be < the minimum, requiring the addition of the lowest level with proportion > the minimum. Likely can be more efficient but it appears to work. The next enhancement would be to figure out how to capture the "rules" for applying the collapse logic to new data (a validation set or future data).

collapseFactors<- function(tableName,minPercent=5,fillIn ="RECODED" )
{
    for (i in 1:ncol(tableName))
        {   

            if(is.factor(tableName[,i]) == TRUE) #process just factors
            {


                sortedTable<-sort(prop.table(table(tableName[,i])))
                numberToCollapse<-length(sortedTable[sortedTable<(minPercent/100)])

                if (sum(sortedTable[1:numberToCollapse])<(minPercent/100))
                    {
                        numberToCollapse=numberToCollapse+1 #add next level if < minPercent
                    }

                if(numberToCollapse>1) #if not >1 then nothing to collapse
                {
                    lf <- names(sortedTable[1:numberToCollapse])
                    levels(tableName[,i])[levels(tableName[,i]) %in% lf] <- fillIn
                }
            }#end if a factor


        }#end for loop

    return(tableName)

}#end function
$\endgroup$
11
$\begingroup$

It seems it's just a matter of "releveling" the factor; no need to compute partial sums or make a copy of the original vector. E.g.,

set.seed(101)
a <- factor(LETTERS[sample(5, 150, replace=TRUE, 
                           prob=c(.1, .15, rep(.75/3,3)))])
p <- 1/5
lf <- names(which(prop.table(table(a)) < p))
levels(a)[levels(a) %in% lf] <- "Other"

Here, the original factor levels are distributed as follows:

 A  B  C  D  E 
18 23 35 36 38 

and then it becomes

Other     C     D     E 
   41    35    36    38 

It may be conveniently wrapped into a function. There is a combine_factor() function in the reshape package, so I guess it could be useful too.

Also, as you seem interested in data mining, you might have a look at the caret package. It has a lot of useful features for data preprocessing, including functions like nearZeroVar() that allows to flag predictors with very imbalanced distribution of observed values (See the vignette, example data, pre-processing functions, visualizations and other functions, p. 5, for example of use).

$\endgroup$
  • $\begingroup$ @CHI Thanks. I have studied the caret package and have used it to tune meta parameters. very useful!. $\endgroup$ – B_Miner Dec 21 '10 at 13:03
  • $\begingroup$ @chl +1, nice one. I wrote my function solely because code a[levels(a) %in% lf] <-"Other" does not work, so I assumed that factor level change is complicated affair. As usual it turned out, that R is not complicated, I am :) $\endgroup$ – mpiktas Dec 21 '10 at 13:04
  • $\begingroup$ @mpiktas Thx. You can work at the vector level with e.g., a[as.character(a) %in% lf] <- lf[1]; a <- factor(droplevels(a), labels=c("Other",LETTERS[3:5])). $\endgroup$ – chl Dec 21 '10 at 15:27
  • $\begingroup$ +1. a[levels(a) %in% lf] <-"Other" sure saves a ton of code lines. Clever and efficient! $\endgroup$ – Christopher Aden Dec 21 '10 at 18:40
  • $\begingroup$ But note that a[a=="a"] <- "Other" will not work, which for me is quite natural to assume that it should. Especially since a[a=="a"] is perfectly valid. $\endgroup$ – mpiktas Dec 21 '10 at 21:04
5
$\begingroup$

The only problem with Christopher answer is that it will mix up the original ordering of the factor. Here is my fix:

 Merge.factors <- function(x, p) {
     t <- table(x)
     levt <- cbind(names(t), names(t)) 
     levt[t/sum(t)<p, 2] <- "Other"
     change.levels(x, levt)
 }

where change.levels is the following function. I wrote it some time ago, so I suspect there might be better ways of achieving what it does.

 change.levels <- function(f, levt) {
     ##Change the the names of the factor f levels from
     ##substitution table levt.
     ## In the first column there are the original levels, in
     ## the second column -- the substitutes
     lv <- levels(f)
     if(sum(sort(lv) != sort(levt[, 1]))>0)
     stop ("The names from substitution table does not match given level names")
     res <- rep(NA, length(f))

     for(i in lv) {
          res[f==i] <- as.character(levt[levt[, 1]==i, 2])
     }
     factor(res)
}
$\endgroup$
4
$\begingroup$

I wrote a quick function that will accomplish this goal. I'm a novice R user, so it may be slow with large tables.

Merge.factors <- function(x, p) { 
    #Combines factor levels in x that are less than a specified proportion, p.
    t <- table(x)
    y <- subset(t, prop.table(t) < p)
    z <- subset(t, prop.table(t) >= p)
    other <- rep("Other", sum(y))
    new.table <- c(z, table(other))
    new.x <- as.factor(rep(names(new.table), new.table))
    return(new.x)
}

As an example of it in action:

> a <- rep("a", 100)
> b <- rep("b", 1000)
> c <- rep("c", 1000)
> d <- rep("d", 1000)
> e <- rep("e", 400)
> f <- rep("f", 100)
> x <- factor(c(a, b, c, d, e, f))
> summary(x)
   a    b    c    d    e    f 
 100 1000 1000 1000  400  100 
> prop.table(table(x))
x
         a          b          c          d          e          f 
0.02777778 0.27777778 0.27777778 0.27777778 0.11111111 0.02777778 
> 
> w <- Merge.factors(x, .05)
> summary(w)
    b     c     d     e Other 
 1000  1000  1000   400   200 
> class(w)
[1] "factor"
$\endgroup$
  • $\begingroup$ Thanks for the observation, John. I have changed it a little to make it a factor. All I did was remake the original vector from the table though, so if there's a way to skip that step, this will be faster. $\endgroup$ – Christopher Aden Dec 21 '10 at 3:11
  • $\begingroup$ Thanks to everyone who responded. My R is weak but the ability to do this with so few lines of code is testament to how powerful it is and makes me want to learn. $\endgroup$ – B_Miner Dec 21 '10 at 14:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.