3
\$\begingroup\$

I am wondering if it's possible to avoid looping. I want to make the function faster. The function is to find how many times a particular value is lower in the overall data. For example:

Value <- c(0,10,5,1,0,0,11,0,0,7,3,2,5) # length =13

The 1st value is 0 and 0 is NOT lower in any of the values. Therefore the value I would like to return from the function would be 0.

Something like this:

sum(Values < 0) 
0

The 2nd value is 10:

sum(Values < 10)
11

I make a function something like below:

fun_num <- function(Value){
  gg <- vector()
  for (i in seq_along(Value)){
    x <- Value[i]
    y <- sum(Value < x)
    gg[i] <- y
  }
  return(gg)
}

Applying the function:

fun_num(Value)

[1]  0 11  8  5  0  0 12  0  0 10  7  6  8

Just wondering, is there a way to speed this function up using sapply and avoid using for loop?

\$\endgroup\$
2
\$\begingroup\$

This should suffice

fun_2 <- function(x) sapply(x, function(y) sum(x < y))
fun_2(Value)
# [1]  0 11  8  5  0  0 12  0  0 10  7  6  8

P.S. sapply/lapply are the same loops, just masked and a little bit faster.

Or if your data is very large we can do it a lot faster using data.table, aggregating the data and counting:

require(data.table)
fun_3 <- function(Value) {
  d <- data.table(x = Value) # creates 1 column data.table
  # setkey(d, x) # not needed here keyby sets the key
  d <- d[, .N, keyby = x] # calculate count of each unique x value
  # and sorts the results
  d[, a := c(0, cumsum(N)[-.N])] # calculate lagged cumsum from N (counts)
  # a represents element count that is smaller than x
  d[.(Value), a] # using datatable-keys-fast-subset get a(result) for each Value
}

set.seed(42)
Value2 <- sample.int(1e5)

system.time(r2 <- fun_2(Value2)) # 36.64 
system.time(r3 <- fun_3(Value2)) # 0.03 
all.equal(r2, r3)
# [1] TRUE

OR with base R:

fun_4 <- function(x) {
  xorder <- order(x)
  xsorted <- x[xorder]
  xsdifs <- c(0, diff(xsorted))
  m <- seq_along(xsdifs) - 1L
  m[xsdifs == 0L] <- 0L
  m <- cummax(m)
  m[order(xorder)]
}

For reverse (Value > x):

fun_2r <- function(x) sapply(x, function(y) sum(x > y))
fun_3r <- function(Value) {
  d <- data.table(x = Value)
  d <- d[, .N, keyby = x]
  setorder(d, -x)
  d[, a := c(0, cumsum(N)[-.N])]
  setkey(d, x) # need to reset key for sub setting,
  # because reordering d removes it
  d[.(Value), a]
}
| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks you very much minem. I am trying to understand fun_3 better, but hopefully I will get it. Specifically if I wanted to do the reverse, ie sum(x > y) rather than sum(x < y). Its easy to edit fun_2, but if you could help explain fun_3 better it would be wonderful. And could you point out some resource to learn more advance resource about programming in R. I'd like to improve my current 'programming' in R. Thanks in advance \$\endgroup\$ – Zak Mar 8 '19 at 14:06
  • \$\begingroup\$ @Zak I like: github.com/Rdatatable/data.table/wiki/Getting-started \$\endgroup\$ – minem Mar 8 '19 at 14:27
  • \$\begingroup\$ @Zak added some comments. I advise that you run the code line by line and inspect the results, to get better feeling of whats happening. \$\endgroup\$ – minem Mar 8 '19 at 14:43
  • 1
    \$\begingroup\$ findInterval(Value, sort(Value) + 0.1) \$\endgroup\$ – Khashaa Mar 8 '19 at 16:15
2
\$\begingroup\$

Consider also colSums wrapping outer where you compare the vector with itself:

less_than <- function (vec)
      colSums(outer(vec, vec, function (x, y) x < y))

less_than(Value)
# [1]  0 11  8  5  0  0 12  0  0 10  7  6  8
| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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