Kontinuierliche Ganzzahl läuft

Question

Ich habe einige Daten in einer Liste, die ich für kontinuierliche Läufe von ganzen Zahlen suchen muss (Mein Gehirn denke, rle, aber weiß nicht, wie man es hier verwendet).

Es ist einfacher, den Datensatz zu betrachten und zu erklären, was ich möchte.

Hier ist die Datenansicht:

$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 

gewünschte Ausgabe:

$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 

Verwenden Basispakete, wie ich kontinuierliche Spanne mit einem Doppelpunkt zwischen dem höchsten und dem niedrigsten und Kommas in ersetzen kann zwischen nicht die nicht kontinuierlichen Teile? Beachten Sie, dass die Daten von einer Liste ganzzahliger Vektoren in eine Liste von Zeichenvektoren übergehen.

MWE Daten:

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

Ich denke diff ist die Lösung. Sie könnten einige zusätzliche Hantieren müssen mit den Singletons beschäftigen, aber:

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

Mit 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

Ich habe eine ziemlich ähnliche Lösung zu Marius, seine Werke sowie meine, aber die Mechanismen sind etwas anders, so dachte ich, dass ich auch kann es schreiben:

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) 

Welche produziert:

$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

Hier wird versucht, mit diff und tapply ein Zeichen Vektor

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

Eine weitere kurze Lösung mit lapply und tapply Rückkehr:

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

Das Ergebnis:

$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

Spät zum pa rty, aber hier ist ein deparse basiert Einzeiler:

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"