1
\$\begingroup\$

The following function receives a vector of positive integers and list of brackets. The function returns a data frame with a logical vector for each bracket indicating whether a given element of a vector falls within that bracket.

Background

Received arguments

  • Vector x consisting of unique positive integers, usually corresponding to:

    1:6000
    c(1:100, 753:4000)
    
  • List of brackets, for instance:

    list(c(1, 325),
         c(1, 651),
         c(1, 976),
         c(1, 1301),
         c(1, 1626),
         c(1, 1952))
    

Behaviour

  • For each of the brackets, the function creates a column int_brakcet_value consisting of TRUE / FALSE values indicating whether i element of vector falls within the designed bracket

Function

assign_interval <- function(x, brackets) {
    do.call("cbind",
            lapply(
                X = brackets,
                FUN = function(bracket) {
                    findInterval(x = x,
                                 vec = bracket,
                                 rightmost.closed = TRUE)
                }
            )) -> int_dta

    # Create friendly names
    int_nms <- lapply(
        X = brackets,
        FUN = function(brc) {
            paste0("int_", paste0(brc, collapse = "_"))
        }
    )

    # Set friendly names
    int_dta <- setNames(object = as.data.frame(int_dta),
                        nm = unlist(int_nms))

    # Replace findInterval outputs with T/F
    apply(X = int_dta, MARGIN = 2,
          FUN = function(col) {
              ifelse(col == 1, TRUE, FALSE)
    }) -> int_dta

    dta_res <- data.frame(int_dta)
    rownames(dta_res) <- x


    return(dta_res)
}

Tests

x <- 1:6505

res <- assign_interval(x = x, brackets = list(c(1, 325),
                                              c(1, 651),
                                              c(1, 976),
                                              c(1, 1301),
                                              c(1, 1626),
                                              c(1, 1952)))
\$\endgroup\$
0

1 Answer 1

2
\$\begingroup\$

Maybe it is overkill to use findInterval when your brackets only have two values (a min and a max). I would suggest this much shorter function based on two outer calls with >= and <=. As you probably know, outer is efficient in that it can take advantage of vectorized functions, so here only a single call to <= and >= will be made:

assign_interval2 <- function(x, brackets) {
  stopifnot(all(lengths(brackets) == 2L))
  lower_bounds <- sapply(brackets, head, 1)
  upper_bounds <- sapply(brackets, tail, 1)
  outer(x, lower_bounds, ">=") & outer(x, upper_bounds, "<=")
}

The results are the same and benchmarks suggest this is also a bit faster:

x <- 1:6505
brackets <- list(c(1,  325), c(1,  651), c(1,  976),
                 c(1, 1301), c(1, 1626), c(1, 1952))

res1 <- assign_interval(x = x, brackets = brackets)
res2 <- assign_interval2(x = x, brackets = brackets)
any(res1 != res2)
# [1] FALSE

library(microbenchmark)
microbenchmark(
  assign_interval(x = x, brackets = brackets),
  assign_interval2(x = x, brackets = brackets)
)

# Unit: milliseconds
#                                          expr      min        lq      mean
#   assign_interval(x = x, brackets = brackets) 7.851050 11.278404 15.300305
#  assign_interval2(x = x, brackets = brackets) 1.373723  1.628319  3.134719
#     median      uq       max neval
#  13.099052 14.4824 152.33409   100
#   2.192194  3.2971  13.70505   100

That being said, let's review your code and see if we can make small suggestions to improve your code while staying true to your implementation.

Instead of the do.call("cbind", lapply(...)), you could use sapply. The s in sapply is meant to do that exactly that: simplify the output by binding the pieces together. It comes at a very small (time) performance cost which should not affect you much here considering you do not have many brackets. I also notice that you are using the -> assignment operator which is not often used by R programmers hence not recommended.

dat <- sapply(brackets, findInterval, x = x, rightmost.closed = TRUE)

For the friendly names, I think the following would read better:

lower_bounds <- sapply(brackets, head, 1)
upper_bounds <- sapply(brackets, tail, 1)
friendly_names <- paste("int", lower_bounds, upper_bounds, sep = "_")

Next, a call to setNamesis a bit inefficient as it copies your data to a separate space in memory. Instead, you should use the colnames<- function so it only modifies the attribute of your existing object.

colnames(int_dta) <- friendly_names

Next, the use of apply is pretty inefficient as it loops on the columns. Instead you could just do:

int_dta <- int_dta == 1L

to convert to a matrix of TRUE/FALSE.

At the end, you are again making an unnecessary copy of your data. You can just change the rownames of your current object, then return it.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.