Many small changes and updates. Need separate git repo for each instrument.

master
Taha Ahmed 13 years ago
parent beab0b9e64
commit 0579b5ea52

1
.gitignore vendored

@ -1,3 +1,4 @@
*.RData *.RData
*.Rhistory *.Rhistory
*.Rhistory.save *.Rhistory.save
*.ROLD

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
############### amperometry2df ################### ############### amperometry2df ###################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
################# chronoamp2df ################### ################# chronoamp2df ###################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
################# chronocm2df #################### ################# chronocm2df ####################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
#################### cv2df ####################### #################### cv2df #######################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
################### lsv2df ####################### ################### lsv2df #######################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
################### mps2df ####################### ################### mps2df #######################

@ -1,4 +1,4 @@
source("/home/taha/chepec/chetex/common/R/common.R") source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
################################################## ##################################################
################### ocp2df ####################### ################### ocp2df #######################

@ -1,6 +1,3 @@
##################################################
################### eds2df #######################
##################################################
eds2df <- function(edstxtfile) { eds2df <- function(edstxtfile) {
## Description: ## Description:
## Reads EDS textfile from INCA EDS. ## Reads EDS textfile from INCA EDS.
@ -85,4 +82,4 @@ eds2df <- function(edstxtfile) {
ff$BeamEnergy <- BeamEnergy ff$BeamEnergy <- BeamEnergy
# #
return(ff) return(ff)
} }

@ -0,0 +1,63 @@
edsWrapper <-
function(data.exp, run, override = FALSE,
kerpk = 1, fitmaxiter = 50, gam = 0.6, scl.factor = 0.1, maxwdth=0.20) {
print("... Started edsWrapper")
# check if edspk has already completed successfully for the current job
current.dirname <- getwd()
print(current.dirname)
current.filename <- "eds-peak-data.rda"
edsdatafile <- paste(current.dirname, current.filename, sep = "/")
if (file.exists(edsdatafile) && !override) {
print("... Started if-clause 1")
# File already exists
# return the data using load() or data()
load(file = edsdatafile)
if (run > length(edsres)) {
print("... Started if-clause 1:1")
# then it does not really exist
edsres[[run]] <- edspk(data.exp,
kerpk = kerpk,
fitmaxiter = fitmaxiter,
gam = gam,
scl.factor = scl.factor,
maxwdth = maxwdth)
save(edsres, file = edsdatafile)
print("... Ended if-clause 1:1")
}
print("... Ended if-clause 1")
return(edsres)
} else {
print("... Started else-clause 1")
if (!exists("edsres")) {
edsres <- list()
print("... edsres list created")
}
# Need to call edspk() and save its results to file as above
edsres[[run]] <- edspk(data.exp,
kerpk = kerpk,
fitmaxiter = fitmaxiter,
gam = gam,
scl.factor = scl.factor,
maxwdth = maxwdth)
save(edsres, file = edsdatafile)
print("... Ended else-clause 1")
return(edsres)
}
}

@ -1,9 +1,7 @@
################################################## edspk <-
#################### edspk ####################### function(eds.exp, kerpk = 1, fitmaxiter = 50, gam = 1.0, scl.factor = 0.1, maxwdth=0.20) {
##################################################
edspk <- function(eds.exp, kerpk = 1, fitmaxiter = 50) {
eds.base <- baselinefit(eds.exp, tau=2.0, gam=1.0, scl.factor=3.0, maxwdth=0.20) eds.base <- baselinefit(eds.exp, tau=2.0, gam=gam, scl.factor=scl.factor, maxwdth=maxwdth)
# This loop deals with the output from baselinefit() # This loop deals with the output from baselinefit()
# It makes a "melted" dataframe in long form for each # It makes a "melted" dataframe in long form for each
@ -91,4 +89,4 @@ edspk <- function(eds.exp, kerpk = 1, fitmaxiter = 50) {
eds.fit.fitpk = eds.fit.fitpk, eds.fit.fitpk = eds.fit.fitpk,
eds.nobasl = eds.nobasl)) eds.nobasl = eds.nobasl))
} }

