R语言 提取左侧闭合区间的断点

gdrx4gfi  于 2023-04-09  发布在  其他
关注(0)|答案(2)|浏览(134)

我正在查看命令cut()example(cut))的示例菜单,特别是这一部分:

cut> aaa <- c(1,2,3,4,5,2,3,4,5,6,7)

cut> cut(aaa, 3)
[1] (0.994,3] (0.994,3] (3,5]     (3,5]     (3,5]     (0.994,3]
[7] (3,5]     (3,5]     (3,5]     (5,7.01]  (5,7.01] 
Levels: (0.994,3] (3,5] (5,7.01]

cut> cut(aaa, 3, dig.lab = 4, ordered = TRUE)
[1] (0.994,2.998] (0.994,2.998] (2.998,5.002] (2.998,5.002]
[5] (2.998,5.002] (0.994,2.998] (2.998,5.002] (2.998,5.002]
[9] (2.998,5.002] (5.002,7.006] (5.002,7.006]
Levels: (0.994,2.998] < (2.998,5.002] < (5.002,7.006]

cut> ## one way to extract the breakpoints
cut> labs <- levels(cut(aaa, 3))

cut> cbind(lower = as.numeric( sub("\\((.+),.*", "\\1", labs) ),
cut+       upper = as.numeric( sub("[^,]*,([^]]*)\\]", "\\1", labs) ))
     lower upper
[1,] 0.994  3.00
[2,] 3.000  5.00
[3,] 5.000  7.01

如果区间在右侧闭合(如上所示),则它向我展示了使用cbind()提取数据断点的方法
现在,让我们假设我的数据将被切断,但表明间隔在左侧闭合。

cut(aaa, 3, dig.lab = 4, ordered = TRUE, right = FALSE)

我现在如何使用相同的命令cbind()提取我的断点?(如果有更多的方法,欢迎使用)

3yhwsihp

3yhwsihp1#

只需为您的模式使用以下内容,并使用gsub"\\[|\\]|\\(|\\)"
举个例子

out <- levels(cut(aaa, 3, dig.lab = 4, ordered = TRUE, right = FALSE))
gsub("\\[|\\]|\\(|\\)", "", out)
# [1] "0.994,2.998" "2.998,5.002" "5.002,7.006"

这里有一个快速读取数据的方法:

read.csv(text = gsub("\\[|\\]|\\(|\\)", "", out), header = FALSE)
#      V1    V2
# 1 0.994 2.998
# 2 2.998 5.002
# 3 5.002 7.006

仅供参考:无论间隔是在左侧闭合还是在右侧闭合,都可以使用相同的模式。使用原始示例:

labs <- levels(cut(aaa, 3))
labs
# [1] "(0.994,3]" "(3,5]"     "(5,7.01]" 
read.csv(text = gsub("\\[|\\]|\\(|\\)", "", labs), header = FALSE)
#      V1   V2
# 1 0.994 3.00
# 2 3.000 5.00
# 3 5.000 7.01

至于替代方案,因为你只需要在使用read.csv之前去掉第一个和最后一个字符,所以你也可以轻松地使用substr,而不必对正则表达式大惊小怪(如果这不是你的事情):

substr(labs, 2, nchar(labs)-1)
# [1] "0.994,3" "3,5"     "5,7.01"

更新:一个完全不同的选择

由于很明显R必须计算这些值并将其存储为函数的一部分,以便生成您看到的输出,因此操纵函数以使其输出不同的东西并不太困难。
查看cut.default的代码,您会发现最后几行代码如下:

if (codes.only) 
    code
else factor(code, seq_along(labels), labels, ordered = ordered_result)

很容易将最后几行改为输出list,其中包含cut的输出作为第一项,以及计算的范围(直接从cut函数中,而不是从粘贴在一起的factorlabels中提取)。
例如,in the Gist I've posted at this link,我对这些行做了如下修改:

if (codes.only) 
  FIN <- code
else FIN <- factor(code, seq_along(labels), labels, ordered = ordered_result)
list(output = FIN, ranges = data.frame(lower = ch.br[-nb], upper = ch.br[-1L]))

现在,比较:

cut(aaa, 3)
#  [1] (0.994,3] (0.994,3] (3,5]     (3,5]     (3,5]     (0.994,3] (3,5]     (3,5]    
#  [9] (3,5]     (5,7.01]  (5,7.01] 
# Levels: (0.994,3] (3,5] (5,7.01]
CUT(aaa, 3)
# $output
# [1] (0.994,3] (0.994,3] (3,5]     (3,5]     (3,5]     (0.994,3] (3,5]     (3,5]    
# [9] (3,5]     (5,7.01]  (5,7.01] 
# Levels: (0.994,3] (3,5] (5,7.01]
# 
# $ranges
#   lower upper
# 1 0.994     3
# 2     3     5
# 3     5  7.01

right = FALSE

cut(aaa, 3, dig.lab = 4, ordered = TRUE, right = FALSE)
#  [1] [0.994,2.998) [0.994,2.998) [2.998,5.002) [2.998,5.002) [2.998,5.002)
#  [6] [0.994,2.998) [2.998,5.002) [2.998,5.002) [2.998,5.002) [5.002,7.006)
# [11] [5.002,7.006)
# Levels: [0.994,2.998) < [2.998,5.002) < [5.002,7.006)
CUT(aaa, 3, dig.lab = 4, ordered = TRUE, right = FALSE)
# $output
#  [1] [0.994,2.998) [0.994,2.998) [2.998,5.002) [2.998,5.002) [2.998,5.002)
#  [6] [0.994,2.998) [2.998,5.002) [2.998,5.002) [2.998,5.002) [5.002,7.006)
# [11] [5.002,7.006)
# Levels: [0.994,2.998) < [2.998,5.002) < [5.002,7.006)

# $ranges
#   lower upper
# 1 0.994 2.998
# 2 2.998 5.002
# 3 5.002 7.006
uxhixvfz

uxhixvfz2#

我发现这个问题的大多数答案都是关于反转构造的字符串或编写自己的cut替代版本。
然而,R有一个函数trace(),它给了你一个开箱即用的机会来注入代码到一个函数中。你可以用它来“破解”一个函数的副作用,比如提取一个不返回的内部对象。

> trace(cut.default,quote(these_breaks<<-breaks),at=7)
Tracing function "cut.default" in package "base"
[1] "cut.default"

> invisible(cut(5:100,7))
Tracing cut.default(5:100, 7) step 7 
> these_breaks
[1]   4.90500  18.57143  32.14286  45.71429  59.28571  72.85714  86.42857 100.09500

> invisible(cut(2:10,2))
Tracing cut.default(2:10, 2) step 7 
> these_breaks
[1]  1.992  6.000 10.008

我使用at=7是因为我事先检查了函数体中的breaks变量已经计算好并且不再更改的位置。你可以通过as.list(body(cut.default))找到这一点。7可能需要在未来的R版本中进行更改。
我使用带引号的表达式these_breaks<<-breaks将内部breaks复制到全局env中的一个对象。在包代码中,可以使用预定义的env更优雅地完成此操作。

breaks_env <- new.env()
untrace(cut.default)
trace(cut.default,quote(assign("these_breaks",breaks,envir = breaks_env)),at=7)

invisible(cut(5:100,7))
breaks_env[['these_breaks']]
rm(these_breaks,envir=breaks_env)

invisible(cut(2:10,2))
breaks_env[['these_breaks']]

相关问题