As a follow-up to this question concerning Python I present you with the exact same thing - for R.

Initially I started with R. However, it takes 44 minutes to run when unleashed on all my data. I then looked for an alternative. I read about Python and got advised to use pandas by a colleague. So I set out on an adventure. At first I was disappointed because my script was actually slower than my R script. Luckily I got some great help which reduced the execution time of my Python script drastically. When running it against all my data it takes ... 4 minutes (!) to execute. That's more than 11x faster than the R script. So I thought to myself, if the good folk at CR can bring the speed of my scripts up to such a good time, then maybe they can do something similar for my R script.

Eventually I'll be going with Python because I'm more familiar with the methods used there, so basically this is a contest for you guys. Can you optimise the R script below so that it finishes more quickly than its Python equivalent in the answer provided above?

Here's a copy-paste of what my script is actually doing:


I am working on a project which crunches plain text files (.lst). Data to test the script can be downloaded here.

The name of the file names (fileName) are important because I'll extract node (e.g. abessijn) and component (e.g. WR-P-E-A) from them into a dataframe.

Examples:

abessijn.WR-P-E-A.lst
A-bom.WR-P-E-A.lst
acroniem.WR-P-E-C.lst
acroniem.WR-P-E-G.lst
adapter.WR-P-E-A.lst
adapter.WR-P-E-C.lst
adapter.WR-P-E-G.lst

Each file consists of one or more line. Each line consists of a sentence (inside <sentence> tags).

Example (abessijn.WR-P-E-A.lst):

<sentence>Vooral mijn abessijn ruikt heerlijk kruidig .. : ) )</sentence>
<sentence>Mijn abessijn denkt daar heel anders over .. : ) ) Maar mijn kinderen richt ik ook niet af , zit niet in mijn bloed .</sentence>

From each line I extract the sentence, do some small modifications to it, and call it sentence. Up next is an element called leftContext, which takes the first part of the split between node (e.g. abessijn) and the sentence it came from. Finally, from leftContext I get precedingWord, which is the word preceding node in sentence, or the right most word in leftContext (with some limitations such as the option of a compound formed with a hyphen).

Example:

