Intervalo establece el álgebra en R (unión, intersección, diferencia, la inclusión, ...)

Question

Me pregunto si un marco adecuado para la manipulación y comparación intervalo existe en R.

Después de alguna búsqueda, sólo pude para encontrar lo siguiente: - function findInterval in base Package. (Pero casi no lo entiendo) - algunas respuestas aquí y allá sobre la unión e intersección (en particular: http://r.789695.n4.nabble.com/Union-Intersect-two-continuous-sets-td4224545.html)

sabría usted de una iniciativa para implementar un conjunto completo de herramientas para maneja fácilmente tareas frecuentes en la manipulación de intervalo, como inclusion/setdiff/union/intersection/etc. (por ejemplo, ver aquí para obtener una lista de funcionalidades)? o ¿tiene algún consejo para desarrollar este enfoque?

continuación se presentan algunos borradores de mi lado para hacerlo. sin duda es incómodo y todavía tiene algunos errores, pero podría ilustrar lo que estoy buscando.

---

aspectos preliminares sobre las opciones tomadas - debe hacer frente a la perfección con intervalos o intervalos establecidos - intervalos se representan como 2 columnas data.frames (límite inferior, superior frontera), en una fila - intervalos son conjuntos representada como 2 columnas con varias filas - podría ser necesaria una tercera columna para la identificación de intervalos establece

---

UNION

interval_union <- function(df){ # for data frame 

    df <- interval_clean(df) 
    if(is.empty(df)){ 
     return(as.data.frame(NULL)) 
    } else { 

     if(is.POSIXct(df[,1])) { 
      dated <- TRUE 
      df <- colwise(as.numeric)(df) 
     } else { 
      dated <- FALSE 
     } 
     M <- as.matrix(df) 

     o <- order(c(M[, 1], M[, 2])) 
     n <- cumsum(rep(c(1, -1), each=nrow(M))[o]) 
     startPos <- c(TRUE, n[-1]==1 & n[-length(n)]==0) 
     endPos <- c(FALSE, n[-1]==0 & n[-length(n)]==1) 

     M <- M[o] 

     if(dated == TRUE) { 
      df2 <- colwise(mkDateTime)(as.data.frame(cbind(M[startPos], M[endPos])), from.s = TRUE) 
     } else { 
      df2 <- as.data.frame(cbind(M[startPos], M[endPos])) 
     } 
     colnames(df2) <- colnames(df) 

     # print(df2) 
     return(df2) 

    } 


} 


union_1_1 <- function(test, ref){ 
    names(ref) <- names(test) 
    tmp <- interval_union(as.data.frame(rbind(test, ref))) 
    return(tmp) 
} 


union_1_n <- function(test, ref){ 
    return(union_1_1(test, ref)) 
} 


union_n_n <- function(test, ref){ 
    testnn <- adply(.data = test, 1, union_1_n, ref, .expand = FALSE) 
    return(testnn) 
} 

ref_interval_union <- function(df, ref){ 

    tmp0 <- adply(df, 1, union_1_1, ref, .expand = FALSE) # set to FALSE to keep ID 
    return(tmp0)     
} 

INTERSECCIÓN

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

} 

EXCLUSIÓN

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) 

} 

INCLUSIÓN

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) 

} 

Answer 1

Creo que podría ser capaz de hacer un buen uso de las muchas funciones relacionados con el intervalo en el paquete sets.

Aquí está un pequeño ejemplo que ilustra el apoyo del paquete para la construcción de intervalo, intersección, diferencia establecido, unión, y la complementación, así como su prueba para la inclusión en un intervalo. Estas y muchas otras funciones relacionadas están documentadas en la página de ayuda para ?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 

Si los intervalos son codificados en un momento hoja.de.datos de dos columnas, se puede usar algo como mapply() para convertirlos en intervalos del tipo utilizado por el paquete de 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]