减少重塑的计算时间

Question

我有以下数据集,我想从宽到长格式重塑:

Name     Code  CURRENCY   01/01/1980   02/01/1980   03/01/1980   04/01/1980
Abengoa  4256  USD        1.53         1.54         1.51         1.52      
Adidas   6783  USD        0.23         0.54         0.61         0.62      

这些数据包括1980年至2013年每天不同公司的股票价格.因此,我的广泛数据中有8,612列(和3,000行).现在,我使用以下命令将数据重新整形为长格式:

library(reshape)
data <- read.csv("data.csv")
data1 <- melt(data,id=c("Name","Code", "CURRENCY"),variable_name="Date")

但是,对于大约50MB的.csv文件,它已经需要大约两个小时.计算时间不应该由弱硬件驱动,因为我在具有16GB RAM的2.7 GHz Intel Core i7上运行.有没有其他更有效的方法来做到这一点？

非常感谢!

Answer 1

基准摘要:

使用Stack(如@AnandaMahto所建议的)绝对
是采用较小数据集(N <3,000)的方法.
随着数据集变大,data.table开始表现优异stack

这是一个使用data.table的选项

dtt <- data.table(data)

# non value columns, ie, the columns to keep post reshape
nvc <- c("Name","Code", "CURRENCY")

# name of columns being transformed 
dateCols <- setdiff(names(data), nvc)

# use rbind list to combine subsets
dtt2 <- rbindlist(lapply(dateCols, function(d) {
    dtt[, Date := d]
    cols <- c(nvc, "Date", d)
    setnames(dtt[, cols, with=FALSE], cols, c(nvc, "Date", "value"))
}))

## Results: 

dtt2
#       Name Code CURRENCY         Date value
# 1: Abengoa 4256      USD X_01_01_1980  1.53
# 2:  Adidas 6783      USD X_01_01_1980  0.23
# 3: Abengoa 4256      USD X_02_01_1980  1.54
# 4:  Adidas 6783      USD X_02_01_1980  0.54
# 5: ... <cropped>

使用更大的样本数据更新基准

根据@AnandaMahto的建议,下面是使用大(较大)样本数据的基准. 请随意改进下面使用的任何方法和/或添加新方法.

基准

 Resh <- quote(reshape::melt(data,id=c("Name","Code", "CURRENCY"),variable_name="Date"))
 Resh2 <- quote(reshape2::melt(data,id=c("Name","Code", "CURRENCY"),variable_name="Date"))
 DT <- quote({    nvc <- c("Name","Code", "CURRENCY"); dateCols <- setdiff(names(data), nvc); rbindlist(lapply(dateCols, function(d) { dtt[, Date := d]; cols <- c(nvc, "Date", d); setnames(dtt[, cols, with=FALSE], cols, c(nvc, "Date", "value"))}))})
 Stack <- quote(data.frame(data[1:3], stack(data[-c(1, 2, 3)])))


 # SAMPLE SIZE: ROWS = 900; COLS = 380 + 3; 
 dtt <- data.table(data);  
 benchmark(Resh=eval(Resh),Resh2=eval(Resh2),DT=eval(DT), Stack=eval(Stack), replications=5, columns=c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), order="relative")
 # relative  test elapsed user.self sys.self replications
 #    1.000 Stack   0.813     0.623    0.192            5
 #    2.530    DT   2.057     2.035    0.026            5
 #   40.470  Resh  32.902    18.410   14.602            5
 #   40.578 Resh2  32.990    18.419   14.728            5

 # SAMPLE SIZE: ROWS = 3,500; COLS = 380 + 3; 
 dtt <- data.table(data);  
 benchmark(DT=eval(DT), Stack=eval(Stack), replications=5, columns=c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), order="relative")
 #  relative  test elapsed user.self sys.self replications
 #      1.00    DT   2.407     2.336    0.076            5
 #      1.08 Stack   2.600     1.626    0.983            5

 # SAMPLE SIZE: ROWS = 27,000; COLS = 380 + 3; 
 dtt <- data.table(data);  
 benchmark(DT=eval(DT), Stack=eval(Stack), replications=5, columns=c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), order="relative")
 # relative  test elapsed user.self sys.self replications
 #    1.000    DT  10.450     7.418    3.058            5
 #    2.232 Stack  23.329    14.180    9.266            5