@ -1,6 +1,3 @@
##################################################
################### pdf2df #######################
##################################################
pdf2df <- function(pdffile) { pdf2df <- function(pdffile) {
# Function for extracting information from ICDD PDF XML-files # Function for extracting information from ICDD PDF XML-files
# For example the PDF files produced by the PDF database at Angstrom's X-ray lab # For example the PDF files produced by the PDF database at Angstrom's X-ray lab
@ -17,7 +14,8 @@ pdf2df <- function(pdffile) {
# hkl indices (string), # hkl indices (string),
# hkl.TeX indices formatted for LaTeX (string), # hkl.TeX indices formatted for LaTeX (string),
# intensity (numeric), # intensity (numeric),
# int.TeX intensity formatted for LaTeX (string) # int.TeX intensity formatted for LaTeX (string),
# pdfNumber (string)
# attr: This function sets the following attributes: # attr: This function sets the following attributes:
# ApplicationName, # ApplicationName,
# ApplicationVersion, # ApplicationVersion,
@ -56,7 +54,8 @@ pdf2df <- function(pdffile) {
xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]])), xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]])),
"$}", sep = "", collapse = ""), "$}", sep = "", collapse = ""),
intensity = as.numeric(gsub(rmchar, "", xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["intensity"]]))), intensity = as.numeric(gsub(rmchar, "", xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["intensity"]]))),
int.TeX = paste("{", xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["intensity"]]), "}", sep = "") int.TeX = paste("{", xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["intensity"]]), "}", sep = ""),
pdfNumber = xmlValue(pdf[["pdf_data"]][["pdf_number"]])
)) ))
} }
# #

