Ok, no commits since a while. Last change was remake of init.R to improve readability.
Taha Ahmed
13 years ago
parent
70c39b9145
commit
f0ed360c0d
@ -0,0 +1,157 @@
|
||||
source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
|
||||
source("/home/taha/chepec/chetex/common/R/common/int2padstr.R")
|
||||
|
||||
|
||||
##################################################
|
||||
#################### OO2df #######################
|
||||
##################################################
|
||||
OO2df <- function(datafile) {
|
||||
## Description:
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
## Usage:
|
||||
## OO2df(datafile)
|
||||
## Arguments:
|
||||
## datafile: text string with full path to TXT file
|
||||
## containing single or multiple data ranges
|
||||
## Value:
|
||||
## Dataframe with the following columns:
|
||||
## $ sampleid : chr
|
||||
## $ wavelength : num
|
||||
## $ counts : num
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $
|
||||
## $ cps ?
|
||||
#
|
||||
# range.header.start.rexp <- "^; \\(Data for Range" #regexp
|
||||
# range.header.end.rexp <- "^_2THETA[^=]" #regexp
|
||||
|
||||
range.data.start.rexp <- ">+Begin[\\s\\w]*<+"
|
||||
range.data.end.rexp <- ">+End[\\s\\w]*<+"
|
||||
|
||||
# Read the input file
|
||||
dfile <- file(datafile, "r")
|
||||
# Note that readLines apparently completely skips empty lines.
|
||||
# That causes line numbers to not match between source and f vector.
|
||||
f <- readLines(dfile, n=-1) # read _all_ lines from data file
|
||||
close(dfile)
|
||||
|
||||
# Fetch a sampleid for the current job
|
||||
sampleid <- ProvideSampleId(datafile)
|
||||
|
||||
# # Look for header start rows
|
||||
# range.header.start.rows <- which(regexpr(range.header.start.rexp, f) == 1)
|
||||
# # Look for header end rows
|
||||
# range.header.end.rows <- which(regexpr(range.header.end.rexp, f) == 1)
|
||||
|
||||
# Look for data start marker line
|
||||
range.data.start.rows <- which(regexpr(range.data.start.rexp, f, perl = TRUE) == 1) + 1
|
||||
# Look for data end marker line
|
||||
range.data.end.rows <- which(regexpr(range.data.end.rexp, f, perl = TRUE) == 1) - 1
|
||||
|
||||
# Calculate number of ranges
|
||||
ranges.total <-
|
||||
ifelse(length(range.data.start.rows) == length(range.data.end.rows),
|
||||
length(range.data.start.rows),
|
||||
NA) #why would they not be equal?
|
||||
if (is.na(ranges.total)) {
|
||||
# Obviously something bad happened.
|
||||
# Do something about it. echo an error message perhaps.
|
||||
# But why would they not be equal?
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Header always precedes start of data
|
||||
range.header.end.rows <- range.data.start.rows - 2
|
||||
if (ranges.total > 1) {
|
||||
range.header.start.rows <- c(1, range.data.end.rows[2:length(range.data.end.rows)])
|
||||
} else {
|
||||
# Data in fact only contains one range
|
||||
range.header.start.rows <- 1
|
||||
}
|
||||
|
||||
# Extract headers (as-is) and put them in a list (by range)
|
||||
headers.raw <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
headers.raw[[range]] <- f[range.header.start.rows[range]:range.header.end.rows[range]]
|
||||
}
|
||||
|
||||
####
|
||||
|
||||
# Extract data (as-is) and put it an list (by range)
|
||||
data.raw <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
data.raw[[range]] <- f[range.data.start.rows[range]:range.data.end.rows[range]]
|
||||
# Replace commas by dots
|
||||
data.raw[[range]] <- gsub(",", "\\.", data.raw[[range]])
|
||||
}
|
||||
|
||||
|
||||
# Specify header parameters to include in dataframe
|
||||
header.param.rexp <-
|
||||
c(DateTime = "^Date:",
|
||||
IntegrationTime = "^Integration Time \\(usec\\):",
|
||||
n_Averaged = "^Spectra Averaged:",
|
||||
Boxcar = "^Boxcar Smoothing:",
|
||||
CorrElectricDark = "^Correct for Electrical Dark:",
|
||||
StrobeLampEnabled = "^Strobe/Lamp Enabled:",
|
||||
CorrDetectorNonLin = "^Correct for Detector Non-linearity:",
|
||||
CorrStrayLight = "^Correct for Stray Light:",
|
||||
n_Pixels = "^Number of Pixels")
|
||||
|
||||
# Collect data and header parameters in dataframes, by range in a list
|
||||
data <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
zz <- textConnection(data.raw[[range]], "r")
|
||||
data[[range]] <- data.frame(stringsAsFactors = FALSE,
|
||||
sampleid,
|
||||
int2padstr(range, "0", 3),
|
||||
matrix(scan(zz, what = character()), ncol = 2, byrow = T))
|
||||
close(zz)
|
||||
# Collect header parameters
|
||||
for (param in 1:length(header.param.rexp)) {
|
||||
data[[range]] <-
|
||||
cbind(stringsAsFactors = FALSE,
|
||||
data[[range]],
|
||||
# Matches any word, digit, plus, or minus character
|
||||
# surrounded by parentheses at the end of the string
|
||||
sub("\\s\\([\\w\\d\\+\\-]+\\)$", "",
|
||||
strsplit(headers.raw[[range]][which(regexpr(unname(header.param.rexp[param]),
|
||||
headers.raw[[range]]) == 1)], ": ")[[1]][2],
|
||||
perl = TRUE))
|
||||
}
|
||||
names(data[[range]]) <-
|
||||
c("sampleid", "range", "wavelength", "intensity", names(header.param.rexp))
|
||||
}
|
||||
|
||||
# Create a unified dataframe
|
||||
data.df <- data[[1]]
|
||||
if (ranges.total > 1) {
|
||||
for (range in 2:ranges.total) {
|
||||
data.df <- rbind(data.df, data[[range]])
|
||||
}
|
||||
}
|
||||
|
||||
# Convert the DateTime column to more legibly (and compact) format
|
||||
data.df$DateTime <-
|
||||
format(as.POSIXct(gsub("\\s[A-Z]{4}\\s", " ", data.df$Date),
|
||||
format = "%a %b %d %H:%M:%S %Y"),
|
||||
format = "%Y-%m-%d %H:%M:%S")
|
||||
# Convert wavelength and intensity to numeric format
|
||||
mode(data.df$wavelength) <- "numeric"
|
||||
mode(data.df$intensity) <- "numeric"
|
||||
|
||||
return(data.df)
|
||||
}
|
||||
@ -0,0 +1,154 @@
|
||||
source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
|
||||
source("/home/taha/chepec/chetex/common/R/common/int2padstr.R")
|
||||
|
||||
|
||||
##################################################
|
||||
#!!!!!!!!!!!!!!!!!# mraw2df #!!!!!!!!!!!!!!!!!!!!#
|
||||
##################################################
|
||||
mraw2df <- function(txtfile) {
|
||||
## Description:
|
||||
## Reads TXT files with one or multiple ranges (XRD commander "save as txt")
|
||||
## Extracts both data (thth, intensity) and parameters
|
||||
## Usage:
|
||||
## mraw2df(txtfile)
|
||||
## Arguments:
|
||||
## txtfile: text string with full path to TXT file, which may
|
||||
## containing single or multiple data ranges
|
||||
## Value:
|
||||
## Dataframe with the following columns:
|
||||
## $ sampleid : chr
|
||||
## $ thth : num
|
||||
## $ counts (or cps) : num
|
||||
## $ steptime : num
|
||||
## $ stepsize : num
|
||||
## $ theta : num
|
||||
## $ khi : num
|
||||
## $ phi : num
|
||||
## $ x : num
|
||||
## $ y : num
|
||||
## $ z : num
|
||||
## $ divergence : num
|
||||
## $ antiscatter : num
|
||||
## $ cps (or counts) : num
|
||||
#
|
||||
range.header.start.rexp <- "^; \\(Data for Range" #regexp
|
||||
range.header.end.rexp <- "^_2THETA[^=]" #regexp
|
||||
|
||||
# Read the input multirange file
|
||||
ufile <- file(uxdfile, "r")
|
||||
# Note that readLines apparently completely skips empty lines.
|
||||
# In that case line numbers do not match between source and f.
|
||||
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||
close(ufile)
|
||||
|
||||
# Fetch a sampleid for the current job
|
||||
sampleid <- ProvideSampleId(uxdfile)
|
||||
|
||||
# Look for header start rows
|
||||
range.header.start.rows <- which(regexpr(range.header.start.rexp, f) == 1)
|
||||
# Look for header end rows
|
||||
range.header.end.rows <- which(regexpr(range.header.end.rexp, f) == 1)
|
||||
|
||||
# Calculate number of ranges
|
||||
ranges.total <-
|
||||
ifelse(length(range.header.start.rows) == length(range.header.end.rows),
|
||||
length(range.header.start.rows),
|
||||
NA) #why would they not be equal?
|
||||
if (is.na(ranges.total)) {
|
||||
# Obviously something bad happened.
|
||||
# Do something about it. echo an error message perhaps.
|
||||
# But why would they not be equal?
|
||||
|
||||
}
|
||||
|
||||
# Determine whether we have COUNTS or COUNTS PER SECOND in current UXD-file
|
||||
# Assuming it is the same for all ranges in this job (a safe assumption).
|
||||
if (f[range.header.end.rows][1] == "_2THETACOUNTS") {
|
||||
# we got counts
|
||||
counts.flag <- TRUE
|
||||
cps.flag <- FALSE
|
||||
}
|
||||
if (f[range.header.end.rows][1] == "_2THETACPS") {
|
||||
# we got counts per second
|
||||
counts.flag <-FALSE
|
||||
cps.flag <- TRUE
|
||||
}
|
||||
|
||||
# Extract headers (as-is) and put them in a list (by range)
|
||||
headers.raw <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
headers.raw[[range]] <- f[range.header.start.rows[range]:range.header.end.rows[range]]
|
||||
}
|
||||
|
||||
# Data always start on the row after header end
|
||||
range.data.start.rows <- range.header.end.rows + 1
|
||||
# Data end rows precedes header with one row, except for the first range
|
||||
# But only if data contained more than one range, obviously. Let's make the code check for that
|
||||
if (ranges.total > 1) {
|
||||
range.data.end.rows <- c(range.header.start.rows[2:length(range.header.start.rows)] - 1, length(f))
|
||||
} else {
|
||||
# Data in fact only contains one range
|
||||
range.data.end.rows <- length(f)
|
||||
}
|
||||
|
||||
####
|
||||
|
||||
# Extract data (as-is) and put it an list (by range)
|
||||
data.raw <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
data.raw[[range]] <- f[range.data.start.rows[range]:range.data.end.rows[range]]
|
||||
}
|
||||
|
||||
# Specify header parameters to include in dataframe
|
||||
header.param.rexp <- c(steptime = "^_STEPTIME=",
|
||||
stepsize = "^_STEPSIZE=",
|
||||
theta = "^_THETA=",
|
||||
khi = "^_KHI=",
|
||||
phi = "^_PHI=",
|
||||
x = "^_X=",
|
||||
y = "^_Y=",
|
||||
z = "^_Z=",
|
||||
divergence = "^_DIVERGENCE=",
|
||||
antiscatter = "^_ANTISCATTER=")
|
||||
|
||||
# Collect data and header parameters in dataframes, by range in a list
|
||||
data <- list()
|
||||
for (range in 1:ranges.total) {
|
||||
zz <- textConnection(data.raw[[range]], "r")
|
||||
data[[range]] <- data.frame(stringsAsFactors = F,
|
||||
sampleid,
|
||||
int2padstr(range, "0", 3),
|
||||
matrix(scan(zz, what = numeric()), ncol = 2, byrow = T))
|
||||
close(zz)
|
||||
# Collect header parameters
|
||||
for (param in 1:length(header.param.rexp)) {
|
||||
data[[range]] <- cbind(data[[range]],
|
||||
as.numeric(strsplit(headers.raw[[range]][which(regexpr(unname(header.param.rexp[param]),
|
||||
headers.raw[[range]]) == 1)], "=")[[1]][2]))
|
||||
}
|
||||
names(data[[range]]) <-
|
||||
c("sampleid", "range", "thth", ifelse(counts.flag, "counts", "cps"), names(header.param.rexp))
|
||||
}
|
||||
|
||||
# Calculate the other of the pair counts <-> cps
|
||||
if (counts.flag) {
|
||||
for (range in 1:ranges.total) {
|
||||
data[[range]] <- cbind(data[[range]], cps = data[[range]]$counts / data[[range]]$steptime)
|
||||
}
|
||||
}
|
||||
if (cps.flag) {
|
||||
for (range in 1:ranges.total) {
|
||||
data[[range]] <- cbind(data[[range]], counts = data[[range]]$cps * data[[range]]$steptime)
|
||||
}
|
||||
}
|
||||
|
||||
# Return a unified dataframe
|
||||
data.df <- data[[1]]
|
||||
if (ranges.total > 1) {
|
||||
for (range in 2:ranges.total) {
|
||||
data.df <- rbind(data.df, data[[range]])
|
||||
}
|
||||
}
|
||||
|
||||
return(data.df)
|
||||
}
|
||||
@ -1,13 +1,10 @@
|
||||
# To source a bunch of files in the same directory
|
||||
|
||||
sourceDir <- function(path, trace = TRUE) {
|
||||
for (nm in list.files(path, pattern = "\\.[Rr]$")) {
|
||||
if(trace) {
|
||||
cat(nm,":")
|
||||
}
|
||||
source(file.path(path, nm))
|
||||
if(trace) {
|
||||
cat("\n")
|
||||
}
|
||||
lsDir <- list.files(path, pattern = "\\.[Rr]$")
|
||||
for (i in lsDir) {
|
||||
if(trace) {cat(i, ":")}
|
||||
source(file.path(path, i))
|
||||
if(trace) {cat("\n")}
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue