4
\$\begingroup\$

I'm trying to implement a function that given a data frame returns the same data frame with four columns added. These new four columns are: for each row, I get the maximum element and its index and put them as two new columns. I do the same with the second maximum element. I don't care if they are repeated.

add_2max <- function(x)
{
  max1 = max(x, na.rm=TRUE)
  indmax1 = which.max(x)
  y=x[-c(indmax1)]
  max2 = max(y, na.rm=TRUE)
  indmax2 = which(x==max2)
  indmax2 = ifelse(max1==max2, indmax2[2], indmax2[1])
  x=c(x, max1, max2, indmax1, indmax2)
  return (x)
}


add_2max_df <- function(DF)
{
  NewDF=t(apply(DF, 1, add_2max))
  return(NewDF)
} 

I'm sure this code can be improved. What do you recommend in order to do that? Is it fast enough?

\$\endgroup\$
3
  • \$\begingroup\$ ifelse is notoriously slow, but since its working on a single row it shouldn't be an issue. As far as you last question... is it fast enough for you? \$\endgroup\$
    – Justin
    Apr 11, 2012 at 15:41
  • \$\begingroup\$ That's the line I'd like to avoid @Justin, but it seems not being an issue due to the fact that it's working on a single row as you've said. Thank you! \$\endgroup\$
    – nhern121
    Apr 11, 2012 at 15:48
  • \$\begingroup\$ Just goes to show we all could use a modified which.max(x,nth_biggest) function. \$\endgroup\$ Apr 11, 2012 at 16:39

2 Answers 2

4
\$\begingroup\$

Here is a more compact version:

add_2maxBrian <- function(x) {
    r <- order(x, decreasing=TRUE)
    c(x, x[r[1:2]], r[1:2])
}

With some sample data (different than Tommy's because I want the chance of ties):

set.seed(123)
DF <- as.data.frame(matrix(sample(1:20, 10000, replace=TRUE), 2500, 4))

It's not as fast a Tommy's solution, but still faster than the original.

library("rbenchmark")

benchmark(a1 <- t(apply(DF, 1, add_2max)),
          a2 <- t(apply(DF, 1, add_2maxFaster)),
          a3 <- t(apply(DF, 1, add_2maxBrian)),
          order = "relative")
#                                   test replications elapsed relative user.self
#2 a2 <- t(apply(DF, 1, add_2maxFaster))          100   6.537 1.000000     6.441
#3  a3 <- t(apply(DF, 1, add_2maxBrian))          100   8.259 1.263424     8.073
#1       a1 <- t(apply(DF, 1, add_2max))          100  12.168 1.861404    12.038
#  sys.self user.child sys.child
#2    0.067          0         0
#3    0.082          0         0
#1    0.089          0         0
identical(a1, a2) #TRUE
identical(a1, a3) #TRUE
\$\endgroup\$
1
  • \$\begingroup\$ Great @Brian Diggs. Pretty compact and simple. I like a lot. \$\endgroup\$
    – nhern121
    Apr 11, 2012 at 17:34
5
\$\begingroup\$

Here's a faster way:

add_2maxFaster <- function(x)
{
  imax1 <- which.max(x)
  imax2 <- which.max(x[-imax1])
  if (imax2 >= imax1) imax2 <- imax2 + 1L
  c(x, x[imax1], x[imax2], imax1, imax2) 
}

set.seed(42)
m <- matrix(runif(1e6), 1e4)

# Compare speed:
system.time( a1<-apply(m, 1, add_2max) )        # 0.38 secs
system.time( a2<-apply(m, 1, add_2maxFaster) )  # 0.15 secs

# ...And compare results
all.equal(a1,a2) # TRUE
\$\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.