r-用cut2(不带[)符号)在Hmisc中获得漂亮的切口

Question

我目前正在尝试使用Hmisc包来整齐地剪切数据，如下例所示：

dummy <- data.frame(important_variable=seq(1:1000))
require(Hmisc)
dummy$cuts <- cut2(dummy$important_variable, g = 4)

生成的切割值正确：

  important_variable       cuts
1                  1 [  1, 251)
2                  2 [  1, 251)
3                  3 [  1, 251)
4                  4 [  1, 251)
5                  5 [  1, 251)
6                  6 [  1, 251)
> table(dummy$cuts)
[  1, 251) [251, 501) [501, 751) [751,1000] 
       250        250        250        250 

然而，我希望数据的呈现方式略有不同。例如，代替

[1251(

[2251501(

我更喜欢

1-250

251-500

由于我在多个变量上做了很多这样的工作，我对一个可重复的解决方案感兴趣，这个解决方案可以很容易地应用于多个变量。

---

编辑

根据评论中的讨论，解决方案必须处理更多混乱的变量，如x2 <- runif(100, 5.0, 7.5)。

Answer 1

我们可以使用gsubfn删除括号，并通过从第二组数字中减去一来更改数字部分

 library(gsubfn)
 v1 <- dummy$cuts
 v1New <-  gsubfn('\[\s*(\d+),\s*(\d+)[^0-9]+', ~paste0(x, '-', 
                     as.numeric(y)-1), as.character(v1))
 table(v1New)
 # 1-250 251-500 501-750 751-999 
 #  250     250     250     250 

对于涉及小数的第二种情况，我们需要将数字与小数进行匹配，并通过将它们放在括号中(([0-9.]+)，(\d+\.\d+)(来捕获这些组。我们将第二组捕获组转换为"numeric"并从中减去0.01(as.numeric(y)-0.01(。CCD_ 7表示0个或更多个空间。空格的格式不均匀，所以我们不得不使用它来代替\s+，后者是1个或多个空格。

 v2New <- gsubfn('\[\s*([0-9.]+),(\d+\.\d+).*', ~paste0(x,
                 '-',as.numeric(y)-0.01), as.character(v2))
 table(v2New)
 v2New
 #5.00-5.59 5.60-6.12 6.13-6.71 6.72-7.49 
 #    25        25        25        25 

数据

 set.seed(24)
 x2 <- runif(100, 5.0, 7.5)
 v2 <- cut2(x2, g=4)

Answer 2

这为整数和小数范围提供了通用解决方案(无需手动指定增量(：

library(stringr)
pretty_cuts <- function(cut_str) {
  # so we know when to not do something
  first_val <- as.numeric(str_extract_all(cut_str[1], "[[:digit:]\.]+")[[1]][1])
  last_val <- as.numeric(str_extract_all(cut_str[length(cut_str)], "[[:digit:]\.]+")[[1]][2])
  sapply(seq_along(cut_str), function(i) {
    # get cut range
    x <- str_extract_all(cut_str[i], "[[:digit:]\.]+")[[1]]
    # see if a double vs an int & get # of places if decimal so
    # we know how much to inc/dec
    inc_dec <- 1
    if (str_detect(x[1], "\.")) {
      x <- as.numeric(x)
      inc_dec <- 10^(-match(TRUE, round(x[1], 1:20) == x[1]))
    } else {
      x <- as.numeric(x)
    }
    # if not the edge cases inc & dec
    if (x[1] != first_val) { x[1] <- x[1] + inc_dec }
    if (x[2] != last_val)  { x[2] <- x[2] - inc_dec }
    sprintf("%s - %s", as.character(x[1]), as.character(x[2]))
  })
}
dummy <- data.frame(important_variable=seq(1:1000))
dummy$cuts <- cut2(dummy$important_variable, g = 4)
a <- pretty_cuts(dummy$cuts)
unique(dummy$cuts)
## [1] [  1, 251) [251, 501) [501, 751) [751,1000]
## Levels: [  1, 251) [251, 501) [501, 751) [751,1000]
unique(a)
## [1] "1 - 250"    "252 - 500"  "502 - 750"  "752 - 1000"
x2 <- runif(100, 5.0, 7.5)
b <- pretty_cuts(cut2(x2, g=4))
unique(cut2(x2, g=4))
## [1] [5.54,6.28) [6.28,6.97) [6.97,7.50] [5.02,5.54)
## Levels: [5.02,5.54) [5.54,6.28) [6.28,6.97) [6.97,7.50]
unique(b)
## [1] "5.54 - 6.27" "6.29 - 6.97" "6.98 - 7.49" "5.03 - 5.53"