以编程方式编辑、过滤和保存 R 中大文件列表中每个文本文件的数据?

programmatically edit, filter and save the data from each text file in large file list in R?

我下载了德国的历史天气数据,一共存储在1080个txt个文件中(原始数据可以在这个ftp:German weather historical data中找到),其中每个人气象站的数据存储在各自的 txt 格式文件中。

然而,在我的研究案例中,我只需要在每个文件中保留 01-01-1980 ~ 31-12-2014 之间的天气数据记录,其中每个单独的文本文件包含超过上述指定日期间隔(大约 100 年)的天气数据天气数据(不连续))。如果我手动编辑每个 txt 文件并且只保留 01-01-198031-12-2014 的天气数据记录,那将是非常低效和艰苦的工作。也许有一种方法可以以编程方式编辑每个文本文件,其中只保留满足我指定日期范围的天气数据记录,而必须删除其余数据记录,并且可以使用其原始格式和名称保存文件。

我以 .txt 格式下载了所有数据记录,并将它们加载到我的 R 会话中。我可以阅读它们。但是以编程方式编辑并仅保留我感兴趣的天气数据记录对我来说是未知的。我怎样才能在 R 中轻松实现这一点?在 R 中这样做可行吗?

数据如下:

> head(ClmData_files)
[1] "stella/data/germany_histData/produkt_klima_monat_17190101_20161231_00403.txt"
[2] "stella/data/germany_histData/produkt_klima_monat_17570301_19611130_01425.txt"
[3] "stella/data/germany_histData/produkt_klima_monat_17810101_20161231_02290.txt"
[4] "stella/data/germany_histData/produkt_klima_monat_17880101_20161231_05099.txt"
[5] "stella/data/germany_histData/produkt_klima_monat_17920101_19840731_04927.txt"
[6] "stella/data/germany_histData/produkt_klima_monat_18010101_19531231_03382.txt"
> tail(ClmData_files)
[1] "stella/data/germany_histData/produkt_klima_monat_20110901_20161231_00161.txt"
[2] "stella/data/germany_histData/produkt_klima_monat_20131101_20161231_15207.txt"
[3] "stella/data/germany_histData/produkt_klima_monat_20140901_20161231_15444.txt"
[4] "stella/data/germany_histData/produkt_klima_monat_20150801_20161231_01246.txt"
[5] "stella/data/germany_histData/produkt_klima_monat_20160501_20161231_15555.txt"
[6] "stella/data/germany_histData/produkt_klima_monat_20160901_20161231_01886.txt"
> length(ClmData_files)
[1] 1080

以下是 Notepad++ 中每个单独的文本文件的样子(仅前 10 行):

STATIONS_ID;MESS_DATUM_BEGINN;MESS_DATUM_ENDE;QN_4;MO_N;MO_TT;MO_TX;MO_TN;MO_FK;MX_TX;MX_FX;MX_TN;MO_SD_S;QN_6;MO_RR;MX_RS;eor
        403;17190101;17190131;    5;  -999;   2.8;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190201;17190228;    5;  -999;   1.1;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190301;17190331;    5;  -999;   5.2;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190401;17190430;    5;  -999;   9.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190501;17190531;    5;  -999;  15.1;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190601;17190630;    5;  -999;  19.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190701;17190731;    5;  -999;  21.4;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190801;17190831;    5;  -999;  18.8;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190901;17190930;    5;  -999;  13.9;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17191001;17191031;    5;  -999;   9.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor

在我从本地驱动器上的 ftp 服务器下载所有天气数据并在下面的 R 中读取它们之后:

lapply(ClmData_files, function(x) {
  read.table(x,
             sep="\t",
             fill=FALSE,
             strip.white=TRUE)
})

因为每个txt文件都有近100年的天气数据,但我只对近35年的天气数据感兴趣,用回归模型研究未来的气候变化趋势。现在我需要以编程方式访问每个 txt 文件,并根据自定义日期间隔编辑和过滤天气数据记录,并将它们保存在当前 R 会话中。有没有办法在动态 R 编程中实现这一点?有什么想法吗?

更新:

我们只需要处理每个文件中的MESS_DATUM_BEGINN (begin date);MESS_DATUM_ENDE (end date)列,只保留日期区间1980-01-01 ~ 2014-12-31内的天气数据记录,并以csv格式保存,这样的操作必须应用并扩展到所有 txt 个文件(总共 1080 个文件)。我怎样才能在 R 中以编程方式实现这一点?任何的想法?谢谢

更新 2:

现在我可以使用 rdwd 包下载德国的所有历史天气数据,这是在 R 会话中获取所有数据的代码:

install.packages("rdwd")
library(rdwd)
ftpURL <- selectDWD(name = "", exactmatch = TRUE, 
                    res="monthly", 
                    var="kl", per="historical", current = TRUE)
ftpFile <- dataDWD(file = ftpURL, dir = "stella/input/",sleep = 0)
rowData <- readDWD(ftpFile, fread = FALSE)

现在各自的历史天气数据正在运行:german historical weather data

您有多种选择,但它们都是从了解如何正确读入 table 开始的。正如评论中提到的,您试图使用制表符作为分隔符,当数据似乎很明显是 semicolon-delimited 时,尽管 可能 是制表符在那里,您可能无意中合并了多个列。

所以让我们首先只读入一个文件。请注意,我使用的是 text='...',而您应该使用 file='...' ...它只是 shorthand 用于可重现的 SO 答案。

