2012-02-21 12 views
6

मैं सोच रहा हूँ अंतराल हेरफेर और तुलना के लिए एक उचित ढांचे आरअंतराल आर (संघ, चौराहे, मतभेद, शामिल किए जाने, ...)

में मौजूद है कि क्या कुछ खोज के बाद में बीजगणित सेट, मैं सक्षम केवल था निम्न को खोजने के लिए: - फ़ंक्शन ढूंढें बेस पैकेज में अंतराल। (लेकिन मैं शायद ही इसे समझने) - यहाँ और वहाँ संघ और चौराहे के बारे में कुछ जवाब (विशेष रूप से: http://r.789695.n4.nabble.com/Union-Intersect-two-continuous-sets-td4224545.html)

आप एक पहल के उपकरणों का एक व्यापक सेट को लागू करने जानते हैं आसानी से की तरह है, अंतराल हेरफेर में लगातार कार्य संभालती के लिए शामिल किए जाने के/setdiff/संघ/चौराहे/आदि। (उदाहरण के लिए कार्यक्षमताओं की एक सूची के लिए यहां देखें)? या क्या आपको इस तरह के दृष्टिकोण को विकसित करने में सलाह होगी?

नीचे ऐसा करने के लिए मेरे पक्ष में कुछ ड्राफ्ट हैं। यह निश्चित रूप से अजीब है और अभी भी कुछ कीड़े हैं लेकिन यह बता सकता है कि मैं क्या देख रहा हूं। विकल्प लिया बारे में


प्रारंभिक पहलुओं - अंतराल या अंतराल के साथ सहजता से पेश आना चाहिए सेट - अंतराल 2 कॉलम data.frames (कम सीमा, उच्च सीमा) के रूप में प्रतिनिधित्व कर रहे हैं, एक पंक्ति पर - अंतराल सेट कर रहे हैं कई पंक्तियों साथ 2 कॉलम के रूप में प्रतिनिधित्व - एक तीसरे स्तंभ अंतराल की पहचान के लिए आवश्यकता हो सकती है सेट


यूनिअन

01,232,

चौराहे

interval_intersect <- function(df){ 
    # adapted from : http://r.789695.n4.nabble.com/Union-Intersect-two-continuous-sets-td4224545.html 
    M <- as.matrix(df) 

    L <- max(M[, 1]) 
    R <- min(M[, 2]) 

    Inew <- if (L <= R) c(L, R) else c() 

    if (!is.empty(Inew)){ 
     df2 <- t(as.data.frame(Inew)) 
     colnames(df2) <- colnames(df) 
     rownames(df2) <- NULL 
    } else { 
     df2 <- NULL 
    } 

    return(as.data.frame(df2)) 

} 



ref_interval_intersect <- function(df, ref){ 

    tmpfun <- function(a, b){ 

     names(b) <- names(a) 
     tmp <- interval_intersect(as.data.frame(rbind(a, b))) 
     return(tmp) 
    } 

    tmp0 <- adply(df, 1, tmpfun, ref, .expand = FALSE) # [,3:4] 
    #if(!is.empty(tmp0)) colnames(tmp0) <- colnames(df) 
    return(tmp0)     
} 


int_1_1 <- function(test, ref){ 

    te <- as.vector(test) 
    re <- as.vector(ref) 
    names(re) <- names(te) 
    tmp0 <- c(max(te[1, 1], re[1, 1]), min(te[1, 2], re[1, 2])) 

    if(tmp0[1]>tmp0[2]) tmp0 <- NULL # inverse of a correct interval --> VOID 

    if(!is.empty(tmp0)){ 
     tmp1 <- colwise(mkDateTime)(as.data.frame(t(as.data.frame(tmp0)))) 
     colnames(tmp1) <- colnames(test) 
    } else { 
     tmp1 <- data.frame(NULL) 
    } 

    return(tmp1) 

} 


int_1_n <- function(test, ref){ 

    test1 <- adply(.data = ref, 1, int_1_1, test = test, .expand = FALSE) 

    if(is.empty(test1)){ 
     return(data.frame(NULL)) 
    } else { 

     testn <- interval_union(test1[,2:3])  
     return(testn) 
    } 

} 


int_n_n <- function(test, ref){ 

    testnn <- adply(.data = test, 1, int_1_n, ref, .expand = FALSE) 
    # return(testnn[,2:3]) # return interval set without index (1st column) 
    return(testnn)   # return interval set with index (1st column) --> usefull to go with merge to keep metadata going alon g with interval description 
} 


int_intersect <- function(df, ref){ 

    mycols <- colnames(df) 
    df$X1 <- 1:nrow(df) 
    test <- df[, 1:2] 
    tmp <- int_n_n(test, ref) 

    intersection <- merge(tmp, df, by = "X1", suffixes = c("", "init")) 
    return(intersection[,mycols]) 

} 

बहिष्कार

excl_1_1 <- function(test, ref){ 
    te <- as.vector(test) 
    re <- as.vector(ref) 
    names(re) <- names(te) 


    if(te[1] < re[1]){   # Lower Bound 
     if(te[2] > re[1]){   # overlap 
      x <- unlist(c(te[1], re[1])) 
     } else {     # no overlap 
      x <- unlist(c(te[1], te[2])) 
     } 
    } else {     # test > ref on lower bound side 
     x <- NULL 
    } 

    if(te[2] > re[2]){   # Upper Bound 
     if(te[1] < re[2]){   # overlap 
      y <- unlist(c(re[2], te[2]))  
     } else {     # no overlap 
      y <- unlist(c(te[1], te[2])) 
     } 
    } else {     # test < ref on upper bound side 
     y <- NULL 
    } 

    if(is.empty(x) & is.empty(y)){ 
     tmp0 <- NULL 
     tmp1 <- tmp0 
    } else { 

     tmp0 <- as.data.frame(rbind(x, y)) 
     colnames(tmp0) <- colnames(test) 
     tmp1 <- interval_union(tmp0)  

    } 

    return(tmp1)  

} 



excl_1_n <- function(test, ref){ 


    testn0 <- adply(.data = ref, 1, excl_1_1, test = test, .expand=FALSE) 

    # boucle pour intersecter successivement les intervalles sets, pour gérer les intervalles disjoints (identifiés par X1, col1) 

    tmp <- range(testn0) 
    names(tmp) <- colnames(testn0)[2:3] 
    tmp <- as.data.frame(t(tmp)) 

    for(i in unique(testn0[,1])){ 
     tmp <- int_n_n(tmp, testn0[testn0[,1]==i, 2:3]) 
    } 
    return(tmp) 

} 

समावेशन

incl_1_1 <- function(test, ref){ 
    te <- as.vector(test) 
    re <- as.vector(ref) 
    if(te[1] >= re[1] & te[2] <= re[2]){ return(TRUE) } else { return(FALSE) } 
} 


incl_1_n <- function(test, ref){ 
    testn <- adply(.data = ref, 1, incl_1_1, test = test) 
    return(any(testn[,ncol(testn)])) 
} 

incl_n_n <- function(test, ref){ 

    testnn <- aaply(.data = test, 1, incl_1_n, ref, .expand = FALSE) 
    names(testnn) <- NULL 
    return(testnn) 
} 

flat_incl_n_n <- function(test, ref){ 

    ref <- interval_union(ref) 
    return(incl_n_n(test, ref)) 

} 


# testing for a vector, instead of an interval set 
incl_x_1 <- function(x, ref){ 

    test <- (x>=ref[1,1] & x<ref[1,2]) 
    return(test) 

} 

incl_x_n <- function(x, ref){ 

    test <- any(x>=ref[,1] & x<ref[,2]) 
    return(test) 

} 

उत्तर

7

मुझे लगता है कि आप sets पैकेज में कई अंतराल संबंधित कार्यों का अच्छा इस्तेमाल करने में सक्षम हो सकता है।

अंतराल निर्माण, चौराहे, सेट अंतर, संघ और पूरक के साथ-साथ अंतराल में समावेशन के लिए पैकेज के समर्थन के लिए पैकेज के समर्थन को चित्रित करने वाला एक छोटा सा उदाहरण यहां दिया गया है। इन और कई अन्य संबंधित कार्यों को ?interval के लिए सहायता पृष्ठ पर दस्तावेज किया गया है।

library(sets) 
i1 <- interval(1,6) 
i2 <- interval(5,10) 
i3 <- interval(200,400) 
i4 <- interval(202,402) 
i5 <- interval_union(interval_intersection(i1,i2), 
        interval_symdiff(i3,i4)) 

i5 
# [5, 6] U [200, 202) U (400, 402] 
interval_complement(i5) 
# [-Inf, 5) U (6, 200) U [202, 400] U (402, Inf] 

interval_contains_element(i5, 5.5) 
# [1] TRUE 
interval_contains_element(i5, 201) 
# [1] TRUE 

अपने अंतराल वर्तमान में एक दो-स्तंभ data.frame में encoded रहे हैं, तो आप mapply() की तरह कुछ इस्तेमाल कर सकते हैं उन्हें sets पैकेज द्वारा इस्तेमाल किया प्रकार के अंतराल में बदलने के लिए:

df <- data.frame(lBound = c(1,5,100), uBound = c(10, 6, 200)) 
Ints <- with(df, mapply("interval", l=lBound, r=uBound, SIMPLIFY=FALSE)) 
Ints 
# [[1]] 
# [1, 10] 

# [[2]] 
# [5, 6] 

# [[3]] 
# [100, 200] 
+1

धन्यवाद जोश मुझे 'सेट' पैकेज में भेजने के लिए। और मैप्ली चाल के लिए धन्यवाद। मैंने 'अंतराल' पैकेज भी देखा जो समान कार्यप्रणाली पेश करता है। ऐसा लगता है कि मैं दो विशेषताएं देख रहा हूं: डेटाफ्रेम जैसे स्ट्रक्चर + इंडेक्स/अंतराल के लाइन वार हैंडलिंग। लेकिन मुझे दोनों तरीकों से आगे की जांच की जरूरत है। – Pascal

+0

@ पास्कल - सुनने के लिए अच्छा है। यदि 'अंतराल' पैकेज आपके उद्देश्यों के लिए बेहतर काम करने के लिए निकलता है, तो कृपया यहां एक नोट बनाकर हमें बताएं। चीयर्स। –

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