#' Reads header information from GPR files
#'
#' \code{readArrayHeader} is usually called by \code{readArrays}
#' rather than being called directly by the user.
#'
#' @param x filename including full path for the array header to be read
#' @return data frame
#' @export
readArrayHeader <- function(x, wavelength, wavelength.field = "Wavelengths"){
con <- file(x, open = "r")
on.exit(close(con))
# Read header lines from GPR file
i <- 0
header <- list()
repeat{
i <- i + 1
header.lines <- readLines(con, n = 1)
header[[i]] <- strsplit(sub("^\"", "", sub("\"$", "", header.lines)),
split = "=|\t")[[1]]
if(grepl("Name", header.lines) & grepl("ID", header.lines)){
break
}
}
header[[i]] <- NULL
# Check ATF header length - warning issued if mismatch
# (potential corrupted or edited header)
if (as.integer(header[[2]][1]) + 2 != length(header)){
warning("ATF header length field in", basename(x),
"incorrect. Header length of", length(header),
"lines used.")
}
header[[2]] <- c("HeaderLines", length(header))
wl.row <- which(sapply(header, function(y) y[1]) == wavelength.field)
if (!length(wl.row)){
warning("Wavelength field not found - default header values used.")
header.data <- sapply(header, function(y) y[2])
names(header.data) = sapply(header, function(y) y[1])
header.data <- data.frame(lapply(header.data, type.convert),
stringsAsFactors=FALSE
)
return (header.data)
} else {
wl.col <- which(header[[wl.row]] == wavelength)
wl.data <- sapply(header, function(y) y[wl.col])
wl.data <- wl.data[!is.na(wl.data)]
header.data <- sapply(header, function(y) y[2])
header.data[!is.na(sapply(header, function(y) y[wl.col]))] <- wl.data
names(header.data) = sapply(header, function(y) y[1])
header.data <- data.frame(lapply(header.data, type.convert),
stringsAsFactors=FALSE
)
return(header.data)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.