How to convert a for-loop to lapply function for parallel testing purposes?-CodePudding

I've been studying the advantages/disadvantages of for-loops versus versus the apply() family of functions and the answer isn't clear cut (apply() always faster than for-loops may not be true, depending on circumstances). So I want to test the various options against my actual data.

Below is a for-loop which looks pretty straightforward to me, but I'm unsure of how to replace it with lapply(). I assume lapply() is correct since the for-loop produces a list object.

The actual data I need to run this analysis against is a data frame containing 2.5 million rows, 30 columns, so I'd like to run speed tests against the various options.

Any explanation would be most helpful. The examples I found online are light on explanations or the for-loops examples overly-complex, and I hope to learn to use apply() family functions well as they seem very useful and simpler to read than for-loops.

Here's the simplified for-loop code, with example data frame, which runs correctly for example purposes:

# Set up data frame to perform migration analysis on:
data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    Flags = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0")
  )

# Function to set-up base table:
setTable <- function(data){
  df <- data.frame(matrix(NA, ncol=length(unique(data$Flags)), nrow=length(unique(data$Flags))))
  row.names(df) <- unique(data$Flags)
  names(df) <- unique(data$Flags)
  return(df)
}

# Function to complete migration table with for-loop:
migration <- function(data, from=1, to=3){
  df <- setTable(data)
  for (i in unique(data$ID)){
    id_from <- as.character(data$Flags[(data$ID == i & data$Period == from)])
    id_to <- as.character(data$Flags[data$ID == i & data$Period == to])
    column <- which(names(df) == id_from)
    row <- which(row.names(df) == id_to)
    df[row, column] <- ifelse(is.na(df[row, column]), 1, df[row, column]   1)
  }
  return(df)
}

# Now to run the function:
test1 <- migration(data, from=1, to=3)

CodePudding user response：

When it comes to speed in R, you can almost always count on library(data.table):

library(data.table)

DT <- setDT(data.frame(
  ID = c(1,1,1,2,2,2,3,3,3,4,4,4),
  Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3),
  Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9, 3, 6, 9),
  Flags = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0", "X2","X1","X0")
))

unique_flags <- unique(DT$Flags)
all_flags <- setDT(expand.grid(list(first_flag = unique_flags, last_flag = unique_flags)))

resultDT <- dcast(DT[, .(first_flag = first(Flags), last_flag = last(Flags)), by = ID][
  ,.N, c("first_flag", "last_flag")][
    all_flags, on = c("first_flag", "last_flag")], last_flag ~ first_flag, value.var = "N")

print(resultDT)

Step by step:

library(data.table)

DT <- setDT(data.frame(
  ID = c(1,1,1,2,2,2,3,3,3,4,4,4),
  Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3),
  Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9, 3, 6, 9),
  Flags = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0", "X2","X1","X0")
))

unique_flags <- unique(DT$Flags)
all_flags <- setDT(expand.grid(list(first_flag = unique_flags, last_flag = unique_flags)))

resultDT <- DT[, .(first_flag = first(Flags), last_flag = last(Flags)), by = ID] # find relevant flags
resultDT <- resultDT[,.N, c("first_flag", "last_flag")] # count transitions
resultDT <- resultDT[all_flags, on = c("first_flag", "last_flag")] # merge all combinations
resultDT <- dcast(resultDT, last_flag ~ first_flag, value.var = "N") # dcast
print(resultDT)

Regarding lapply you can do (I'd prefer data.table):

# Set up data frame to perform migration analysis on:
input_data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    Flags = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0")
  )

# Function to set-up base table:
setTable <- function(data){
  DF <- data.frame(matrix(NA, ncol=length(unique(data$Flags)), nrow=length(unique(data$Flags))))
  row.names(DF) <- unique(data$Flags)
  names(DF) <- unique(data$Flags)
  return(DF)
}

# Function to complete migration table with for-loop:
migration <- function(data, from=1, to=3){
  DF <- setTable(data)
  lapply(seq_along(unique(data$ID)), function(i){
    id_from <- as.character(data$Flags[(data$ID == i & data$Period == from)])
    id_to <- as.character(data$Flags[data$ID == i & data$Period == to])
    column <- which(names(DF) == id_from)
    row <- which(row.names(DF) == id_to)
    DF[row, column] <<- ifelse(is.na(DF[row, column]), 1, DF[row, column]   1)
  })
  return(DF)
}

# Now to run the function:
test1 <- migration(input_data, from=1, to=3)