ID | filename             | node | component | precedingWord      | leftContext                               |  sentence
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
1    adapter.WR-P-P-F.lst  adapter  WR-P-P-F   aanpassingseenheid  Een aanpassingseenheid (                      Een aanpassingseenheid ( adapter ) , 
2    adapter.WR-P-P-F.lst  adapter  WR-P-P-F   toestel             Het toestel (                                 Het toestel ( adapter ) draagt zorg voor de overbrenging van gegevens
3    adapter.WR-P-P-F.lst  adapter  WR-P-P-F   de                  de aansluiting tussen de sensor en de         de aansluiting tussen de sensor en de adapter , 
4    airbag.WS-U-E-A.lst   airbag   WS-U-E-A   den                 ja voor den                                   ja voor den airbag op te pompen eh :p
5    airbag.WS-U-E-A.lst   airbag   WS-U-E-A   ne                  Dobby , als ze valt heeft ze dan wel al ne    Dobby , als ze valt heeft ze dan wel al ne airbag hee

That dataframe is exported as dataset.csv.

After that, the intention of my project comes at hand: I create a frequency table that takes node and precedingWord into account. From a variable I define neuter and non_neuter, e.g (in Python):

neuter = ["het", "Het"]
non_neuter = ["de","De"]

and a rest category unspecified. When precedingWord is an item from the list, assign it to the variable. Example of a frequency table output:

node    |   neuter   | nonNeuter   | unspecified
-------------------------------------------------
A-bom       0          4             2
acroniem    3          0             2
act         3          2             1

The frequency list is exported as frequencies.csv.


My R script looks like this:

# ---
# STEP 0: Preparations
    start_time <- Sys.time()
  ## 1. Set working directory in R
    setwd("C:/User/Desktop/testdata")

  ## 2. Load required library/libraries
    library(dplyr)
    library(stringi)

  ## 3. Create directory where we'll save our dataset(s)
    dir.create("../R/dataset", showWarnings = FALSE)
    Rprof("../R/dataset/profiling.out", line.profiling=TRUE)

# ---
# STEP 1: Loop through files, get data from the file_name

    ## 1. Create first dataframe, based on file_name of all files
    files <- list.files(pattern="*.lst", full.names=T, recursive=FALSE)
    d <- data.frame(file_name = stri_trans_tolower(unname(sapply(files, basename))), stringsAsFactors = FALSE)

    ## 2. Create additional columns (word & component) based on file_name
    file_nameSplit <- stri_split_fixed(d$file_name, ".")
    d$node <- sapply(file_nameSplit, "[", 1)
    d$component <- sapply(file_nameSplit, "[", 2)
    d$file_name <- paste(d$node, d$component, sep=".")

# ---
# STEP 2: Loop through files again, but now also through its contents
# In other words: get the sentences

    ## 1. Create second set which is an rbind of multiple frames
    ## One two-column data.frame per file
    ## First column is file_name, second column is data from each file
    e <- do.call(rbind, lapply(files, function(x) {
        data.frame(file_name = stri_trans_tolower(unname(sapply(x, basename))), sentence = readLines(x, encoding="UTF-8"), stringsAsFactors = FALSE)
    }))

    # Before doing anything else we got to
    # get rid of some characters we can't use such as ³ and ¾
    e$sentence <- stri_replace_all_regex(e$sentence, "[^[:graph:]\\s]", "")
    # Only NOW we can lower-case it
    e$sentence <- stri_trans_tolower(e$sentence)

    ## 2. Clean file_name
     e$file_name <- stri_replace_first_regex(e$file_name, "(.*)\\.lst$", "$1")

    ## 3. Get the sentence and clean
    e$sentence <- stri_replace_all_regex(e$sentence, ".*?<sentence>(.*?)</sentence>", "$1")
        # Remove floating space before/after punctuation
        e$sentence <- stri_replace_all_regex(e$sentence, "\\s(?:(?=[.,:;?!) ])|(?<=\\( ))", "")
        # Add space after triple dots ...
        e$sentence <- stri_replace_all_regex(e$sentence, "\\.{3}(?=[^\\s])", "... ")

      # Transform HTML entities into characters
      # It is unfortunate that there's no easier way to do this
      # E.g. Python provides the HTML package which can unescape (decode) HTML
      # characters
          e$sentence <- stri_replace_all_fixed(e$sentence, "&apos;", "'")
          e$sentence <- stri_replace_all_fixed(e$sentence, "&amp;", "&")
        # Avoid R from wrongly interpreting ", so replace by single quotes
          e$sentence <- stri_replace_all_regex(e$sentence, "&quot;|\"", "'")


# ---
# STEP 3:
# Create final dataframe

  ## 1. Merge d and e by common column name file_name
    df <- merge(d, e, by="file_name", all=TRUE)

  ## 2. Make sure that only those sentences in which df$node is present in df$sentence are taken into account
    matchFunction <- function(x, y) any(x == y)
    matchedFrame <- with(df, mapply(matchFunction, node, stri_split_regex(sentence, "[ :?.,]")))
    df <- df[matchedFrame, ]

  ## 3. Create left_context based on the split of the word and the sentence
    # Use paste0 to make sure we are looking for the node, not a compound
    # node can only be preceded by a space, but can be followed by punctuation as well
    contexts <- stri_split_regex(df$sentence, paste0("(^| )", df$node, "( |[!\",.:;?})\\]])"))
    df$left_context <- sapply(contexts, `[`, 1)

  ## 4. Get the word preceding the node
    df$preceding_word <- stri_replace_all_regex(df$left_context, "^.*\\b(?<!-)(\\w+(?:-\\w+)*)[^\\w]*$","$1")

  ## 5. Improve readability by sorting columns
    df <- df[c("file_name", "component", "preceding_word", "node", "left_context", "sentence")]

  ## 6. Write dataset to dataset dir
    # write.csv2(df,"../R/dataset/r-dataset.csv")


# ---
# STEP 4:
# Create dataset with frequencies

  ## 1. Define neuter and nonNeuter classes
    neuter <- c("het")
    non.neuter<- c("de")

  ## 2. Mutate df to fit into usable frame
    freq <- mutate(df, gender = ifelse(!df$preceding_word %in% c(neuter, non.neuter), "unspecified",
      ifelse(df$preceding_word %in% neuter, "neuter", "non_neuter")))

  ## 3. Transform into table, but still usable as data frame (i.e. matrix)
  ## Also add column name "node"
    freqTable <- table(freq$node, freq$gender) %>%
      as.data.frame.matrix %>%
      mutate(node = row.names(.))

  ## 4. Small adjustements
    freqTable <- freqTable[,c(4,1:3)]

  ## 5. Write dataset to dataset dir
    write.csv2(freqTable,"../R/dataset/r-frequencies.csv")


    diff <- Sys.time() - start_time # calculate difference
    print(diff) # print in nice format
    Rprof(NULL)
    summaryRprof("../R/dataset/profiling.out")

I swapped out the mclm library for a native write.csv2. Also, note that the testdata is only a quick way to test the script and its output. Actual data consists of 16.500 files, consisting of between 1 to 100s of lines!

I also ran some basic profiling. (See script above.) Here are the results. I will now run the profiling on all the data, maybe there's a difference.

$by.self
                  self.time self.pct total.time total.pct
".Call"                0.48     60.0       0.50      62.5
"readLines"            0.08     10.0       0.10      12.5
"lapply"               0.02      2.5       0.14      17.5
"[.data.frame"         0.02      2.5       0.04       5.0
"rbind"                0.02      2.5       0.04       5.0
".row_names_info"      0.02      2.5       0.02       2.5
"=="                   0.02      2.5       0.02       2.5
"deparse"              0.02      2.5       0.02       2.5
"file"                 0.02      2.5       0.02       2.5
"gsub"                 0.02      2.5       0.02       2.5
"ifelse"               0.02      2.5       0.02       2.5
"match"                0.02      2.5       0.02       2.5
"paste0"               0.02      2.5       0.02       2.5
"sort.list"            0.02      2.5       0.02       2.5

$by.total
                           total.time total.pct self.time self.pct
".Call"                          0.50      62.5      0.48     60.0
"stri_replace_all_regex"         0.24      30.0      0.00      0.0
"stri_split_regex"               0.22      27.5      0.00      0.0
"do.call"                        0.16      20.0      0.00      0.0
"lapply"                         0.14      17.5      0.02      2.5
"data.frame"                     0.14      17.5      0.00      0.0
"FUN"                            0.14      17.5      0.00      0.0
"eval"                           0.12      15.0      0.00      0.0
"readLines"                      0.10      12.5      0.08     10.0
"<Anonymous>"                    0.06       7.5      0.00      0.0
"mapply"                         0.06       7.5      0.00      0.0
"with"                           0.06       7.5      0.00      0.0
"with.default"                   0.06       7.5      0.00      0.0
"[.data.frame"                   0.04       5.0      0.02      2.5
"rbind"                          0.04       5.0      0.02      2.5
"["                              0.04       5.0      0.00      0.0
"as.data.frame"                  0.04       5.0      0.00      0.0
"merge"                          0.04       5.0      0.00      0.0
"merge.data.frame"               0.04       5.0      0.00      0.0
"stri_trans_tolower"             0.04       5.0      0.00      0.0
".row_names_info"                0.02       2.5      0.02      2.5
"=="                             0.02       2.5      0.02      2.5
"deparse"                        0.02       2.5      0.02      2.5
"file"                           0.02       2.5      0.02      2.5
"gsub"                           0.02       2.5      0.02      2.5
"ifelse"                         0.02       2.5      0.02      2.5
"match"                          0.02       2.5      0.02      2.5
"paste0"                         0.02       2.5      0.02      2.5
"sort.list"                      0.02       2.5      0.02      2.5
"%>%"                            0.02       2.5      0.00      0.0
"as.data.frame.character"        0.02       2.5      0.00      0.0
"doTryCatch"                     0.02       2.5      0.00      0.0
"eval.parent"                    0.02       2.5      0.00      0.0
"evalq"                          0.02       2.5      0.00      0.0
"factor"                         0.02       2.5      0.00      0.0
"mutate"                         0.02       2.5      0.00      0.0
"mutate_"                        0.02       2.5      0.00      0.0
"mutate_.data.frame"             0.02       2.5      0.00      0.0
"mutate_.tbl_df"                 0.02       2.5      0.00      0.0
"mutate_impl"                    0.02       2.5      0.00      0.0
"paste"                          0.02       2.5      0.00      0.0
"sapply"                         0.02       2.5      0.00      0.0
"stri_replace_first_regex"       0.02       2.5      0.00      0.0
"table"                          0.02       2.5      0.00      0.0
"tryCatch"                       0.02       2.5      0.00      0.0
"tryCatchList"                   0.02       2.5      0.00      0.0
"tryCatchOne"                    0.02       2.5      0.00      0.0
"unname"                         0.02       2.5      0.00      0.0
"vapply"                         0.02       2.5      0.00      0.0
"write.csv2"                     0.02       2.5      0.00      0.0
"write.table"                    0.02       2.5      0.00      0.0

And when profiling the script when it runs all my data:

$by.self
                          self.time self.pct total.time total.pct
"rbind"                     1905.88    79.16    1908.12     79.25
".Call"                      256.76    10.66     260.04     10.80
"file"                        84.04     3.49      84.06      3.49
"readLines"                   51.38     2.13     135.92      5.65
"mapply"                      17.84     0.74      61.46      2.55
"data.frame"                  16.00     0.66     160.12      6.65
"sort.list"                   13.72     0.57      13.78      0.57
"<Anonymous>"                 12.72     0.53    1926.64     80.02
"lapply"                      11.34     0.47     156.58      6.50
"make.unique"                  7.38     0.31      10.20      0.42
"=="                           4.46     0.19       4.46      0.19
"ifelse"                       2.92     0.12       3.28      0.14
"as.character"                 2.82     0.12       2.82      0.12
"unique.default"               2.52     0.10       2.54      0.11
"unlist"                       2.28     0.09       2.38      0.10
"match"                        2.16     0.09       3.06      0.13
"anyDuplicated.default"        1.68     0.07       1.68      0.07
"any"                          1.44     0.06       1.44      0.06
"[.data.frame"                 1.38     0.06      25.98      1.08
"paste0"                       1.10     0.05       1.10      0.05
".deparseOpts"                 0.82     0.03       1.66      0.07
"deparse"                      0.68     0.03       2.98      0.12
"pmatch"                       0.50     0.02       0.52      0.02
"[["                           0.48     0.02       1.24      0.05
"is.factor"                    0.42     0.02       0.42      0.02
"as.data.frame"                0.36     0.01       6.94      0.29
"integer"                      0.34     0.01       0.34      0.01
"FUN"                          0.30     0.01     145.80      6.06
"match.fun"                    0.30     0.01       0.30      0.01
"order"                        0.26     0.01       0.42      0.02
"close.connection"             0.26     0.01       0.26      0.01
"merge.data.frame"             0.22     0.01      40.20      1.67
"close"                        0.22     0.01       0.48      0.02
"as.list"                      0.20     0.01       0.26      0.01
"lengths"                      0.20     0.01       0.20      0.01
"unique"                       0.16     0.01       2.88      0.12
"names"                        0.16     0.01       0.16      0.01
"as.data.frame.vector"         0.14     0.01       0.20      0.01
"%in%"                         0.12     0.00       2.58      0.11
"table"                        0.12     0.00       2.24      0.09
"make.names"                   0.10     0.00       0.62      0.03
"Make.row.names"               0.10     0.00       0.12      0.00
"list.files"                   0.10     0.00       0.10      0.00
"unclass"                      0.10     0.00       0.10      0.00
"simplify2array"               0.08     0.00       3.24      0.13
"attr"                         0.08     0.00       0.08      0.00
"sum"                          0.08     0.00       0.08      0.00
"sapply"                       0.06     0.00      13.22      0.55
"as.data.frame.character"      0.06     0.00       3.28      0.14
"[[.data.frame"                0.06     0.00       0.76      0.03
".row_names_info"              0.06     0.00       0.06      0.00
"as.list.default"              0.06     0.00       0.06      0.00
"length"                       0.06     0.00       0.06      0.00
"mode"                         0.04     0.00       1.24      0.05
"inDL"                         0.04     0.00       0.04      0.00
"is.expression"                0.04     0.00       0.04      0.00
"is.matrix"                    0.04     0.00       0.04      0.00
"lazyLoadDBfetch"              0.04     0.00       0.04      0.00
"sys.call"                     0.04     0.00       0.04      0.00
"do.call"                      0.02     0.00    2053.84     85.30
"stri_trans_tolower"           0.02     0.00      18.94      0.79
"factor"                       0.02     0.00       2.10      0.09
"!"                            0.02     0.00       0.02      0.00
".External2"                   0.02     0.00       0.02      0.00
".set_row_names"               0.02     0.00       0.02      0.00
".subset2"                     0.02     0.00       0.02      0.00
"abs"                          0.02     0.00       0.02      0.00
"anyNA"                        0.02     0.00       0.02      0.00
"as.integer"                   0.02     0.00       0.02      0.00
"c"                            0.02     0.00       0.02      0.00
"find.package"                 0.02     0.00       0.02      0.00
"force"                        0.02     0.00       0.02      0.00
"getOption"                    0.02     0.00       0.02      0.00
"is.data.frame"                0.02     0.00       0.02      0.00
"is.na"                        0.02     0.00       0.02      0.00
"list"                         0.02     0.00       0.02      0.00
"nzchar"                       0.02     0.00       0.02      0.00
"paste"                        0.02     0.00       0.02      0.00

$by.total
                           total.time total.pct self.time self.pct
"do.call"                     2053.84     85.30      0.02     0.00
"<Anonymous>"                 1926.64     80.02     12.72     0.53
"rbind"                       1908.12     79.25   1905.88    79.16
".Call"                        260.04     10.80    256.76    10.66
"data.frame"                   160.12      6.65     16.00     0.66
"lapply"                       156.58      6.50     11.34     0.47
"FUN"                          145.80      6.06      0.30     0.01
"readLines"                    135.92      5.65     51.38     2.13
"stri_replace_all_regex"       121.96      5.07      0.00     0.00
"stri_split_regex"             110.08      4.57      0.00     0.00
"file"                          84.06      3.49     84.04     3.49
"eval"                          67.02      2.78      0.00     0.00
"mapply"                        61.46      2.55     17.84     0.74
"with"                          61.46      2.55      0.00     0.00
"with.default"                  61.46      2.55      0.00     0.00
"merge"                         40.22      1.67      0.00     0.00
"merge.data.frame"              40.20      1.67      0.22     0.01
"[.data.frame"                  25.98      1.08      1.38     0.06
"["                             25.98      1.08      0.00     0.00
"stri_trans_tolower"            18.94      0.79      0.02     0.00
"cbind"                         14.32      0.59      0.00     0.00
"sort.list"                     13.78      0.57     13.72     0.57
"sapply"                        13.22      0.55      0.06     0.00
"make.unique"                   10.20      0.42      7.38     0.31
"as.data.frame"                  6.94      0.29      0.36     0.01
"stri_replace_first_regex"       5.48      0.23      0.00     0.00
"=="                             4.46      0.19      4.46     0.19
"stri_replace_all_fixed"         3.48      0.14      0.00     0.00
"mutate"                         3.38      0.14      0.00     0.00
"mutate_"                        3.38      0.14      0.00     0.00
"mutate_.data.frame"             3.38      0.14      0.00     0.00
"doTryCatch"                     3.34      0.14      0.00     0.00
"tryCatch"                       3.34      0.14      0.00     0.00
"tryCatchList"                   3.34      0.14      0.00     0.00
"tryCatchOne"                    3.34      0.14      0.00     0.00
"ifelse"                         3.28      0.14      2.92     0.12
"as.data.frame.character"        3.28      0.14      0.06     0.00
"evalq"                          3.28      0.14      0.00     0.00
"mutate_.tbl_df"                 3.28      0.14      0.00     0.00
"mutate_impl"                    3.28      0.14      0.00     0.00
"simplify2array"                 3.24      0.13      0.08     0.00
"match"                          3.06      0.13      2.16     0.09
"deparse"                        2.98      0.12      0.68     0.03
"unique"                         2.88      0.12      0.16     0.01
"as.character"                   2.82      0.12      2.82     0.12
"%in%"                           2.58      0.11      0.12     0.00
"unique.default"                 2.54      0.11      2.52     0.10
"unlist"                         2.38      0.10      2.28     0.09
"%>%"                            2.26      0.09      0.00     0.00
"table"                          2.24      0.09      0.12     0.00
"factor"                         2.10      0.09      0.02     0.00
"unname"                         2.06      0.09      0.00     0.00
"anyDuplicated.default"          1.68      0.07      1.68     0.07
"anyDuplicated"                  1.68      0.07      0.00     0.00
".deparseOpts"                   1.66      0.07      0.82     0.03
"any"                            1.44      0.06      1.44     0.06
"[["                             1.24      0.05      0.48     0.02
"mode"                           1.24      0.05      0.04     0.00
"paste0"                         1.10      0.05      1.10     0.05
"[[.data.frame"                  0.76      0.03      0.06     0.00
"make.names"                     0.62      0.03      0.10     0.00
"pmatch"                         0.52      0.02      0.50     0.02
"close"                          0.48      0.02      0.22     0.01
"is.factor"                      0.42      0.02      0.42     0.02
"order"                          0.42      0.02      0.26     0.01
"data.row.names"                 0.40      0.02      0.00     0.00
"integer"                        0.34      0.01      0.34     0.01
"match.fun"                      0.30      0.01      0.30     0.01
"close.connection"               0.26      0.01      0.26     0.01
"as.list"                        0.26      0.01      0.20     0.01
"lengths"                        0.20      0.01      0.20     0.01
"as.data.frame.vector"           0.20      0.01      0.14     0.01
"names"                          0.16      0.01      0.16     0.01
"Make.row.names"                 0.12      0.00      0.10     0.00
"list.files"                     0.10      0.00      0.10     0.00
"unclass"                        0.10      0.00      0.10     0.00
"attr"                           0.08      0.00      0.08     0.00
"sum"                            0.08      0.00      0.08     0.00
".row_names_info"                0.06      0.00      0.06     0.00
"as.list.default"                0.06      0.00      0.06     0.00
"length"                         0.06      0.00      0.06     0.00
"::"                             0.06      0.00      0.00     0.00
"asNamespace"                    0.06      0.00      0.00     0.00
"getExportedValue"               0.06      0.00      0.00     0.00
"getNamespace"                   0.06      0.00      0.00     0.00
"loadNamespace"                  0.06      0.00      0.00     0.00
"vapply"                         0.06      0.00      0.00     0.00
"inDL"                           0.04      0.00      0.04     0.00
"is.expression"                  0.04      0.00      0.04     0.00
"is.matrix"                      0.04      0.00      0.04     0.00
"lazyLoadDBfetch"                0.04      0.00      0.04     0.00
"sys.call"                       0.04      0.00      0.04     0.00
"dyn.load"                       0.04      0.00      0.00     0.00
"library.dynam"                  0.04      0.00      0.00     0.00
"match.names"                    0.04      0.00      0.00     0.00
"!"                              0.02      0.00      0.02     0.00
".External2"                     0.02      0.00      0.02     0.00
".set_row_names"                 0.02      0.00      0.02     0.00
".subset2"                       0.02      0.00      0.02     0.00
"abs"                            0.02      0.00      0.02     0.00
"anyNA"                          0.02      0.00      0.02     0.00
"as.integer"                     0.02      0.00      0.02     0.00
"c"                              0.02      0.00      0.02     0.00
"find.package"                   0.02      0.00      0.02     0.00
"force"                          0.02      0.00      0.02     0.00
"getOption"                      0.02      0.00      0.02     0.00
"is.data.frame"                  0.02      0.00      0.02     0.00
"is.na"                          0.02      0.00      0.02     0.00
"list"                           0.02      0.00      0.02     0.00
"nzchar"                         0.02      0.00      0.02     0.00
"paste"                          0.02      0.00      0.02     0.00
"_fseq"                          0.02      0.00      0.00     0.00
"as.lazy_dots"                   0.02      0.00      0.00     0.00
"eval.parent"                    0.02      0.00      0.00     0.00
"freduce"                        0.02      0.00      0.00     0.00
"tbl_df"                         0.02      0.00      0.00     0.00
"withVisible"                    0.02      0.00      0.00     0.00
"write.csv2"                     0.02      0.00      0.00     0.00
"write.table"                    0.02      0.00      0.00     0.00

The amount of rows:

> nrow(d)
[1] 16,417
> nrow(e)
[1] 3,352,602
> nrow(df)
[1] 2,816,442
> nrow(freqTable)
[1] 1532
  • 1) where can we find the mclm package? Or can we safely assume that write.dataset is fast and not the cause of your slow run? 2) Except for write.dataset, I was able to run your code on the sample data you provided in the zip and it ran very fast: 1.3 seconds. Your real data must be a lot larger for your code to run for 44 minutes, can you please give more info: number of files, and total number of rows (nrow(e))? 3) Have you done some basic profiling to identify the slow parts of the process? – flodel Aug 25 '15 at 1:29
  • Easy to grab SIGNIFICANT improvements: replace readLines with readr::read_lines, strsplit with stringi::stri_split_regex, sub with stringi::stri_replace_first_regex, and gsub with stringi::stri_replace_all_regex. Making these changes make your code run 15x faster on your sample data. I'll be happy to help more if you can answer some of the questions above, especially 2) – flodel Aug 25 '15 at 2:51
  • @flodel I must have done something wrong, but performance hasn't improved significantly when using the stringi package (see my edited code above) – Bram Vanroy Aug 25 '15 at 16:44
  • I think I did something wrong, where I forgot to move the arguments around when switching from sub/gsub to their stringi versions. I had checked that the final output (freqTable) were identical though... Can you try to answer my question 2) above? It will really help benchmark your code and see where improvements will be beneficial. – flodel Aug 25 '15 at 22:20
  • @flodel I had some more time on my hands this morning so I removed the mclm package, added profiling and other information and updated the script. Please see my edit! – Bram Vanroy Aug 26 '15 at 12:20
