27

Following some great advice from before, I'm now writing my 2nd R function and using a similar logic. However, I'm trying to automate a bit more and may be getting too smart for my own good.

I want to break the clients into quintiles based on the number of orders. Here's my code to do so:

# sample data
clientID <- round(runif(200,min=2000, max=3000),0)
orders <- round(runif(200,min=1, max=50),0)

df <- df <- data.frame(cbind(clientID,orders))

#function to break them into quintiles
ApplyQuintiles <- function(x) {
  cut(x, breaks=c(quantile(df$orders, probs = seq(0, 1, by = 0.20))), 
      labels=c("0-20","20-40","40-60","60-80","80-100"))
}

#Add the quintile to the dataframe
df$Quintile <- sapply(df$orders, ApplyQuintiles)

table(df$Quintile)

0-20   20-40   40-60    60-80   80-100 
40     39      44       38      36

You'll see here that in my sample data, I created 200 observations, yet only 197 are listed via table. The 3 left off are NA

Now, there are some clientIDs that have an 'NA' for quintile. It seems if they were at the lowest break, in this case, 1, then they were not included in the cut function.

Is there a way to make cut inclusive of all observations?

Community
  • 1
  • 1
mikebmassey
  • 8,354
  • 26
  • 70
  • 95

8 Answers8

32

Try the following:

set.seed(700)

clientID <- round(runif(200,min=2000, max=3000),0)
orders <- round(runif(200,min=1, max=50),0)

df <- df <- data.frame(cbind(clientID,orders))

ApplyQuintiles <- function(x) {
  cut(x, breaks=c(quantile(df$orders, probs = seq(0, 1, by = 0.20))), 
      labels=c("0-20","20-40","40-60","60-80","80-100"), include.lowest=TRUE)
}
df$Quintile <- sapply(df$orders, ApplyQuintiles)
table(df$Quintile)

0-20  20-40  40-60  60-80 80-100 
  40     41     39     40     40 

I included include.lowest=TRUE in your cut function, which seems to make it work. See ?cut for more details.

Edward
  • 5,367
  • 1
  • 20
  • 17
  • 3
    should there be x instead of df$orders in the 6th line of code? – Polar Bear Oct 23 '19 at 20:19
  • Yes it should be. Here is an improved version that allows you to specify splitPct values: `applyQuintiles <- function(cVector, splitPct) { if(1 %% splitPct == 0) { labelTags <- paste0("< ",seq(0, 1, by = splitPct) * 100,"%")[-1] cut(cVector, breaks=c(quantile(cVector, probs = seq(0, 1, by = splitPct))), labels=labelTags, include.lowest=TRUE) } else {message("Your splitPct is not summing to 1 (100%).")} }` Okay stackoverflow doesnt allow me to format but copy pasting this should work – Simon Stolz Jul 24 '20 at 11:47
7

There is also cut2 in the venerable Hmisc package. It does quantile cuts.

From the help:

Function like cut but left endpoints are inclusive and labels are of the form [lower, upper), except that last interval is [lower,upper]. If cuts are given, will by default make sure that cuts include entire range of x. Also, if cuts are not given, will cut x into quantile groups (g given) or groups with a given minimum number of observations (m). Whereas cut creates a category object, cut2 creates a factor object.

Owen
  • 3,063
  • 5
  • 30
  • 26
5

You can very easily accomplish this automatically with the content method in the bin function in the OneR package:

library(OneR)
set.seed(700)

clientID <- round(runif(200, min = 2000, max = 3000), 0)
orders <- round(runif(200, min = 1, max = 50), 0)
df <- data.frame(cbind(clientID, orders))

df$Quintiles <- bin(df$orders, method = "content")
table(df$Quintile)
## 
## (0.952,9.8]    (9.8,19]   (19,31.4] (31.4,38.2]   (38.2,49] 
##          40          41          39          40          40

(Full disclosure: I am the author of this package)

vonjd
  • 4,202
  • 3
  • 44
  • 68
2

I use a similar function for my data and I am concerned because my quintile bins have different numbers of observation: is that OK? Thanks!

jobs02.vq <- cut(meaneduc02v, breaks=c(quantile(meaneduc02v,  probs = seq(0,        1, by=0.20), 
                          na.rm=TRUE, names=TRUE, include.lowest=TRUE, right = TRUE, 
                          labels=c("1","2","3","4","5")))) # makes quintiles

And the output I get is:

 table(jobs02.vq, useNA='ifany')
 jobs02.vq
 [1.00,2.00) [2.00,2.51) [2.51,3.34) [3.34,4.45) [4.45,5.33]        <NA> 
     82          54          69          64          67         123 
Paula
  • 21
  • 1
2

I wanted something that would work would dplyr and group_by; and I needed with cut labels specifying the range. Here's what I got

Get.breaks <- function(f, cuts, digits = 2)
{
  x <- round(quantile(f, probs = seq(1/cuts, 1 - 1/cuts, 1/cuts), names = F), digits)
  x <- sort(unique(c(0, x, Inf)))
  rm(f, cuts, digits)
  return(x)
}

df <- data.frame(cbind(clientID = round(runif(200,min=2000, max=3000),0),
                       orders = round(runif(200,min=1, max=50),0)))

cut <- df %>%
        mutate(lower = cut(orders, right = F
                           , breaks = Get.breaks(orders, cuts = 10, digits = 0)
                           , labels = head(Get.breaks(orders, cuts = 10, digits = 0), -1)
                           )
               , lower = as.numeric(as.character(lower))
               ) %>% 
        group_by(lower) %>% 
        summarise(.groups = "drop", N = n())
ishonest
  • 433
  • 4
  • 8
1

gtools::quantcut does the trick well

This create labels low, mid & high according to quantile 0.33 & 0.66 for Sepal.Length variable grouped by Species

library(dplyr)
library(gtools)
tt <- iris %>%
  group_by(Species) %>%
  mutate(
    Sepal.Length.Band = quantcut(Sepal.Length, q = c(0, 0.33, 0.66, 1), 
                                 labels = c("low", "mid", "high"))
  )

table(tt$Species, tt$Sepal.Length.Band)
qfazille
  • 1,643
  • 13
  • 27
0

cut2 from Hmisc does de job (parameter g defines the number of quantile groups)

set.seed(700)

clientID <- round(runif(200,min=2000, max=3000),0)
orders <- round(runif(200,min=1, max=50),0)

df <- data.frame(cbind(clientID,orders))

library(Hmisc)
df$Quintile <- cut2(df$orders, g =5)
levels(df$Quintile) <-  c("0-20", "20-40", "40-60", "60-80", "80-100")

table(df$Quintile)
##  0-20  20-40  40-60  60-80 80-100 
##    40     41     39     40     40 
0

A simple function working for all data:

    cutD <- function(x,n) {
  cut(x, breaks=c(quantile(x, probs = seq(0, 1, by = 1/n),na.rm = T)), 
      include.lowest=TRUE)
}
Fabach
  • 1