連續整數運行

我有一些數據在列表中，我需要尋找連續運行的整數（我的大腦認爲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"))

來源

2013-02-14 Tyler Rinker

你的問題是類似位這一個：http://stackoverflow.com/q/7077710/602276 – Andrie 2013-02-14 06:03:06

我覺得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"

來源

2013-02-14 05:52:56 Marius

這一個我喜歡的大多數，因爲我可以理解你所做的一切。我做了一個小調整，把'49：49'變成'49'，但這很容易。謝謝。 – 2013-02-14 06:13:56

使用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"

來源

2013-02-14 06:01:10 Arun

工作得很好。不在基地但對未來的搜索者有用。謝謝。 +1 – 2013-02-14 06:12:49

當然，任何與間隔有關的事情，最好使用實現'間隔樹'的包。 – Arun 2013-02-14 06:16:17

是的，這是我第一次見到IRanges – 2013-02-14 06:17:05

我有一個相當類似的解決方案，以馬呂斯，他的作品以及我的，但該機制略有不同的，所以我想我可能也張貼：

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"

來源

2013-02-14 06:06:08

謝謝你分享你的想法+1 – 2013-02-14 06:11:21

下面是一個試圖使用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"

來源

2013-02-14 06:07:08 mnel

當我認爲自己擅長RI看這樣的代碼並意識到我有很多東西要學習+1 – 2013-02-14 06:12:14

我不太確定這是讚美:)。 – mnel 2013-02-14 06:15:01

不，它是。有一些我不會想到的功能組合:-)我喜歡創造力。 – 2013-02-14 06:15:55

與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"

來源

2013-02-14 07:55:07

晚到pa RTY，但這裏有一個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"

來源

2013-03-29 11:13:26 James

不錯的方法+1絕對晚到派對;） – 2013-03-29 15:19:25

連續整數運行

回答

相關問題