up vote 1 down vote accepted

Give this a shot!

setwd("C:/User/Desktop/testdata")
library(dplyr)
library(stringi)
library(readr)

dir.create("../R/dataset", showWarnings = FALSE)
Rprof("../R/dataset/profiling.out")
files <- list.files(pattern = "[.]lst$", full.names = TRUE)
file.pattern <- "^.*[/](([^.]+)[.]([^.]+))[.]lst$"
d <- data.frame(file_name = tolower(sub(file.pattern, "\\1", files)),
                node      = tolower(sub(file.pattern, "\\2", files)),
                component = tolower(sub(file.pattern, "\\3", files)))
l <- lapply(files, readLines, encoding = "UTF-8")
n <- vapply(l, length, integer(1L))
e <- data.frame(sentence  = unlist(l, use.names = FALSE),
                file_name = rep(d$file_name, n),
                node      = rep(d$node     , n),
                component = rep(d$component, n),
                stringsAsFactors = FALSE)

e$sentence <- stri_replace_all_regex(e$sentence, "[^[:graph:]\\s]", "")
e$sentence <- stri_trans_tolower(e$sentence)
e$sentence <- stri_replace_all_regex(e$sentence, ".*?<sentence>(.*?)</sentence>", "$1")
e$sentence <- stri_replace_all_regex(e$sentence, "\\s(?:(?=[.,:;?!) ])|(?<=\\( ))", "")
e$sentence <- stri_replace_all_regex(e$sentence, "\\.{3}(?=[^\\s])", "... ")
e$sentence <- stri_replace_all_fixed(e$sentence, "&apos;", "'")
e$sentence <- stri_replace_all_fixed(e$sentence, "&amp;", "&")
e$sentence <- stri_replace_all_regex(e$sentence, "&quot;|\"", "'")

