将ascii网格数据读入矩阵格式

Question

我正在尝试将 ASCII TOMS 网格格式的文件读入 R。我已经能够以它在 R 中打开的方式读取它。但是，我以线性矩阵的形式打开。该文件包含的内容摘要可在此处获得：

[Link](http://www.temis.nl/docs/README_TOMSASCII.pdf)

数据集的样本可以在这里下载：

[Link](http://www.temis.nl/airpollution/no2col/no2monthscia.php?Year=2005&Month=04)

该数据集是 2006 年 1 月的数据集，我只是将其重命名以方便访问，因为我需要处理的数据很多。我在使用中阅读它：

CCC<-read.csv("no2_200601.asc",header=FALSE,skip=4,sep="\t")
dim(CCC)
[1] 52560    1

如何将其读入 R，以便每个纬度的数据位于一行？我觉得这将有助于建立一个适当的数据结构。 注意：让我尝试一下，简单地说，我理解：
这意味着结构是这样的，一行表示标题，例如lat=-89.9，接下来的 144 行有 20 个元素，每个元素都属于 lat=-89.9 行；所以我现在的问题是在下一个“lat=...”之前将所有这些元素读入一行。

此外，我只是尝试使用以下方法循环一组文件：

NO2files<-list.files(pattern=".asc", full.names=TRUE)
f<-lapply(NO2files, function (x) readLines (x))

for (i in 1:length (NO2files)) {  
 function(x)
 i<-readLines(x)
pattern <- "[[:digit:]]+(?=\\sbins)"
m <- regexpr(pattern, i[3], perl=TRUE)
dim <- regmatches(i[3], m)
m <- regexpr(pattern, i[4], perl=TRUE)
dim[2] <- regmatches(i[4], m)

dim <- as.integer(dim)

pattern <- "(?<=undef=).*"
m <- regexpr(pattern, i[2], perl=TRUE)
na_string <- regmatches(i[2], m)

dat1 <- i[-(1:4)]
sep <- grepl("=", dat1, fixed=TRUE)
dat2a <- dat1[sep] 
dat2b <- dat1[!sep] 
dat2b <- lapply(dat2b, substring, 
            first=seq(1,nchar(dat2b[1]),4), 
            last=  seq(4,nchar(dat2b[1]),4))
dat2b <- unlist(dat2b)
dat2b <- as.numeric(dat2b)
dat2b[dat2b==as.numeric(na_string)] <- NA
dat2b <- matrix(dat2b, nrow=dim[2], byrow=TRUE)
dat2b <- dat2b[nrow(dat2b):1, ]
}

Answer 1

这是一个开始：

dat <- readLines("totno2_200504.asc")

#parse dimensions
pattern <- "[[:digit:]]+(?=\\sbins)"
m <- regexpr(pattern, dat[3], perl=TRUE)
dim <- regmatches(dat[3], m)

m <- regexpr(pattern, dat[4], perl=TRUE)
dim[2] <- regmatches(dat[4], m)

dim <- as.integer(dim)

#parse NA string
pattern <- "(?<=undef=).*"
m <- regexpr(pattern, dat[2], perl=TRUE)
na_string <- regmatches(dat[2], m)

#parse data
dat1 <- dat[-(1:4)]
sep <- grepl("=", dat1, fixed=TRUE)
dat2a <- dat1[sep] #might be useful 
dat2b <- dat1[!sep] #the data
dat2b <- lapply(dat2b, substring, 
                first=seq(1,nchar(dat2b[1]),4), 
                last=  seq(4,nchar(dat2b[1]),4))
dat2b <- unlist(dat2b)
dat2b <- as.numeric(dat2b)
dat2b[dat2b==as.numeric(na_string)] <- NA
dat2b <- matrix(dat2b, nrow=dim[2], byrow=TRUE)
dat2b <- dat2b[nrow(dat2b):1, ] #flip in axis

library(raster)
plot(raster(dat2b))

Answer 2

不像@Roland 的示例那样优雅，我不确定为什么会有不同的值 - 实际上我对下面的评论（不同的文件）表示感谢。

library(stringr)
library(plyr)
library(raster)

f <- readLines("totno2_200601.asc")

# how many lat/lon values
bins.lon <- as.numeric(str_match(f[3], "Longitudes *: *([0-9]+) bins")[2])
bins.lat <- as.numeric(str_match(f[4], "Latitudes *: *([0-9]+) bins")[2])

# number of characters that represent a value
num.width <- 4

# how many lines do we need to encode the longitude bins
bins.lon.lines <- as.integer(bins.lon / (80/num.width))

# where does the data start
curr.lat.line <- 5
curr.lat.bin <- 1

m <- matrix(nrow=bins.lat, ncol=bins.lon+1)

repeat {

  # get current latitude
  lat <- as.numeric(str_match(f[curr.lat.line], "lat=\ +([0-9\\.\\-]+)")[2])

  # show progress - not necessary
  cat(curr.lat.bin, lat); cat("\n")

  # get the values for the longitudes at current latitude
  vals <- paste(f[(curr.lat.line+1):(curr.lat.line+bins.lon.lines)], sep="", collapse="")

  # split them by 4 and assign to the proper entry
  m[curr.lat.bin, ] <- c(lat, as.numeric(laply(seq(1, nchar(vals), 4), function(i) substr(vals, i, i+3))))

  curr.lat.bin <- curr.lat.bin + 1
  curr.lat.line <- curr.lat.line + bins.lon.lines + 1

  if (curr.lat.bin > bins.lat) { break }

}

m <- m[nrow(m):1, ]

plot(raster(m))

由于您添加了一个要求，以便能够在循环中使用它来读取多个文件：

library(stringr)
library(plyr)
library(raster)

# this is the function-ized version 

tomsToMatrix <- function(fname, verbose=FALSE) {

  f <- readLines(fname)

  bins.lon <- as.numeric(str_match(f[3], "Longitudes *: *([0-9]+) bins")[2])
  bins.lat <- as.numeric(str_match(f[4], "Latitudes *: *([0-9]+) bins")[2])

  num.width <- 4
  bins.lon.lines <- as.integer(bins.lon / (80/num.width))
  curr.lat.line <- 5
  curr.lat.bin <- 1

  m <- matrix(nrow=bins.lat, ncol=bins.lon+1)

  repeat {
    lat <- as.numeric(str_match(f[curr.lat.line], "lat=\ +([0-9\\.\\-]+)")[2])
    if (verbose) { cat(curr.lat.bin, lat); cat("\n") }
    vals <- paste(f[(curr.lat.line+1):(curr.lat.line+bins.lon.lines)], sep="", collapse="")
    m[curr.lat.bin, ] <- c(lat, as.numeric(laply(seq(1, nchar(vals), 4), function(i) substr(vals, i, i+3))))
    curr.lat.bin <- curr.lat.bin + 1
    curr.lat.line <- curr.lat.line + bins.lon.lines + 1 
    if (curr.lat.bin > bins.lat) { break } 
  }

  m <- m[nrow(m):1, ]

  return(m)

}

setwd("/data/toms") # whatever the source directory is for **your** files

t.files <- list.files("/data/toms")
t.files
[1] "totno2_200504.asc" "totno2_200505.asc" "totno2_200506.asc"

dat <- lapply(t.files, tomsToMatrix)

str(dat)
List of 3
$ : num [1:720, 1:1441] 89.9 89.6 89.4 89.1 88.9 ...
$ : num [1:720, 1:1441] 89.9 89.6 89.4 89.1 88.9 ...
$ : num [1:720, 1:1441] 89.9 89.6 89.4 89.1 88.9 ...

如果您需要它们作为命名条目，那应该不难添加。