样本数据创建

  # rm(list=ls(all=TRUE))
  set.seed(1)
  LLLL <- apply(expand.grid(LETTERS, LETTERS[10:15], LETTERS[1:20], LETTERS[1:5], stringsAsFactors=FALSE), 1, paste0, collapse="")

  size <- 900
  dateSamples <- 380
  startDate <- as.Date("1980-01-01")

  Name <- apply(matrix(LLLL[1:(2*size)], ncol=2), 1, paste0, collapse="")
  Code <- sample(1e3:max(1e4-1, size+1e3), length(Name))
  CURRENCY <- sample(c("USD", "EUR", "YEN"), length(Name), TRUE)

  Dates <- seq(startDate, length.out=dateSamples, by="mon")
  Values <- sample(c(1:1e2, 1:5e2), size=size*dateSamples, TRUE) / 1e2

  # Calling the sample dataframe `data` to keep consistency, but I dont like this practice
  data <- data.frame(Name, Code, CURRENCY,       
                     matrix(Values, ncol=length(Dates), dimnames=list(c(), as.character(Dates)))
                    ) 

  data[1:6, 1:8]
  #        Name Code CURRENCY X1980.01.01 X1980.02.01 X1980.03.01 X1980.04.01 X1980.05.01
  # 1  AJAAQNFA 3389      YEN        0.37        0.33        3.58        4.33        1.06
  # 2  BJAARNFA 4348      YEN        1.14        2.69        2.57        0.27        3.02
  # 3  CJAASNFA 6154      USD        2.47        3.72        3.32        0.36        4.85
  # 4  DJAATNFA 9171      USD        2.22        2.48        0.71        0.79        2.85
  # 5  EJAAUNFA 2814      USD        2.63        2.17        1.66        0.55        3.12
  # 6  FJAAVNFA 9081      USD        1.92        1.47        3.51        3.23        3.68

Answer 2

从问题:

read.csv

和

...对于大约50MB的.csv文件,它已经需要大约两个小时......

因此,尽管堆叠/熔化/重塑发挥作用,我猜测(因为这是你的拳头问题)这里最大的因素是melt.假设你把它包括在你的时间以及read.csv(目前尚不清楚).

stringsAsFactors众所周知,默认参数很慢.几个简单的搜索应该显示提示和提示(例如colClasses,fread),如:

• http://cran.r-project.org/doc/manuals/R-data.html
• 快速读取非常大的表作为R中的数据帧

但我建议1.8.7中的新data.table功能fread.从R-Forge仓库安装(因为它还没有在CRAN上).为了感受read.csv,没有安装,其原始文本形式的手册页在这里:https://r-forge.r-project.org/scm/viewvc.php/pkg/man/fread.Rd？view = markup& root =数据表

实际上,示例部分有一个50MB的示例,显示在3秒内读取而不是最多60次.基准测试开始出现在其他答案中,这很好看.

如果我猜对了,那么堆栈/重塑/熔化答案是下一个顺序.

Answer 3

在测试进行时，我将发布我的评论作为答案供您考虑。尝试使用stack如下：

data1 <- data.frame(data[1:3], stack(data[-c(1, 2, 3)]))

在许多情况下，stack这些类型的运算确实非常有效，并且由于 R 中向量的回收方式，在前几列中添加回也可以快速工作。

就此而言，这可能也值得考虑：

data.frame(data[1:3],
           vals = as.vector(as.matrix(data[-c(1, 2, 3)])),
           date = rep(names(data)[-c(1, 2, 3)], each = nrow(data)))

不过，我对如此小的数据样本进行基准测试持谨慎态度，因为我怀疑结果与实际数据集的基准测试不太相似。

更新：更多基准测试的结果

使用@RicardoSaporta 的基准测试程序，我data.table对我所说的“手动”进行了基准测试data.frame创建进行了基准测试。您可以在此处查看基准测试的结果，数据集范围从 1000 行到 3000 行，增量为 500 行，并且全部具有 8003 列（8000 个数据列，加上三个初始列）。

结果可以在这里看到： http: //rpubs.com/mrdwab/reduce-computing-time

Ricardo 是正确的——似乎有大约 3000 行的东西与基本 R 方法产生了巨大的差异（如果有人对这可能是什么有任何解释，那就会很有趣）。stack但如果性能确实是首要考虑因素，那么这种“手动”方法实际上比 更快。

以下是最近三轮运行的结果：

data <- makeSomeData(2000, 8000)
dtt <- data.table(data)
suppressWarnings(benchmark(DT = eval(DT), Manual = eval(Manual), replications = 1, 
    columns = c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), 
    order = "relative"))
##   relative   test elapsed user.self sys.self replications
## 2    1.000 Manual   0.908     0.696    0.108            1
## 1    3.963     DT   3.598     3.564    0.012            1

rm(data, dateCols, nvc, dtt)

data <- makeSomeData(2500, 8000)
dtt <- data.table(data)
suppressWarnings(benchmark(DT = eval(DT), Manual = eval(Manual), replications = 1, 
    columns = c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), 
    order = "relative"))
##   relative   test elapsed user.self sys.self replications
## 2    1.000 Manual   2.841     1.044    0.296            1
## 1    1.694     DT   4.813     4.661    0.080            1

rm(data, dateCols, nvc, dtt)

data <- makeSomeData(3000, 8000)
dtt <- data.table(data)
suppressWarnings(benchmark(DT = eval(DT), Manual = eval(Manual), replications = 1, 
    columns = c("relative", "test", "elapsed", "user.self", "sys.self", "replications"), 
    order = "relative"))
##   relative   test elapsed user.self sys.self replications
## 1     1.00     DT   7.223     5.769    0.112            1
## 2    29.27 Manual 211.416     1.560    0.952            1

哎哟! data.table最后的比赛确实扭转了局面！