is.matched <- with(e, unlist(
   Map(`%in%`, node, stri_split_regex(sentence, "[ :?.,]")),
   use.names = FALSE
))
df <- e[is.matched, ]

contexts <- stri_split_regex(df$sentence, paste0("(^| )", df$node, "( |[!\",.:;?})\\]])"))
df$left_context <- vapply(contexts, `[[`, character(1L), 1L)
df$preceding_word <- stri_replace_all_regex(df$left_context, "^.*\\b(?<!-)(\\w+(?:-\\w+)*)[^\\w]*$","$1")
df <- df[c("file_name", "component", "preceding_word", "node", "left_context", "sentence")]

neuter <- c("het")
non.neuter<- c("de")
df$gender <- ifelse(df$preceding_word %in% c(neuter),     "neuter",
             ifelse(df$preceding_word %in% c(non.neuter), "non_neuter",       
                                                          "unspecified"))
freqTable <- table(df$node, df$gender) %>%
   as.data.frame.matrix %>%
   cbind(node = row.names(.), .)

write.csv2(freqTable,"../R/dataset/r-frequencies.csv", row.names = FALSE)
Rprof(NULL)
summaryRprof("../R/dataset/profiling.out")

What are the improvements?

  1. The profiler showed that rbind-ing your 16.5k data.frames was the main culprit. Instead, I create a data.frame after dumping the list of sentences into a single vector. I am also able to compute the vector of corresponding filenames using the function rep.
  2. Untested: assuming merge() was also computationally expensive, I used rep() again to append the node and component. You could check by yourself if this is instead faster this way.
  3. I used the supposedly faster readr::read_lines instead of readLines
  4. Your matchFunction is presumably a slow re-implementation of the %in% function
  5. I replaced mapply with the faster unlist(Map(...), use.names = FALSE) construct. Also sapply with vapply. mapply and sapply are slower because they try to simplify your output data.
  6. Where possible, I have avoided large duplications of your data, e.g. where you were using mutate. Instead, I just appended column(s) to your existing data

