सतत पूर्णांक चलाता

मैं एक सूची में कुछ डेटा है कि मैं पूर्णांकों का निरंतर रन (मेरे मस्तिष्क लगता है 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

उपयोग आधार संकुल कैसे मैं बीच में उच्चतम और निम्नतम और अल्पविराम के बीच एक पेट के साथ निरंतर अवधि की जगह ले सकता गैर निरंतर भागों नहीं? ध्यान दें कि डेटा पूर्णांक वैक्टर की सूची से चरित्र वैक्टर की सूची में जाता है।

मेगावाट डेटा:

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

मुझे लगता है कि 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: 4 9 'के रूप में' 49:' पाने के लिए एक छोटा सा चिल्लाया लेकिन यह आसान हिस्सा था। धन्यवाद। –

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 –

निश्चित रूप से, अंतराल से संबंधित कुछ भी, पैकेज का उपयोग करना बेहतर है जो 'अंतराल पेड़' लागू करता है। – Arun

हाँ यह पहली बार था जब मैंने 'आईरेंज' –

मैं, अपने कार्यों के साथ-साथ मेरा रूप मेरियस लिए एक काफी समान समाधान है, लेकिन तंत्र हैं थोड़ा अलग इसलिए मैंने सोचा कि मैं भी इसे पोस्ट कर सकते हैं:

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 –

यहाँ एक प्रयास 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

जब मुझे लगता है कि मैं आरआई में अच्छा महसूस कर रहा हूं तो इस तरह के कोड को देखें और मुझे एहसास है कि मुझे +1 –

सीखने के लिए बहुत कुछ है मुझे पूरा यकीन नहीं है कि एक तारीफ है :)। – mnel

नहीं यह है।कार्यों के कुछ संयोजन थे जो मैंने एक साथ रखने के लिए नहीं सोचा था :-) मुझे रचनात्मकता पसंद आई। –

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

देर पी के लिए 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;) –

उत्तर

संबंधित मुद्दे