Комбинирование уровни фактора в R 3.2.1

Question

В предыдущих версиях RI может совмещают уровни фактора, которые не имеют «значительный» порог громкости, используя следующую маленькую функцию:

whittle = function(data, cutoff_val){ 
    #convert to a data frame 
    tab = as.data.frame.table(table(data)) 
    #returns vector of indices where value is below cutoff_val 
    idx = which(tab$Freq < cutoff_val) 
    levels(data)[idx] = "Other" 
    return(data) 
} 

Это берет в фактор вектор, ищет уровни, которые не появляются «достаточно часто» и объединяют все эти уровни в один «другой» факторный уровень. Примером этого является следующее:

> sort(table(data$State)) 

    05 27 35 40 54 84  9 AP AU BE BI DI  G GP GU GZ HN HR JA JM KE KU  L LD LI MH NA 
    1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 
    OU  P PL RM SR TB TP TW  U VD VI VS WS  X ZH 47 BL BS DL  M MB NB RP TU 11 DU KA 
    1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  3  3  3 
    BW ND NS WY AK SD 13 QC 01 BC MT AB HE ID  J NO LN NM ON NE VT UT IA MS AO AR ME 
    4  4  4  4  5  5  6  6  7  7  7  8  8  8  9 10 11 17 23 26 26 30 31 31 38 40 44 
    OR KS HI NV WI OK KY IN WV AL CO WA MN NH MO SC LA TN AZ IL NC MI GA OH ** CT DE 
    45 47 48 57 57 64 106 108 112 113 120 125 131 131 135 138 198 200 233 492 511 579 645 646 840 873 1432 
    RI DC TX MA FL VA MD CA NJ PA NY 
1782 2513 6992 7027 10527 11016 11836 12221 15485 16359 34045 

Теперь, когда я использую whittle он возвращает мне следующее сообщение:

> delete = whittle(data$State, 1000) 
Warning message: 
In `levels<-`(`*tmp*`, value = c("Other", "Other", "Other", "Other", : 
    duplicated levels in factors are deprecated 

Как я могу изменить свою функцию так, что она имеет тот же эффект, но Безразлично» t использовать эти «устаревшие» уровни факторов? Преобразование в символ, табуляция, а затем преобразование в символ «Другое»?

Answer 1

Я всегда считал, что проще (меньше набирать и меньше головной боли), чтобы преобразовать характер и обратно для такого рода операций. Держа с as.data.frame.table и использованием replace сделать замену уровней низкочастотных:

whittle <- function(data, cutoff_val) { 
    tab = as.data.frame.table(table(data)) 
    factor(replace(as.character(data), data %in% tab$data[tab$Freq < cutoff_val], "Other")) 
} 

Тестирование на некотором образце данных:

state <- factor(c("MD", "MD", "MD", "VA", "TX")) 
whittle(state, 2) 
# [1] MD MD MD Other Other 
# Levels: MD Other 

Answer 2

Я думаю, что это будет работать. Функция levels<- позволяет свернуть, назначив список (см. ?levels).

whittle <- function(data, cutoff_val){ 
    tab <- table(data) 
    shouldmerge <- tab < cutoff_val 
    tokeep <- names(tab)[!shouldmerge] 
    tomerge <- names(tab)[shouldmerge] 
    nv <- c(as.list(setNames(tokeep,tokeep)), list("Other"=tomerge)) 
    levels(data)<-nv 
    return(data) 
} 

И мы тестируем ее с

set.seed(15) 
x<-factor(c(sample(letters[1:10], 100, replace=T), sample(letters[11:13], 10, replace=T))) 
table(x) 
# x 
# a b c d e f g h i j k l m 
# 5 11 8 8 7 5 13 14 14 15 2 3 5 

y <- whittle(x, 9) 
table(y) 
# y 
#  b  g  h  i  j Other 
# 11 13 14 14 15 43 

Answer 3

Вот еще один способ сделать это, заменив все ниже пункты порог с первым, а затем переименование этого уровня в другое.

whittle <- function(x, thresh) { 
    belowThresh <- names(which(table(x) < thresh)) 
    x[x %in% belowThresh] <- belowThresh[1] 
    levels(x)[levels(x) == belowThresh[1]] <- "Other" 
    factor(x) 
} 

Answer 4

Стоит добавить к этому ответу, что новый forcats пакет содержит функцию fct_lump() которая посвящена этому.

Использование @ данных MrFlick в:

x <- factor(c(sample(letters[1:10], 100, replace=T), 
       sample(letters[11:13], 10, replace=T))) 

library(forcats) 
library(magrittr) ## for %>% ; could also load dplyr 
fct_lump(x, n=5) %>% table 

# b  g  h  i  j Other 
#11 13 14 14 15 43 

n аргумент задает число наиболее распространенных значений для сохранения.