@ -1,5 +1,5 @@
xrfpk <- xrfpk <-
function(data.exp, kerpk = 1, fitmaxiter = 50, gam = 0.6, scl.factor = 0.1, maxwdth = 200) { function(data.exp, kerpk = 1, fitmaxiter = 50, gam = 0.6, scl.factor = 0.1, maxwdth = 10) {
print("... Starting baseline fitting") print("... Starting baseline fitting")

@ -2,6 +2,8 @@ source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R")
xrfspectro2df <- function(smpfile) { xrfspectro2df <- function(smpfile) {
## Description: ## Description:
## Total remake of xrfspectro2df(). Idea is to accomodate all 6 possible
## datasets of each SMP file, plus the attributes.
## Reads XRF textfile from XLAB SPECTRO XRF. ## Reads XRF textfile from XLAB SPECTRO XRF.
## Stores data in data frame and parameters in an attributed dataframe. ## Stores data in data frame and parameters in an attributed dataframe.
## Usage: ## Usage:
@ -11,76 +13,193 @@ xrfspectro2df <- function(smpfile) {
## (with path) to one SMP file (ASCII). ## (with path) to one SMP file (ASCII).
## Value: ## Value:
## A dataframe with attributed dataframe ## A dataframe with attributed dataframe
#
#### ONLY BOTHER WITH THE FIRST MEASUREMENT IN THE SMP-FILE.
filecon <- file(smpfile, "r") filecon <- file(smpfile, "r")
smpcontents <- readLines(filecon, n = -1) #read all lines of input file smpcontents <- readLines(filecon, n = -1) #read all lines of input file
close(filecon) close(filecon)
#
sampleid <- ProvideSampleId(smpfile) # Parameter table
# # Those are the parameter we may access later in this function
rgxp.data <- "^Kanal\\s[\\d]+:" xrf.param <- data.frame(stringsAsFactors = FALSE,
# matrix(c("Method", "^Method:",
numrow.idx <- regexpr(rgxp.data, smpcontents, perl = TRUE) "Job", "^Job:",
# scrap the match.length attribute "Status", "^Status:",
attr(numrow.idx, "match.length") <- NULL "Description", "^Description:",
# "Date", "^Date\\sof\\sMeasurement:",
# Determine how many columns the data contains "Measurements", "^Measurements:",
smpdata.cols <- length(strsplit(smpcontents[which(numrow.idx == 1)][1], "\t")[[1]]) - 1 "Voltage", "^Voltage:",
# While we are at it, save row count to a variable as well "Current", "^Current:",
smpdata.rows <- length(smpcontents[which(numrow.idx == 1)]) "Target", "^Target:",
# strip prefix off each data row "Duration", "^Meas\\.\\sDuration:",
#smpdata <- matrix(NA, ncol = smpdata.cols, nrow = smpdata.rows) "Impulse", "^Imp\\.\\sRate:",
smpdata.txt <- vector(length = smpdata.rows) "DeadTime", "^Rel\\.\\sDead\\sTime:",
for (i in 1:smpdata.rows) { "FirstChannel", "^First\\sChannel:",
smpdata.txt[i] <- strsplit(smpcontents[which(numrow.idx == 1)][i], ":")[[1]][2] "LastChannel", "^Last\\sChannel:",
"PeakTime", "^Peak\\sTime:",
"Gain", "^Gain:",
"ZeroPeak", "^Zero\\sPeak:",
"Data", "^Kanal\\s[\\d]+:"),
ncol = 2, byrow = T))
names(xrf.param) <- c("parameter", "regexp")
# Data table
# Contains the regexp used for identifiying rows containing data
xrf.data <- data.frame(stringsAsFactors = FALSE,
matrix(c("Data", "^Kanal\\s[\\d]+:"), ncol = 2, byrow = T))
names(xrf.data) <- c("parameter", "regexp")
# Find out how many measurements we have in this
# file by accessing the Measurements field
n_measurements <- as.numeric(strsplit(gsub("^\\t", "",
strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Measurements", select = "regexp")$regexp,
smpcontents) == 1)], ":")[[1]][2]), "\\t")[[1]])
# If more than one measurement, issue warning
if (n_measurements > 1) {
warning(paste(paste(n_measurements, " measurements detected in ",
basename(smpfile), sep = ""),
"Only the first measurement will be recorded",
sep = "\n", collapse = ""))
} }
smpdata.txt.clean <- gsub("^\\s", "",
gsub("\\t", " ", smpdata.txt))
zz <- textConnection(smpdata.txt.clean, "r")
ff <- data.frame(stringsAsFactors = FALSE,
sampleid = sampleid,
channel = seq(1, smpdata.rows),
matrix(scan(zz, what = numeric(), sep = " "),
ncol = smpdata.cols, byrow = TRUE))
close(zz)
names(ff) <- c("sampleid", "channel", paste("Y", seq(1, smpdata.cols), sep = ""))
# # How many rows of data?
### Collect attributes of this experiment n_rowsdata <-
SMPattrEdit <- matrix(c("Voltage", "^Voltage:", length(which(regexpr(subset(xrf.data, parameter == "Data",
"Current", "^Current:", select = "regexp")$regexp, smpcontents, perl = TRUE) == 1))
"Target", "^Target:",
"Duration", "^Meas\\.\\sDuration:", # Build an empty matrix big enough to hold all data
"Impulse", "^Imp\\.\\sRate:", # (i.e., ncol = 3, and nrow = n_rowsdata * n_measurements)
"DeadTime", "^Rel\\.\\sDead\\sTime:", data.long <- data.frame(matrix(NA, ncol = 5, nrow = 6 * n_rowsdata))
"FirstChannel", "^First\\sChannel:", names(data.long) <- c("sampleid", "measurement", "channel", "energy", "counts")
"LastChannel", "^Last\\sChannel:",
"PeakTime", "^Peak\\sTime:",
"Gain", "^Gain:", data.mtx <- matrix(NA, ncol = 6, nrow = n_rowsdata)
"ZeroPeak", "^Zero\\sPeak:"), for (j in 1:n_rowsdata) {
ncol = 2, byrow = T) data.mtx[j, ] <- as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.data, parameter == "Data",
select = "regexp")$regexp, smpcontents, perl = TRUE) == 1)], ":\\t")[[j]][2], "\\t")[[1]])
SMPattr <- matrix(NA, nrow = smpdata.cols + 1, ncol = dim(SMPattrEdit)[1])
for (c in 1:dim(SMPattrEdit)[1]) {
SMPattr[1, c] <- SMPattrEdit[c, 1]
SMPattr[2:dim(SMPattr)[1], c] <-
matrix(strsplit(gsub("^\\t", "",
strsplit(smpcontents[which(regexpr(SMPattrEdit[c, 2], smpcontents) == 1)],
":")[[1]][2]), "\\t")[[1]], ncol = smpdata.cols)
} }
SMPdf <- data.frame(stringsAsFactors = FALSE,
SMPattr[2:dim(SMPattr)[1], ])
colnames(SMPdf) <- SMPattr[1, ] # Sampleid to column 1
data.long[, 1] <- rep(ProvideSampleId(smpfile), n_rowsdata)
# Channel to column 3
### Now calculate the energy (keV) scale (convert from channels to energy) data.long[, 3] <- rep(seq(1, n_rowsdata), dim(data.mtx)[2])
ff$X <- ff$channel * (as.numeric(SMPdf$Gain[1]) / as.numeric(SMPdf$LastChannel[1])) for (c in 1:6) {
# Measurement no. in column 2
data.long[((c * n_rowsdata) - n_rowsdata + 1):(((c + 1) * n_rowsdata) - n_rowsdata), 2] <- rep(c, n_rowsdata)
# Counts in column 5
data.long[((c * n_rowsdata) - n_rowsdata + 1):(((c + 1) * n_rowsdata) - n_rowsdata), 5] <- data.mtx[, c]
}
# Drop all rows with measurement-number not equal to 1
data.long <- subset(data.long, measurement == 1)
# Fetch the measurement parameters
data.long[, subset(xrf.param, parameter == "Date")$parameter] <-
rep(substr(strsplit(gsub("^\\t", "", strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Date")$regexp, smpcontents) == 1)], ":")[[1]][2]),
"\\t")[[1]][1], 1, 8), n_rowsdata)
data.long[, subset(xrf.param, parameter == "Method")$parameter] <-
rep(strsplit(gsub("^\\t", "", strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Method")$regexp, smpcontents) == 1)], ":")[[1]][2]),
"\\t")[[1]][1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Job")$parameter] <-
rep(strsplit(gsub("^\\t", "", strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Job")$regexp, smpcontents) == 1)], ":")[[1]][2]),
"\\t")[[1]][1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Status")$parameter] <-
rep(strsplit(gsub("^\\t", "", strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Status")$regexp, smpcontents) == 1)], ":")[[1]][2]),
"\\t")[[1]][1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Description")$parameter] <-
rep(gsub("^\\t", "", strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Description")$regexp, smpcontents) == 1)], ":")[[1]][2]),
n_rowsdata)
data.long[, subset(xrf.param, parameter == "Voltage")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Voltage")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Current")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Current")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Target")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Target")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Duration")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Duration")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Impulse")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Impulse")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
# Attach parameters to returned dataframe data.long[, subset(xrf.param, parameter == "DeadTime")$parameter] <-
attr(ff, "parameters") <- SMPdf rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
# parameter == "DeadTime")$regexp, smpcontents, perl = TRUE) == 1)],
return(ff) ":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
}
data.long[, subset(xrf.param, parameter == "FirstChannel")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "FirstChannel")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "LastChannel")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "LastChannel")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "PeakTime")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "PeakTime")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "Gain")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "Gain")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
data.long[, subset(xrf.param, parameter == "ZeroPeak")$parameter] <-
rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param,
parameter == "ZeroPeak")$regexp, smpcontents, perl = TRUE) == 1)],
":\\t")[[1]][2], "\\t")[[1]])[1], n_rowsdata)
# Convert channel into energy scale
# Using the following assumptions:
# 1. Zero peak is always the strongest (highest) peak in the spectrum
# The channel with maximum counts should correspond to 0 keV
# This gives a one-channel deviation from what the instrument shows
# for a 12.5 keV range measurement using 1024 channels (so far)
# This is good enough for our purposes, since the peak energies for most
# ions do not match with reference values without a correction term anyway.
max.channel <- which(data.long$counts == max(data.long$counts))
data.long$energy <- (data.long$channel * (data.long$Gain / data.long$LastChannel)) -
((max.channel / data.long$LastChannel) * data.long$Gain)
# Save the maxchannel to the returned dataframe
data.long$ZeroChannel <- rep(max.channel, n_rowsdata)
# Calculate energy from channel # this is no longer viable
#data.long$energy <- (data.long$channel * (data.long$Gain / data.long$LastChannel)) -
# ((24 / data.long$LastChannel) * data.long$Gain)
return(data.long)
}

Loading…
Cancel
Save