R语言将连续整数游程折叠为范围字符串

rjzwgtxy 于 2023-01-03 发布在其他

关注(0)|答案(6)|浏览(115)

我在一个列表中有一些数据，我需要寻找连续运行的整数（我的大脑认为rle，但不知道如何在这里使用它）。
这样更容易查看数据集并解释我的目的。

数据视图如下：

$greg
 [1]  7  8  9 10 11 20 21 22 23 24 30 31 32 33 49

$researcher
[1] 42 43 44 45 46 47 48

$sally
 [1] 25 26 27 28 29 37 38 39 40 41

$sam
 [1]  1  2  3  4  5  6 16 17 18 19 34 35 36

$teacher
[1] 12 13 14 15

预期产出：

$greg
 [1]  7:11, 20:24, 30:33, 49

$researcher
 [1] 42:48

$sally
 [1] 25:29, 37:41

$sam
 [1]  1:6, 16:19 34:36

$teacher
 [1] 12:15

使用基本包我怎么能用最高和最低之间的冒号和非连续部分之间的逗号来替换连续跨度？注意，数据从整数向量列表到字符向量列表。

MWE数据：

z <- structure(list(greg = c(7L, 8L, 9L, 10L, 11L, 20L, 21L, 22L, 
    23L, 24L, 30L, 31L, 32L, 33L, 49L), researcher = 42:48, sally = c(25L, 
    26L, 27L, 28L, 29L, 37L, 38L, 39L, 40L, 41L), sam = c(1L, 2L, 
    3L, 4L, 5L, 6L, 16L, 17L, 18L, 19L, 34L, 35L, 36L), teacher = 12:15), .Names = c("greg", 
    "researcher", "sally", "sam", "teacher"))

来源：https://stackoverflow.com/questions/14868406/collapse-continuous-integer-runs-to-strings-of-ranges

6条答案

按热度按时间

pgky5nke1#

我认为diff是解决方案。您可能需要一些额外的操作来处理单例，但是：

lapply(z, function(x) {
  diffs <- c(1, diff(x))
  start_indexes <- c(1, which(diffs > 1))
  end_indexes <- c(start_indexes - 1, length(x))
  coloned <- paste(x[start_indexes], x[end_indexes], sep=":")
  paste0(coloned, collapse=", ")
})

$greg
[1] "7:11, 20:24, 30:33, 49:49"

$researcher
[1] "42:48"

$sally
[1] "25:29, 37:41"

$sam
[1] "1:6, 16:19, 34:36"

$teacher
[1] "12:15"

赞(0）回复(0）举报 2023-01-03

dohp0rv52#

使用IRanges：

require(IRanges)
lapply(z, function(x) {
    t <- as.data.frame(reduce(IRanges(x,x)))[,1:2]
    apply(t, 1, function(x) paste(unique(x), collapse=":"))
})

# $greg
# [1] "7:11"  "20:24" "30:33" "49"   
# 
# $researcher
# [1] "42:48"
# 
# $sally
# [1] "25:29" "37:41"
# 
# $sam
# [1] "1:6"   "16:19" "34:36"
# 
# $teacher
# [1] "12:15"

赞(0）回复(0）举报 2023-01-03

ds97pgxw3#

以下是使用diff和tapply返回字符向量的尝试

runs <- lapply(z, function(x) {
  z <- which(diff(x)!=1); 
  results <- x[sort(unique(c(1,length(x), z,z+1)))]
  lr <- length(results)
  collapse <- rep(seq_len(ceiling(lr/2)),each = 2, length.out = lr)
  as.vector(tapply(results, collapse, paste, collapse = ':'))
  })

runs
$greg
[1] "7:11"  "20:24" "30:33" "49"   

$researcher
[1] "42:48"

$sally
[1] "25:29" "37:41"

$sam
[1] "1:6"   "16:19" "34:36"

$teacher
[1] "12:15"

赞(0）回复(0）举报 2023-01-03

disbfnqx4#

我有一个相当类似的解决方案马里乌斯，他的作品以及我的，但机制略有不同，所以我想我不妨张贴它：

findIntRuns <- function(run){
  rundiff <- c(1, diff(run))
  difflist <- split(run, cumsum(rundiff!=1))
  unname(sapply(difflist, function(x){
    if(length(x) == 1) as.character(x) else paste0(x[1], ":", x[length(x)])
  }))
}

lapply(z, findIntRuns)

它产生：

$greg
[1] "7:11"  "20:24" "30:33" "49"   

$researcher
[1] "42:48"

$sally
[1] "25:29" "37:41"

$sam
[1] "1:6"   "16:19" "34:36"

$teacher
[1] "12:15"

赞(0）回复(0）举报 2023-01-03

vom3gejh5#

lapply和tapply的另一个简短解决方案：

lapply(z, function(x)
  unname(tapply(x, c(0, cumsum(diff(x) != 1)), FUN = function(y) 
    paste(unique(range(y)), collapse = ":")
  ))
)

结果是：

$greg
[1] "7:11"  "20:24" "30:33" "49"   

$researcher
[1] "42:48"

$sally
[1] "25:29" "37:41"

$sam
[1] "1:6"   "16:19" "34:36"

$teacher
[1] "12:15"

赞(0）回复(0）举报 2023-01-03

ccgok5k56#

迟到了，但这里有一个基于deparse的一行程序：

lapply(z,function(x) paste(sapply(split(x,cumsum(c(1,diff(x)-1))),deparse),collapse=", "))
$greg
[1] "7:11, 20:24, 30:33, 49L"

$researcher
[1] "42:48"

$sally
[1] "25:29, 37:41"

$sam
[1] "1:6, 16:19, 34:36"

$teacher
[1] "12:15"

赞(0）回复(0）举报 2023-01-03

我来回答

R语言将连续整数游程折叠为范围字符串

6条答案

相关问题

热门标签

最新问答

R语言 将连续整数游程折叠为范围字符串

6条答案

相关问题

热门标签

最新问答

R语言将连续整数游程折叠为范围字符串