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\$
  • \$\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 '12 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 '12 at 15:48
  • \$\begingroup\$ Just goes to show we all could use a modified which.max(x,nth_biggest) function. \$\endgroup\$ – Carl Witthoft Apr 11 '12 at 16:39
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\$
  • \$\begingroup\$ Great @Brian Diggs. Pretty compact and simple. I like a lot. \$\endgroup\$ – nhern121 Apr 11 '12 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, privacy policy and cookie policy

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