分位数的装箱在R中添加异常

时间:2018-10-10 19:35:31

标签: r

我需要创建10个频率最接近的垃圾箱;为了这, 我正在从库(ClassInt)使用具有以下样式的函数“ ClassInvervals” 用于分块某些数据的“分位数”。这适用于must列;但是,当我的某列中有1个数字重复太多次时,就会出现一个错误,提示某些括号不是唯一的,这是有道理的,假设最后+ 30%的列数据是相同的数字,因此该函数不会不知道如何分割垃圾箱。

我想做的是,如果数字大于列长度的10%,则将其视为不同的bin,否则将其原样使用。

例如,假设我们有这个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”视为唯一的bin。

所以我们最终的输出或多或少是这样的:

    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)
}

有人可以帮我吗?

2 个答案:

答案 0 :(得分: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 

more on cutr and smart_cut

答案 1 :(得分:0)

您可以创建两个不同的数据框:一个包含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