Биннинг с квантилями добавляя исключение в г

Question

Мне нужно создать 10 бинов с максимально приблизительной частотой каждый;для этого я использую функцию «ClassInvervals» из библиотеки (ClassInt) со стилем «квантиль» для объединения некоторых данных.Это работает для обязательных столбцов;но когда у меня есть столбец, в котором 1 число повторяется слишком много раз, появляется ошибка, которая говорит о том, что некоторые скобки не являются уникальными, что имеет смысл, если предположить, что последние + 30% данных столбца - это то же число, поэтому функция нене знаю, как разделить ячейки.

Что я хотел бы сделать, так это то, что если число больше 10% длины столбца, то обрабатывать его как другую ячейку, а если нет, затем используйте функцию как есть.

Например, давайте предположим, что у нас есть этот DF:

df <- read.table(text="
    X
1   5
2   29
3   4
4   26
5   4
6   17
7   4
8   4
9   4
10  25
11  4
12  4
13  5
14  14
15  18
16  13
17  29
18  4
19  13
20  6
21  26
22  11
23  2
24  23
25  4
26  21
27  7
28  4
29  18
30  4",h=T,strin=F)

Так что в этом случае 10% длины будет 3, поэтому еслимы создаем таблицу, содержащую частоту каждого числа, это будет выглядеть примерно так:

2   1
4   11
5   2
6   1
7   1
11  1
13  2
14  1
17  1
18  2
21  1
23  1
25  1
26  2
29  2

С этой информацией сначала мы должны обработать «4» как уникальный бин.

Таку нас есть окончательный результат, более или менее подобный этому:

    X   Bins
1   5   [2,6)
2   29  [27,30)
3   4   [4]
4   26  [26,27)
5   4   [4]
6   17  [15,19)
7   4   [4]
8   4   [4]
9   4   [4]
10  25  [19,26)
11  4   [4]
12  4   [4]
13  5   [2,6)
14  14  [12,15)
15  18  [15,19)
16  13  [12,15)
17  29  [27,30)
18  4   [4]
19  13  [12,15)
20  6   [6,12)
21  26  [26,27)
22  11  [6,12)
23  2   [2,6)
24  23  [19,26)
25  4   [4]
26  21  [19,26)
27  7   [6,12)
28  4   [4]
29  18  [15,19)
30  4   [4]

До сих пор мой подход был примерно таким:

Moda <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

Binner <- function(df) {
  library(classInt)
  #Input is a matrix that wants to be binned
  for (c in 1:ncol(df)) {
    if (sapply(df,class)[c]=="numeric") {
      VectorTest <- df[,c]

# Here I get the 10% of the values
      TenPer <- floor(length(VectorTest)/10)

      while((sum(VectorTest == Moda(VectorTest)))>=TenPer) {
# in this loop I manage to remove the values that 
# are repeated more than 10% but I still don't know how to add it as a special bin
        VectorTest <- VectorTest[VectorTest!=Moda(VectorTest)]
        Counter <- Counter +1
      }

      binsTest <- classIntervals(VectorTest_Fixed, 10- Counter, style = 'quantile')
      binsBrakets <- cut(VectorTest, breaks = binsTest$brks)
      df[ , paste0("Binned_", colnames(df)[c])]   <- binsBrakets
    }
  }
  return (df)
}

Может ли кто-нибудь мне помочь?

Answer 1

вы можете создать два разных фрейма данных: один с 10% ячейками, а остальные с cut созданными ячейками.Затем свяжите их вместе (убедитесь, что ячейки являются строками).

library(magrittr)

#lets find the numbers that appear more than 10% of the time
large <- table(df$X) %>% 
  .[. >= length(df$X)/10] %>%
  names()

#these numbers appear less than 10% of the time
left_over <- df$X[!df$X %in% large]



#we want a total of 10 bins, so we'll cut the data into 10 - the number of 10%
left_over_bins <- cut(left_over, 10 - length(large))

#Let's combine the information into a single data frame
numbers_bins <- rbind(
  data.frame(
    n = left_over,
    bins = left_over_bins %>% as.character,
    stringsAsFactors = F
  ),
  data.frame(
    n = df$X[df$X %in% large],
    bins = df$X[df$X %in% large] %>% as.character,
    stringsAsFactors = F
  )
)

Если вы соберете информацию, вы получите что-то вроде этого

table(numbers_bins$bins) %>% sort(T)

       4 (1.97,5]  (11,14]  (23,26]  (17,20] 
      11        3        3        3        2 
 (20,23]  (26,29]    (5,8]  (14,17]   (8,11] 
       2        2        2        1        1 

Answer 2

Вы можете использовать cutr::smart_cut:

# devtools::install_github("moodymudskipper/cutr")
library(cutr)
df$Bins <- smart_cut(df$X,list(10,"balanced"),"g",simplify = F)
table(df$Bins)
# 
#   [2,4)   [4,5)   [5,6)  [6,11) [11,14) [14,18) [18,21) [21,25) [25,29) [29,29] 
#       1      11       2       2       3       2       2       2       3       2 

больше на cutr и smart_cut