有没有办法用dplyr的实用程序将纯文本数据重塑为常规表格数据?

你可以使用 readLines 将原始文本文件读入文件中的行向量。然后,您可以确定哪些行包含日期,哪些行包含观察结果(基于本例中的缩进);将它们读入单独的数据帧;并根据包含日期的行的索引组合数据帧。下面是执行此操作的代码:

parse_weather <- function(file) {
  lines <- readLines(file)

  # Indicators for whether a line contains a date or an observation
  date_lines <- !startsWith(lines, " ")
  data_lines <- !date_lines

  # Number of observations for each date
  nobs <- diff(c(which(date_lines), length(lines) + 1)) - 1

  dates <- read.table(
    # repeat date for each observation
    text = paste(rep(lines[date_lines], nobs), collapse = "\n"),
    col.names = c("year", "month", "day", "days")
  )

  observations <- read.table(
    text = paste(lines[data_lines], collapse = "\n"),
    col.names = c("long", "lat", "precip", "err1", "err2")
  )

  cbind(dates, observations)
}

# I saved the example data snippet as a local text file
weather <- parse_weather("weather.txt")
head(weather, 8)
#>   year month day days  long    lat precip  err1 err2
#> 1 1980     1   1    1 6.125 47.375    0.0 20.00    1
#> 2 1980     1   1    1 6.375 47.375    0.0 19.99    1
#> 3 1980     1   1    1 6.625 47.375    0.0 19.97    1
#> 4 1980     1   1    1 6.875 47.375    0.0 19.84    1
#> 5 1980     1   1    1 7.125 47.375    0.0 20.00    1
#> 6 1980     1   2    2 6.125 47.375    1.5 20.00    1
#> 7 1980     1   2    2 6.375 47.375    1.5 19.99    1
#> 8 1980     1   2    2 6.625 47.375    1.5 19.97    1

以这种导入策略留下的长格式处理这些数据可能更容易。如果你想每天都有一列,你可以通过改变数据的形状来实现。 tidyr::spread 或 rehsape2::dcast 。

编辑: 结果是 read.table 速度非常慢,使用大矢量输入作为 text 论点粘贴 lines 将向量转换为单个字符串可以大大加快大型文件的处理速度:我相应地更新了答案。

该问题的显著特征是:

1. 每天一条标题记录,每天有可变数量的观察/详细记录
2. 不同的详细信息观察行不包括将标题链接到详细信息的键
3. 标题记录有4列,详细记录有5列
4. 由于一个经度坐标在小数点左侧最多有3位数字,因此我们无法在第一列中分析记录以区分标题记录和详细信息记录

读取此文件并将标题信息与详细信息对齐的最直接方法是利用文本处理来重塑文件,使其每个记录包含一个观察值。一旦对原始数据进行了重塑,就可以使用 read.table() 。

所需的转换可以在base R中通过以下组合完成 readLines() 和 lapply() 。

inFile <- "./data/tempdata1980.txt"
outputFile <- "./data/tempData.txt"
# delete output file if it already exists
if (file.exists(outputFile)) file.remove(outputFile)
theText <- readLines(inFile)
header <- NULL # scope to retain header across executions of lapply()
theResult <- lapply(theText,function(x){
     # reduce blanks to 1 between tokens 
     aRow <- unlist(strsplit(gsub("^ *|(?<= ) | *$", "", x, perl = TRUE)," "))
     # use <<- form of assignment operator to set to parent of if() environment 
     if (length(aRow) == 4) header <<- x
     else {
          cat(paste(header,x),file=outputFile,
              sep="\n",append=TRUE)
     }
})
# now read with read.table
colNames <- c("year","month","day","dayOfYear","long","lat","precip","err1","err2")
theData <- read.table(outputFile,header=FALSE,col.names = colNames)

。。。和输出:

> head(theData)
  year month day dayOfYear  long    lat precip  err1 err2
