使用apply将R循环转换为函数形式

Question

I've written some R code to parse strings, count occurrences of substrings, and then populate a table of substring counts. It works fine, but it's really really slow on the actual data I'm using (which is quite large), and I know a lot of that is because I'm using loops rather than functions from the apply family. I've been trying to get this code into functional form and I'm not having any luck, can anyone help? My biggest issue is I can't figure out a way to use the column names to match values within an apply construct. Here's the code with some toy data:

#Create toy data, list of unique substrings
code_frame<-matrix(c(c('a|a|b|c|d'),c('a|b|b|c|c'),c('a|b|c|d|d')),nrow=3,ncol=1)   
all_codes_list<-c('a','b','c','d')

#create data frame with a column for each code and a row for each job
code_count<-as.data.frame(matrix(0, ncol = length(all_codes_list), nrow = nrow(code_frame)))
colnames(code_count)<-all_codes_list

#fill in the code_count data frame with entries where codes occur
for(i in 1:nrow(code_frame)){
    test_string<-strsplit(code_frame[i,1],split="|",fixed=TRUE)[[1]]
    for(j in test_string){
        for(g in 1:ncol(code_count)){
            if(j == all_codes_list[g]){
                code_count[i,g]<-code_count[i,g]+1
                }
            }
        }
    }

Thanks.

Answer 1

A oneliner, split into 3 lines:

do.call(rbind,
        lapply(strsplit(code_frame[,1], "|", fixed=TRUE),
               function(x) table(factor(x, levels=all_codes_list))))

Note that strsplit is vectorised, so you don't need the outside loop over all rows. Your inner loops are basically counting up the occurrences of each code, which is an application of table . Finally, do.call(rbind, *) is the standard idiom for turning a list of rows into a single data frame.

Answer 2

The qdap package has a tool that's perfect for this and should be very fast and little coding, called mtabulate :

library(qdap)    
mtabulate(strsplit(code_frame, "\\|"))

##   a b c d
## 1 2 1 1 1
## 2 1 2 2 0
## 3 1 1 1 2

Basically it takes lists of vectors (output from strsplit ) and makes a row of tabulated info for each vector.

EDIT: If speed truly is your thing here are the benchmarks on 1000 replications ( microbenchmark package on Win 7 machine):

Unit: microseconds
     expr      min       lq   median       uq      max neval
   HONG()  592.458  620.448  632.111  644.706 4650.560  1000
  TYLER()  324.220  342.413  351.743  361.073 3556.613  1000
 HENRIK() 1527.329 1560.450 1578.177 1614.331 4828.297  1000

And visual output:

Answer 3

A base alternative:

df <- read.table(text = code_frame, sep = "|")

tt <- apply(df, 1, function(x){
  x2 <- factor(x, levels = letters[1:4])
  table(x2)
  })

t(tt) 

#      a b c d
# [1,] 2 1 1 1
# [2,] 1 2 2 0
# [3,] 1 1 1 2