4
\$\begingroup\$

For loops are the devil. I can't see a way to speed this up with apply or other more speedy functions though...

pred <- read.csv("predictions_from_external_multinomial_model.csv")

pred$id <- test_users$user_id

pred$first   <- "a"
pred$second  <- "b"
pred$third   <- "c"
pred$fourth  <- "d"
pred$fifth   <- "e"

for(i in 1:nrow(pred)){
  pred$first[i]   <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
  pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0

  pred$second[i]  <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
  pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0

  pred$third[i]   <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
  pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0

  pred$fourth[i]   <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
  pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0

  pred$fifth[i]   <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
  pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0
}


data_long <- melt(pred, id.vars=("id"), measure.vars = c("first", "second", "third", "fourth", "fifth"), value.name = "country")
data_long <- data_long[order(data_long$id),]
data_long$variable <- NULL

What it's doing is picking the top 5 results for each individual, based on the column value of 12 columns in the original prediction dataset.

In the imported csv file each row is a unique individual and each possible prediction class in in a column indexed from 2 to 13.

Here's an example dataset in case you wish to reproduce it (you can use line numbers or an arbitrary sequence in place of test_users$user_id in the code above):

http://wikisend.com/download/535006/2023bd19b880.csv

\$\endgroup\$
  • \$\begingroup\$ To get an idea about the speed requirements, how many rows/cols of data do you have? \$\endgroup\$ – flodel Jan 15 '16 at 13:00
  • \$\begingroup\$ 12 key columns (13 total) and about 62,000 rows. Right now it takes approximately 30 - 45 minutes to run. \$\endgroup\$ – Hack-R Jan 15 '16 at 14:17
3
\$\begingroup\$

This is a solution using data.table and without loops.

require(data.table)

pred <- fread("/home/djhurio/Downloads/2023bd19b880.csv")

pred[, id := 1:.N]

# Melt to long format
data_long <- melt(pred, id.vars = "id", measure.vars = names(pred)[2:13],
                  variable.name = "country")

# Order data by id (A) and value (D)
setorderv(data_long, c("id", "value"), order = c(1, -1))

# Numerate records for each id
data_long[, i := 1:.N, by = id]

# Select top 5
data_long <- data_long[i < 6, .(id, country)]

data_long
\$\endgroup\$
0
\$\begingroup\$

As this is code review, what I can tell about your actual code (I had apreciate a dput(head(pred)) as my company firewal prevent me to get your file):

pred$first[i]   <- names(pred[which(pred[i,] == max(pred[i,2:13]))])
pred[i,names(pred[which(pred[i,] == max(pred[i,2:13]))])] <- 0

You have a lot of extraneous and redundant calls here, if I understand properly, what it does is:

Fill pred[i,'first'] with the column name of the top value from this line and then set the entry to 0.

I would get rid of the subsetting and of the which call, get the columns position only once and get the names from a vector baked before the loop.

And to avoid repeating yourself, I would nest a second loop:

cnames <- colnames(pred)

for(i in 1:nrow(pred)) {
  for(n in c('first','second','third','fourth','fifth')) {
    pos <- pred[i,] == max(pred[i,2:13])
    pred[i,n] <- cnames[pos]
    pred[i,pos] <- 0
  }
}

More readable IMO, and probably faster by reducing the number of calls done.

The code is still brittle, if an id match the max value for a row or if there's 2 equal predictions it will fail (more than 1 name to put into first, second, etc.). Prefer the data.table solution given by @djhurio.

Sample dataset used (very small, just to ensure the results are ok):

pred <- structure(list(id = 1:10, V1 = c(1L, 9L, 9L, 6L, 3L, 1L, 8L, 
2L, 10L, 7L), V2 = c(9L, 2L, 6L, 12L, 4L, 4L, 13L, 13L, 7L, 5L
), V3 = c(12L, 11L, 10L, 3L, 11L, 9L, 4L, 6L, 11L, 9L), V4 = c(7L, 
10L, 7L, 8L, 9L, 3L, 7L, 9L, 13L, 2L), V5 = c(11L, 5L, 11L, 11L, 
12L, 5L, 11L, 7L, 5L, 11L), V6 = c(10L, 8L, 5L, 4L, 8L, 11L, 
3L, 8L, 4L, 1L), V7 = c(5L, 3L, 12L, 13L, 2L, 7L, 10L, 4L, 12L, 
10L), V8 = c(2L, 13L, 8L, 5L, 1L, 13L, 12L, 3L, 6L, 6L), V9 = c(13L, 
7L, 2L, 7L, 10L, 10L, 2L, 11L, 9L, 12L), V10 = c(4L, 4L, 13L, 
10L, 5L, 8L, 6L, 12L, 8L, 8L), V11 = c(6L, 12L, 3L, 9L, 6L, 12L, 
5L, 10L, 2L, 4L), V12 = c(3L, 1L, 1L, 1L, 13L, 6L, 1L, 1L, 3L, 
3L), V13 = c(8L, 6L, 4L, 2L, 7L, 2L, 9L, 5L, 1L, 13L), first = c("a", 
"a", "a", "a", "a", "a", "a", "a", "a", "a"), second = c("b", 
"b", "b", "b", "b", "b", "b", "b", "b", "b"), third = c("c", 
"c", "c", "c", "c", "c", "c", "c", "c", "c"), fourth = c("d", 
"d", "d", "d", "d", "d", "d", "d", "d", "d"), fifth = c("e", 
"e", "e", "e", "e", "e", "e", "e", "e", "e")), .Names = c("id", 
"V1", "V2", "V3", "V4", "V5", "V6", "V7", "V8", "V9", "V10", 
"V11", "V12", "V13", "first", "second", "third", "fourth", "fifth"
), row.names = c(NA, -10L), class = "data.frame")
\$\endgroup\$
  • \$\begingroup\$ That's why I included a head in the command, and as I say my company firewall block the acces as 'file sharing site' which are denied by compa'y policy... I can't say it more clearly. Up to you to give self containing exemples to get wide feedback or to ignore this remark and get feedback from people able to Download your file. Having to guess original data is not encouraging to give feedback IMO. \$\endgroup\$ – Tensibai Jan 20 '16 at 20:31

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.