在 R 中，从数千个外部文件中尽可能高效和快速地计算数据帧
In R, calculate a dataframe as efficifiently and as fast as possible from thousands of external files
我正在构建一个 Shiny 应用程序，其中需要使用大量外部源文件一遍又一遍地计算大型 ggplot2 强化数据框。我正在寻找最快和最有效的方法来做到这一点。在接下来的段落中，我将更深入地研究这个主题和我目前拥有的代码，并提供输入数据以获得您的帮助。
我正在使用 Helsinki Region Travel Time Matrix 2018，这是由赫尔辛基大学的一个研究小组数字地理实验室提供的数据集。此数据使用赫尔辛基首都地区的广义地图，在 250 x 250 米的单元格中（在我的代码 grid_f 中），计算地图中所有单元格之间的旅行时间（网格 ID 称为 YKR_ID，n =13231) public 交通工具、私家车、自行车和步行。计算结果存储在带分隔符的 .txt 文件中，一个文本文件包含到特定单元格 ID 的所有行程时间。数据可供下载 at this website, under "Download the data"。注意，解压后的数据大小为 13.8 GB。
这是从数据集中的文本文件中选择的内容：
from_id;to_id;walk_t;walk_d;bike_s_t;bike_f_t;bike_d;pt_r_tt;pt_r_t;pt_r_d;pt_m_tt;pt_m_t;pt_m_d;car_r_t;car_r_d;car_m_t;car_m_d;car_sl_t
5785640;5785640;0;0;-1;-1;-1;0;0;0;0;0;0;-1;0;-1;0;-1
5785641;5785640;48;3353;51;32;11590;48;48;3353;48;48;3353;22;985;21;985;16
5785642;5785640;50;3471;51;32;11590;50;50;3471;50;50;3471;22;12167;21;12167;16
5785643;5785640;54;3764;41;26;9333;54;54;3764;54;54;3764;22;10372;21;10370;16
5787544;5785640;38;2658;10;7;1758;38;38;2658;38;38;2658;7;2183;7;2183;6
我的兴趣是可视化（使用 ggplot2）这张 250x250m 的赫尔辛基地区地图，用于一种出行方式，私家车，使用任何可能的 13231 小区 ID，如果用户需要，可以重复。因此，尽可能快速高效地获取数据帧非常重要。对于这道题，我们重点关注外部文件数据的抓取和处理，只使用一个特定的id值。
简而言之，在我制作了一个 ggplot2::fortify() 版本的 250 x 250 米网格空间数据集之后 grid_f，
- 我需要扫描所有 13231 Travel Time Matrix 2018 文本文件
- 在每个文件
中仅选择相关列（from_id、to_id、car_r_t、car_m_t、car_sl_t）
- 在每个文件中使用
from_id（在本例中为 origin_id <- "5985086"）选择相关行
- 将结果行加入强化空间数据
grid_f
我的代码如下：
# Libraries
library(ggplot2)
library(dplyr)
library(rgdal)
library(data.table)
library(sf)
library(sp)
# File paths. ttm_path is the folder which contains the unchanged Travel
# Time Matrix 2018 data from the research group's home page
ttm_path <- "HelsinkiTravelTimeMatrix2018"
gridpath <- "MetropAccess_YKR_grid_EurefFIN.shp"
#### Import grid cells
# use this CRS information throughout the app
app_crs <- sp::CRS("+init=epsg:3067")
# Read grid shapefile and transform
grid_f <- rgdal::readOGR(gridpath, stringsAsFactors = TRUE) %>%
sp::spTransform(., app_crs) %>%
# preserve grid dataframe data in the fortify
{dplyr::left_join(ggplot2::fortify(.),
as.data.frame(.) %>%
dplyr::mutate(id = as.character(dplyr::row_number() - 1)))} %>%
dplyr::select(-c(x, y))
这一点以上的代码仅用于 运行 一次。下面的代码或多或少会 运行 一遍又一遍地使用不同的 origin_ids.
#### Fetch TTM18 data
origin_id <- "5985086"
origin_id_num <- as.numeric(origin_id)
# column positions of columns from_id, to_id, car_r_t, car_m_t, car_sl_t
col_range <- c(1, 2, 14, 16, 18)
# grid_f as data.table version
dt_grid <- as.data.table(grid_f)
# Get filepaths of all of the TTM18 data. Remove metadata textfile filepath.
all_files <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE,
full.names = TRUE)
all_files <- all_files[-length(all_files)]
# lapply function
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fread(x, select = col_range)
res <- subset(res, from_id == origin_id)
return(res)
}
# The part of the code that needs to be fast and efficient
result <-
lapply(all_files, FUN = TTM18_fetch, col_range, origin_id_num) %>%
data.table::rbindlist(., fill = TRUE) %>%
data.table::merge.data.table(dt_grid, ., by.x = "YKR_ID", by.y = "to_id")
数据框 result 应该有 66155 行 12 个变量，每个 250x250 米的网格单元有五行。列为 YKR_ID、long、lat、order、hole、piece、id、group , from_id, car_r_t, car_m_t, car_sl_t.
我当前的 lapply() 和 data.table::fread() 解决方案大约需要 2-3 分钟才能完成。我认为这已经是一个很好的成就了，但我忍不住想有更好更快的方法来完成这个。到目前为止，我已经尝试了这些替代方法来代替我现在拥有的方法：
- 传统的 for 循环：这显然是一个缓慢的解决方案
- 我试图自学更多有关 R 中矢量化函数的知识，但这并没有取得任何进展。 Used this link
- 尝试尝试
with() 但未成功 , inspired by this SO question
- 查看了包
parallel 但由于我正在使用 Windows 环境而最终没有使用它
- 试图用
apply() 和 sapply() 找到解决此问题的替代方法，但结果没有什么值得注意的。
至于为什么我在 ggplot2::fortify 之前没有对数据执行所有这些操作，我只是觉得使用 SpatialPolygonsDataFrame 很麻烦。
感谢您的宝贵时间。
每当我想弄清楚如何提高我的 R 的性能时
函数，我一般使用下面的方法。首先，我寻找任何
可能不必要的函数调用或识别多个地方
函数调用可以简化为一个。然后，我在我的
通过对每个代码进行基准测试而招致最大时间损失的代码
分开的部分。这可以使用 microbenchmark 轻松完成
包裹.
例如，我们可以询问是否有更好的性能
管道（例如%>%）。
# hint... piping is always slower
library(magrittr)
library(microbenchmark)
microbenchmark(
pipe = iris %>% subset(Species=='setosa'),
no_pipe = subset(iris, Species=='setosa'),
times = 200)
Unit: microseconds
expr min lq mean median uq max neval cld
pipe 157.518 196.739 308.1328 229.6775 312.6565 2473.582 200 b
no_pipe 84.894 116.386 145.4039 126.1950 139.4100 612.492 200 a
在这里，我们发现在没有管道的情况下删除 data.frame 的子集
花费将近一半的时间来执行！
接下来，我确定每个位置的净时间惩罚
通过将执行时间乘以它的总次数来进行基准测试
需要被执行。对于净时间损失最大的区域，
我尝试用更快的函数替换它 and/or 尝试减少总数
需要执行的次数。
TLDR
对于您的情况，您可以使用 fst package 来加快速度
尽管您需要将 csv 文件转换为 fst 文件。
# before
TTM18_fetch <- function(x, col_range, origin_id) {
res <- data.table::fread(x, select = col_range)
res <- subset(res, from_id == origin_id)
return(res)
}
# after (NB x needs to be a fst file)
col_range <- c('from_id', 'to_id', 'car_r_t', 'car_m_t', 'car_sl_t')
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fst::read_fst(path = x,
columns = col_range,
as.data.table = TRUE)[from_id==origin_id]
return(res)
}
将您的 csv 文件转换为 fst
library(data.table)
library(fst)
ttm_path <- 'REPLACE THIS'
new_ttm_path <- 'REPLACE THIS'
# Get filepaths of all of the TTM18 data. Remove metadata textfile filepath.
all_files <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE,
full.names = TRUE)
all_files <- all_files[-grepl('[Mm]eta', all_files)]
# creating new file paths and names for fst files
file_names <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE)
file_names <- file_names[-grepl('[Mm]eta', file_names)]
file_names <- gsub(pattern = '.csv$',
replacement = '.fst',
x =file_names)
file_names <- file.path(new_ttm_path, file_names)
# csv to fst conversion
require(progress) # this will help you create track of things
pb <- progress_bar$new(
format = " :what [:bar] :percent eta: :eta",
clear = FALSE, total = length(file_names), width = 60)
# an index file to store from_id file locations
from_id_paths <- data.table(from_id = numeric(),
file_path = character())
for(i in seq_along(file_names)){
pb$tick(tokens = list(what = 'reading'))
tmp <- data.table::fread(all_files[i], key = 'from_id')
pb$update(tokens = list(what = 'writing'))
fst::write_fst(tmp,
compress = 50, # less compressed files read faster
path = file_names[i] )
pb$update(tokens = list(what = 'indexing'))
from_id_paths <- rbind(from_id_paths,
data.table(from_id = unique(tmp$from_id),
file_path = file_names[i]))
}
setkey(from_id_paths, from_id)
write_fst(from_id_paths,
path = file.path('new_ttm_path', 'from_id_index.fst'),
compress = 0)
这将是替代品
library(fst)
library(data.table)
new_ttm_path <- 'REPLACE THIS'
#### Fetch TTM18 data
origin_id <- "5985086"
origin_id_num <- as.numeric(origin_id)
# column positions of columns from_id, to_id, car_r_t, car_m_t, car_sl_t
col_range <- c('from_id', 'to_id', 'car_r_t', 'car_m_t', 'car_sl_t')
# grid_f as data.table version
dt_grid <- as.data.table(grid_f)
nescessary_files <- read_fst(path = file.path(new_ttm_path,
'from_id_index.fst'),
as.data.table = TRUE
)[from_id==origin_id,file_path]
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fst::read_fst(path = x,
columns = col_range,
as.data.table = TRUE)[from_id==origin_id]
return(res)
}
result <- rbindlist(lapply(nescessary_files, FUN = TTM18_fetch, col_range, origin_id_num),
fill = TRUE)
result <- data.table::merge.data.table(dt_grid, result, by.x = "YKR_ID", by.y = "to_id")
我正在构建一个 Shiny 应用程序，其中需要使用大量外部源文件一遍又一遍地计算大型 ggplot2 强化数据框。我正在寻找最快和最有效的方法来做到这一点。在接下来的段落中，我将更深入地研究这个主题和我目前拥有的代码，并提供输入数据以获得您的帮助。
我正在使用 Helsinki Region Travel Time Matrix 2018，这是由赫尔辛基大学的一个研究小组数字地理实验室提供的数据集。此数据使用赫尔辛基首都地区的广义地图，在 250 x 250 米的单元格中（在我的代码 grid_f 中），计算地图中所有单元格之间的旅行时间（网格 ID 称为 YKR_ID，n =13231) public 交通工具、私家车、自行车和步行。计算结果存储在带分隔符的 .txt 文件中，一个文本文件包含到特定单元格 ID 的所有行程时间。数据可供下载 at this website, under "Download the data"。注意，解压后的数据大小为 13.8 GB。
这是从数据集中的文本文件中选择的内容：
from_id;to_id;walk_t;walk_d;bike_s_t;bike_f_t;bike_d;pt_r_tt;pt_r_t;pt_r_d;pt_m_tt;pt_m_t;pt_m_d;car_r_t;car_r_d;car_m_t;car_m_d;car_sl_t
5785640;5785640;0;0;-1;-1;-1;0;0;0;0;0;0;-1;0;-1;0;-1
5785641;5785640;48;3353;51;32;11590;48;48;3353;48;48;3353;22;985;21;985;16
5785642;5785640;50;3471;51;32;11590;50;50;3471;50;50;3471;22;12167;21;12167;16
5785643;5785640;54;3764;41;26;9333;54;54;3764;54;54;3764;22;10372;21;10370;16
5787544;5785640;38;2658;10;7;1758;38;38;2658;38;38;2658;7;2183;7;2183;6
我的兴趣是可视化（使用 ggplot2）这张 250x250m 的赫尔辛基地区地图，用于一种出行方式，私家车，使用任何可能的 13231 小区 ID，如果用户需要，可以重复。因此，尽可能快速高效地获取数据帧非常重要。对于这道题，我们重点关注外部文件数据的抓取和处理，只使用一个特定的id值。
简而言之，在我制作了一个 ggplot2::fortify() 版本的 250 x 250 米网格空间数据集之后 grid_f，
- 我需要扫描所有 13231 Travel Time Matrix 2018 文本文件
- 在每个文件 中仅选择相关列（
- 在每个文件中使用
from_id（在本例中为origin_id <- "5985086"）选择相关行 - 将结果行加入强化空间数据
grid_f
from_id、to_id、car_r_t、car_m_t、car_sl_t）
我的代码如下：
# Libraries
library(ggplot2)
library(dplyr)
library(rgdal)
library(data.table)
library(sf)
library(sp)
# File paths. ttm_path is the folder which contains the unchanged Travel
# Time Matrix 2018 data from the research group's home page
ttm_path <- "HelsinkiTravelTimeMatrix2018"
gridpath <- "MetropAccess_YKR_grid_EurefFIN.shp"
#### Import grid cells
# use this CRS information throughout the app
app_crs <- sp::CRS("+init=epsg:3067")
# Read grid shapefile and transform
grid_f <- rgdal::readOGR(gridpath, stringsAsFactors = TRUE) %>%
sp::spTransform(., app_crs) %>%
# preserve grid dataframe data in the fortify
{dplyr::left_join(ggplot2::fortify(.),
as.data.frame(.) %>%
dplyr::mutate(id = as.character(dplyr::row_number() - 1)))} %>%
dplyr::select(-c(x, y))
这一点以上的代码仅用于 运行 一次。下面的代码或多或少会 运行 一遍又一遍地使用不同的 origin_ids.
#### Fetch TTM18 data
origin_id <- "5985086"
origin_id_num <- as.numeric(origin_id)
# column positions of columns from_id, to_id, car_r_t, car_m_t, car_sl_t
col_range <- c(1, 2, 14, 16, 18)
# grid_f as data.table version
dt_grid <- as.data.table(grid_f)
# Get filepaths of all of the TTM18 data. Remove metadata textfile filepath.
all_files <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE,
full.names = TRUE)
all_files <- all_files[-length(all_files)]
# lapply function
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fread(x, select = col_range)
res <- subset(res, from_id == origin_id)
return(res)
}
# The part of the code that needs to be fast and efficient
result <-
lapply(all_files, FUN = TTM18_fetch, col_range, origin_id_num) %>%
data.table::rbindlist(., fill = TRUE) %>%
data.table::merge.data.table(dt_grid, ., by.x = "YKR_ID", by.y = "to_id")
数据框 result 应该有 66155 行 12 个变量，每个 250x250 米的网格单元有五行。列为 YKR_ID、long、lat、order、hole、piece、id、group , from_id, car_r_t, car_m_t, car_sl_t.
我当前的 lapply() 和 data.table::fread() 解决方案大约需要 2-3 分钟才能完成。我认为这已经是一个很好的成就了，但我忍不住想有更好更快的方法来完成这个。到目前为止，我已经尝试了这些替代方法来代替我现在拥有的方法：
- 传统的 for 循环：这显然是一个缓慢的解决方案
- 我试图自学更多有关 R 中矢量化函数的知识，但这并没有取得任何进展。 Used this link
- 尝试尝试
with()但未成功 - 查看了包
parallel但由于我正在使用 Windows 环境而最终没有使用它 - 试图用
apply()和sapply()找到解决此问题的替代方法，但结果没有什么值得注意的。
至于为什么我在 ggplot2::fortify 之前没有对数据执行所有这些操作，我只是觉得使用 SpatialPolygonsDataFrame 很麻烦。
感谢您的宝贵时间。
每当我想弄清楚如何提高我的 R 的性能时
函数，我一般使用下面的方法。首先，我寻找任何
可能不必要的函数调用或识别多个地方
函数调用可以简化为一个。然后，我在我的
通过对每个代码进行基准测试而招致最大时间损失的代码
分开的部分。这可以使用 microbenchmark 轻松完成
包裹.
例如，我们可以询问是否有更好的性能
管道（例如%>%）。
# hint... piping is always slower
library(magrittr)
library(microbenchmark)
microbenchmark(
pipe = iris %>% subset(Species=='setosa'),
no_pipe = subset(iris, Species=='setosa'),
times = 200)
Unit: microseconds
expr min lq mean median uq max neval cld
pipe 157.518 196.739 308.1328 229.6775 312.6565 2473.582 200 b
no_pipe 84.894 116.386 145.4039 126.1950 139.4100 612.492 200 a
在这里，我们发现在没有管道的情况下删除 data.frame 的子集
花费将近一半的时间来执行！
接下来，我确定每个位置的净时间惩罚 通过将执行时间乘以它的总次数来进行基准测试 需要被执行。对于净时间损失最大的区域， 我尝试用更快的函数替换它 and/or 尝试减少总数 需要执行的次数。
TLDR
对于您的情况，您可以使用 fst package 来加快速度
尽管您需要将 csv 文件转换为 fst 文件。
# before
TTM18_fetch <- function(x, col_range, origin_id) {
res <- data.table::fread(x, select = col_range)
res <- subset(res, from_id == origin_id)
return(res)
}
# after (NB x needs to be a fst file)
col_range <- c('from_id', 'to_id', 'car_r_t', 'car_m_t', 'car_sl_t')
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fst::read_fst(path = x,
columns = col_range,
as.data.table = TRUE)[from_id==origin_id]
return(res)
}
将您的 csv 文件转换为 fst
library(data.table)
library(fst)
ttm_path <- 'REPLACE THIS'
new_ttm_path <- 'REPLACE THIS'
# Get filepaths of all of the TTM18 data. Remove metadata textfile filepath.
all_files <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE,
full.names = TRUE)
all_files <- all_files[-grepl('[Mm]eta', all_files)]
# creating new file paths and names for fst files
file_names <- list.files(path = ttm_path,
pattern = ".txt$",
recursive = TRUE)
file_names <- file_names[-grepl('[Mm]eta', file_names)]
file_names <- gsub(pattern = '.csv$',
replacement = '.fst',
x =file_names)
file_names <- file.path(new_ttm_path, file_names)
# csv to fst conversion
require(progress) # this will help you create track of things
pb <- progress_bar$new(
format = " :what [:bar] :percent eta: :eta",
clear = FALSE, total = length(file_names), width = 60)
# an index file to store from_id file locations
from_id_paths <- data.table(from_id = numeric(),
file_path = character())
for(i in seq_along(file_names)){
pb$tick(tokens = list(what = 'reading'))
tmp <- data.table::fread(all_files[i], key = 'from_id')
pb$update(tokens = list(what = 'writing'))
fst::write_fst(tmp,
compress = 50, # less compressed files read faster
path = file_names[i] )
pb$update(tokens = list(what = 'indexing'))
from_id_paths <- rbind(from_id_paths,
data.table(from_id = unique(tmp$from_id),
file_path = file_names[i]))
}
setkey(from_id_paths, from_id)
write_fst(from_id_paths,
path = file.path('new_ttm_path', 'from_id_index.fst'),
compress = 0)
这将是替代品
library(fst)
library(data.table)
new_ttm_path <- 'REPLACE THIS'
#### Fetch TTM18 data
origin_id <- "5985086"
origin_id_num <- as.numeric(origin_id)
# column positions of columns from_id, to_id, car_r_t, car_m_t, car_sl_t
col_range <- c('from_id', 'to_id', 'car_r_t', 'car_m_t', 'car_sl_t')
# grid_f as data.table version
dt_grid <- as.data.table(grid_f)
nescessary_files <- read_fst(path = file.path(new_ttm_path,
'from_id_index.fst'),
as.data.table = TRUE
)[from_id==origin_id,file_path]
TTM18_fetch <- function(x, col_range, origin_id) {
res <- fst::read_fst(path = x,
columns = col_range,
as.data.table = TRUE)[from_id==origin_id]
return(res)
}
result <- rbindlist(lapply(nescessary_files, FUN = TTM18_fetch, col_range, origin_id_num),
fill = TRUE)
result <- data.table::merge.data.table(dt_grid, result, by.x = "YKR_ID", by.y = "to_id")