1 1980     1   1         1 6.125 47.375    0.0 20.00    1
2 1980     1   1         1 6.375 47.375    0.0 19.99    1
3 1980     1   1         1 6.625 47.375    0.0 19.97    1
4 1980     1   1         1 6.875 47.375    0.0 19.84    1
5 1980     1   1         1 7.125 47.375    0.0 20.00    1
6 1980     1   2         2 6.125 47.375    1.5 20.00    1
>

这种方法还避免了为了将标题记录与正确数量的细节记录合并而必须跟踪每天的观察次数。

更新:提高解决方案的性能

根据对此答案的评论,脚本需要相当长的时间才能针对OP中引用的完整数据执行。原始数据文件有407705行:365条标题记录和407340条详细记录。上述解决方案将数据转换并在约155秒内加载到MacBook Pro上的数据框中,配置如下。

• 操作系统:OS X Yosemite 10.10.4(14E46)
• 处理器:Intel i5 2.6Ghz,turbo高达3.3Ghz,双核
• 内存:8 GB
• 磁盘:512 GB,固态驱动器
• 建造日期:2013年4月

性能缓慢的原因

与向该职位提供的其他答案相比,有两个潜在的缓慢来源,包括:

1. 字符串函数的使用 gsub() 和 strsplit() ,其中一个生成字符串列表作为其输出
2. 使用 cat(...,append=TRUE) 在循环中,这意味着R必须打开文件,导航到末尾,并添加超过400000次的内容。

性能优化

我们通过以下方式调整代码以提高其性能。

1. 使用 readr 用于读写的库,因为它比基本R函数运行得快得多
2. 从写入输出 lapply() 到内存中的向量,而不是在执行期间写入磁盘 lapply() 和
3. 使用写入输出向量一次 readr::write_lines()

更新后的版本运行大约23秒,比原来的版本有了很大的改进。下面列出了修改后的代码和性能时间。

inFile <- "./data/25_krig_all_1980.txt"
outputFile <- "./data/tempData.txt"
if (file.exists(outputFile)) file.remove(outputFile)
library(readr)
system.time(theText <- readLines(inFile))
#   user  system elapsed 
#  1.821   0.027   1.859 

header <- NULL # scope to retain header across executions of lapply()
outVector <- NULL
i <- 1 
system.time(theResult <- lapply(theText,function(x){
     # reduce blanks to 1 between tokens 
     aRow <- unlist(strsplit(gsub("^ *|(?<= ) | *$", "", x, perl = TRUE)," "))
     # use <<- form of assignment operator to set to parent of if() environment 
     if (length(aRow) == 4) header <<- x
     else {
          outVector[i] <<- paste(header,x)
          i <<- i + 1
     }
}))
#   user  system elapsed 
# 19.327   0.085  19.443 

# write to file
system.time(write_lines(outVector,outputFile))
#   user  system elapsed 
#  0.079   0.020   0.117 

# now read with read.table
colNames <- c("year","month","day","dayOfYear","long","lat","precip","err1","err2")
system.time(theData <- read_table2(outputFile,col_names = colNames))
#  user  system elapsed 
# 0.559   0.071   0.794

最后一次优化

OP的另一个答案是检查记录的第一列是否为空,以确定该记录是标题记录还是详细记录。在我的帖子顶部,我注意到,由于经度可能在小数点前有3位数字,所以这种技术是有风险的。

然而,事实证明,这些数据的经度不超过本初子午线以东或以西100度,因此我们可以使用以下代码改进脚本的运行时性能。

header <- NULL # scope to retain header across executions of lapply()
outVector <- NULL
i <- 1
system.time(theResult <- lapply(theText,function(x){
     # use <<- form of assignment operator to set to parent of if() environment 
     if (substr(x,1,1) != " ") header <<- x
     else {
          outVector[i] <<- paste(header,x)
          i <<- i + 1
     }
}))
#   user  system elapsed 
#  2.840   0.080   2.933 

正如我们从性能计时中看到的,替换 strsplit() 通过简单的子字符串比较,可以改进 lapply() 从大约20秒到大约3秒。