There are certainly more things that can be done. One thing that comes to mind is to use the data.table package instead of data.frames since you have such a large data. But please let us know first how much faster this code is. Maybe it won't be worth the extra effort.

  • This is looking very promising. However, you may notice that something goes wrong when using diacritics. Take for instance the file attachécase in the testdata. It isn't included in the resulting dataset. I have done some testing with encoding but I can't find the culprit. Whenever a filename/node/sentence contains a special character such as éàçè that node will never make it to the end results, even if the node can be found in the sentence. Any ideas? +1 for your efforts so far! – Bram Vanroy Aug 31 '15 at 13:34
  • Is that not a problem with your original code though? Nothing I introduced, right? – flodel Sep 1 '15 at 0:06
  • I'm afraid you have. In my own code this isn't a problem. – Bram Vanroy Sep 1 '15 at 6:21
  • It seems to go wrong when reading the lines in e with the readr package. The encoding is wrong. For the special characters, I need UTF-8. – Bram Vanroy Sep 1 '15 at 14:45
  • After some digging I found that this is an issue with readr. See this issue. Here it is stated that in future versions an encoding argument will be supported. For now it seems better for me to use the vanilla readLines. Don't you agree? Could you modify your code accordingly? – Bram Vanroy Sep 1 '15 at 15:08

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

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