使用 cut2 在 Hmisc 中获得漂亮的切割(没有 [ ) 符号)
Obtaining nice cuts in Hmisc with cut2 (without the [ ) signs )
我目前正在尝试使用 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
但是,我希望数据的呈现方式略有不同。例如代替
[ 1, 251 )
[ 251, 501 )
我更喜欢符号
1 - 250
251 - 500
由于我在多个变量上做了很多这样的工作,所以我对可轻松应用于多个变量的可重现解决方案很感兴趣。
编辑
根据评论中的讨论,解决方案必须处理更多 混乱的 变量,例如 x2 <- runif(100, 5.0, 7.5)
.
我们可以使用 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
) 来更改第二组捕获组。 \s*
表示 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)
这为整数和小数范围提供了通用解决方案(无需手动指定增量):
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"
我目前正在尝试使用 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
但是,我希望数据的呈现方式略有不同。例如代替
[ 1, 251 )
[ 251, 501 )
我更喜欢符号
1 - 250
251 - 500
由于我在多个变量上做了很多这样的工作,所以我对可轻松应用于多个变量的可重现解决方案很感兴趣。
编辑
根据评论中的讨论,解决方案必须处理更多 混乱的 变量,例如 x2 <- runif(100, 5.0, 7.5)
.
我们可以使用 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
) 来更改第二组捕获组。 \s*
表示 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)
这为整数和小数范围提供了通用解决方案(无需手动指定增量):
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"