Ciągła liczba całkowita działa

Question

Mam niektóre dane na liście, które należy szukać ciągłych przebiegów liczb całkowitych (My brain think rle, ale nie wiem, jak używać go tutaj).

Łatwiej jest spojrzeć na zestaw danych i wyjaśnić, czego szukam.

Oto widok danych:

$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 

Pożądany wyjściowa:

$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 

pakietów korzysta bazowe jak mogę zastąpić ciągłą rozpiętość dwukropkiem pomiędzy najwyższą i najniższą i przecinki pomiędzy nimi inne niż nieciągłe części? Zauważ, że dane przechodzą z listy wektorów całkowitych do listy wektorów znaków.

MWE dane:

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

Answer 1

myślę diff jest rozwiązaniem. Może trzeba trochę dodatkowego błahy, aby uporać się z pojedynczych, ale:

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" 

Answer 2

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

Answer 3

Mam dość podobny rozwiązanie Marius, jego dzieła, a także kopalni ale mechanizmy są nieznacznie różni się więc pomyślałem, że może także dodawać go:

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) 

która produkuje:

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

Answer 4

Tutaj jest próbą używając diff i tapply powrocie do postaci wektorowej

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" 

Answer 5

Kolejny krótki rozwiązanie z lapply i tapply:

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

Rezultat:

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

Answer 6

Późno do pa rty, ale tu jest deparse oparty jedna wkładka:

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"