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, "'", "'")
e$sentence <- stri_replace_all_fixed(e$sentence, "&", "&")
# Avoid R from wrongly interpreting ", so replace by single quotes
e$sentence <- stri_replace_all_regex(e$sentence, ""|\"", "'")
# ---
# 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
mclmpackage? Or can we safely assume thatwrite.datasetis fast and not the cause of your slow run? 2) Except forwrite.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? \$\endgroup\$readLineswithreadr::read_lines,strsplitwithstringi::stri_split_regex,subwithstringi::stri_replace_first_regex, andgsubwithstringi::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) \$\endgroup\$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. \$\endgroup\$