x <- read.table(text = 'STATIONS_ID;MESS_DATUM_BEGINN;MESS_DATUM_ENDE;QN_4;MO_N;MO_TT;MO_TX;MO_TN;MO_FK;MX_TX;MX_FX;MX_TN;MO_SD_S;QN_6;MO_RR;MX_RS;eor
        403;17190101;17190131;    5;  -999;   2.8;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190201;17190228;    5;  -999;   1.1;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190301;17190331;    5;  -999;   5.2;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190401;17190430;    5;  -999;   9.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190501;17190531;    5;  -999;  15.1;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190601;17190630;    5;  -999;  19.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190701;17190731;    5;  -999;  21.4;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190801;17190831;    5;  -999;  18.8;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17190901;17190930;    5;  -999;  13.9;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor
        403;17191001;17191031;    5;  -999;   9.0;   -999;   -999;-999;-999;-999;-999;-999;-999;-999;-999;eor',
        sep = ';', header = TRUE)
str(x)
# 'data.frame': 10 obs. of  17 variables:
#  $ STATIONS_ID      : int  403 403 403 403 403 403 403 403 403 403
#  $ MESS_DATUM_BEGINN: int  17190101 17190201 17190301 17190401 17190501 17190601 17190701 17190801 17190901 17191001
#  $ MESS_DATUM_ENDE  : int  17190131 17190228 17190331 17190430 17190531 17190630 17190731 17190831 17190930 17191031
#  $ QN_4             : int  5 5 5 5 5 5 5 5 5 5
#  $ MO_N             : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MO_TT            : num  2.8 1.1 5.2 9 15.1 19 21.4 18.8 13.9 9
#  $ MO_TX            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MO_TN            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MO_FK            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MX_TX            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MX_FX            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MX_TN            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MO_SD_S          : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ QN_6             : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MO_RR            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ MX_RS            : int  -999 -999 -999 -999 -999 -999 -999 -999 -999 -999
#  $ eor              : Factor w/ 1 level "eor": 1 1 1 1 1 1 1 1 1 1

接下来,我们可以将所有日期解析为经典的 R Date 对象,或者我们可以直接将它们作为现在的整数进行处理;比较可能会以任何一种方式进行,但为了代码清晰(并且因为我怀疑您可能想进一步 analysis/visualization 使用实际的 date-like 标签)我将执行额外的步骤转换为正确的日期对象:

my_ymd <- function(a) as.Date(as.character(a), format='%Y%m%d')
x[c('MESS_DATUM_BEGINN','MESS_DATUM_ENDE')] <- lapply(x[c('MESS_DATUM_BEGINN','MESS_DATUM_ENDE')], my_ymd)
str(x[c('MESS_DATUM_BEGINN','MESS_DATUM_ENDE')])
# 'data.frame': 10 obs. of  2 variables:
#  $ MESS_DATUM_BEGINN: Date, format: "1719-01-01" "1719-02-01" "1719-03-01" "1719-04-01" ...
#  $ MESS_DATUM_ENDE  : Date, format: "1719-01-31" "1719-02-28" "1719-03-31" "1719-04-30" ...

(有几个软件包可以快速且更稳健地执行此操作。请随意使用它们中的任何一个,根据我所见,我提供了一个简单的 base-R 方法。)

从这里开始,过滤掉您想要的日期范围非常straight-forward(请注意,我使用了不同的日期,因为您的示例不包括您要过滤的日期):

keep_ymd <- my_ymd(c("17190401", "17190701"))
keep_ymd
# [1] "1719-04-01" "1719-07-01"
x[keep_ymd[1] <= x$MESS_DATUM_BEGINN & x$MESS_DATUM_ENDE <= keep_ymd[2],,drop=FALSE]
#   STATIONS_ID MESS_DATUM_BEGINN MESS_DATUM_ENDE QN_4 MO_N MO_TT MO_TX MO_TN MO_FK MX_TX MX_FX MX_TN MO_SD_S QN_6 MO_RR MX_RS eor
# 4         403        1719-04-01      1719-04-30    5 -999   9.0  -999  -999  -999  -999  -999  -999    -999 -999  -999  -999 eor
# 5         403        1719-05-01      1719-05-31    5 -999  15.1  -999  -999  -999  -999  -999  -999    -999 -999  -999  -999 eor
# 6         403        1719-06-01      1719-06-30    5 -999  19.0  -999  -999  -999  -999  -999  -999    -999 -999  -999  -999 eor

因此,要使用 lapply 将其与您的初始代码结合起来,我可能会这样做:

rawdata <- lapply(ClmData_files, read.table, sep=';', header=TRUE)
filtered <- lapply(rawdata, function(x) {
  x[c('MESS_DATUM_BEGINN','MESS_DATUM_ENDE')] <- lapply(x[c('MESS_DATUM_BEGINN','MESS_DATUM_ENDE')], my_ymd)
  x[keep_ymd[1] <= x$MESS_DATUM_BEGINN & x$MESS_DATUM_ENDE <= keep_ymd[2],,drop=FALSE]
})

(我倾向于加载原始数据并保留它,直到我确信我的前几个步骤是可靠的。)

编辑

我认为(未经测试)以下 dplyr(和朋友)管道可能有效:

library(dplyr)
library(tidyr)
library(purrr)

data_frame(fname = ClmData_files) %>%
  mutate(data = map(fname, ~ read.table(., sep=':', header=TRUE))) %>%
  mutate_at(vars(MESS_DATUM_BEGINN, MESS_DATUM_ENDE), funs(my_ymd)) %>%
  unnest() %>%
  filter(
    between(MESS_DATUM_BEGINN, keep_ymd[1], keep_ymd[2]),
    between(MESS_DATUM_ENDE, keep_ymd[1], keep_ymd[2])
  )