Найти лучшие децили из фрейма данных по группе

Question

Я пытаюсь создать новые переменные, используя функцию и lapply вместо того, чтобы работать прямо в данных с циклами. Я использовал Stata и решил бы эту проблему с помощью метода, аналогичного тому, который обсуждался здесь.

Поскольку именование переменных программно очень сложно или, по крайней мере, неудобно в R (и кажется, что вы не можете использовать индексацию с assign), Я оставил процесс именования до lapply, Я тогда использую for цикл, чтобы сделать переименование до слияния и снова для слияния. Есть ли более эффективные способы сделать это? Как бы я заменил петли? Должен ли я делать какие-то изменения?

#Reproducible data
data <- data.frame("custID" = c(1:10, 1:20),
    "v1" = rep(c("A", "B"), c(10,20)), 
    "v2" = c(30:21, 20:19, 1:3, 20:6), stringsAsFactors = TRUE)

#Function to analyze customer distribution for each category (v1)
pf <- function(cat, df) {

        df <- df[df$v1 == cat,]
        df <- df[order(-df$v2),]

    #Divide the customers into top percents
    nr <- nrow(df)
    p10 <- round(nr * .10, 0)
    cat("Number of people in the Top 10% :", p10, "\n")
    p20 <- round(nr * .20, 0)
    p11_20 <- p20-p10
    cat("Number of people in the 11-20% :", p11_20, "\n")

    #Keep only those customers in the top groups
    df <- df[1:p20,]

    #Create a variable to identify the percent group the customer is in
    top_pct <- integer(length = p10 + p11_20)

    #Identify those in each group
    top_pct[1:p10] <- 10
    top_pct[(p10+1):p20] <- 20

    #Add this variable to the data frame
    df$top_pct <- top_pct

    #Keep only custID and the new variable
    df <- subset(df, select = c(custID, top_pct))

    return(df)

}


##Run the customer distribution function
v1Levels <- levels(data$v1)
res <- lapply(v1Levels, pf, df = data)

#Explore the results
summary(res)

    #      Length Class      Mode
    # [1,] 2      data.frame list
    # [2,] 2      data.frame list

print(res)

    # [[1]]
    #   custID top_pct
    # 1      1      10
    # 2      2      20
    # 
    # [[2]]
    #    custID top_pct
    # 11      1      10
    # 16      6      10
    # 12      2      20
    # 17      7      20



##Merge the two data frames but with top_pct as a different variable for each category

#Change the new variable name
for(i in 1:length(res)) {
    names(res[[i]])[2] <- paste0(v1Levels[i], "_top_pct")
}

#Merge the results
res_m <- res[[1]]
for(i in 2:length(res)) {
    res_m <- merge(res_m, res[[i]], by = "custID", all = TRUE)
}

print(res_m)

    #   custID A_top_pct B_top_pct
    # 1      1        10        10
    # 2      2        20        20
    # 3      6        NA        10
    # 4      7        NA        20

Answer 1

Идиоматический способ сделать такую ​​вещь в R будет состоять в использовании комбинации split а также lapply, Вы на полпути с вашим использованием lapply; вам просто нужно использовать split также.

lapply(split(data, data$v1), function(df) {
    cutoff <- quantile(df$v2, c(0.8, 0.9))
    top_pct <- ifelse(df$v2 > cutoff[2], 10, ifelse(df$v2 > cutoff[1], 20, NA))
    na.omit(data.frame(id=df$custID, top_pct))
})

Поиск квантилей делается с quantile,

Answer 2

Придерживайтесь своих инстинктов Stata и используйте один набор данных:

require(data.table)
DT <- data.table(data)

DT[,r:=rank(v2)/.N,by=v1]

Вы можете увидеть результат, набрав DT,

---

Отсюда вы можете сгруппироватьv1 ранг, r, если хотите. После Статы идиомы...

DT[,g:={
  x = rep(0,.N)
  x[r>.8] = 20
  x[r>.9] = 10
  x
}]

Это как gen а потом два replace ... if заявления. Опять же, вы можете увидеть результат с DT,

---

Наконец, вы можете подмножество с

DT[g>0]

который дает

   custID v1 v2     r  g
1:      1  A 30 1.000 10
2:      2  A 29 0.900 20
3:      1  B 20 0.975 10
4:      2  B 19 0.875 20
5:      6  B 20 0.975 10
6:      7  B 19 0.875 20

Эти шаги также могут быть связаны между собой:

DT[,r:=rank(v2)/.N,by=v1][,g:={x = rep(0,.N);x[r>.8] = 20;x[r>.9] = 10;x}][g>0]

---

(Спасибо @ExperimenteR:)

Переставить для нужного выхода в ОП, со значениями v1 в столбцах используйте dcast:

dcast(
  DT[,r:=rank(v2)/.N,by=v1][,g:={x = rep(0,.N);x[r>.8] = 20;x[r>.9] = 10;x}][g>0], 
  custID~v1)

В настоящее время, dcast требуется последняя версия data.table, доступно (я думаю) от Github.

Answer 3

Вам не нужна функция pf добиться того, что вы хотите. Пытаться dplyr/tidyr комбо

library(dplyr)
library(tidyr)
data %>% 
    group_by(v1) %>% 
    arrange(desc(v2))%>%
    mutate(n=n()) %>% 
    filter(row_number() <= round(n * .2)) %>% 
    mutate(top_pct= ifelse(row_number()<=round(n* .1), 10, 20)) %>%
    select(custID, top_pct) %>% 
    spread(v1,  top_pct)
#  custID  A  B
#1      1 10 10
#2      2 20 20
#3      6 NA 10
#4      7 NA 20