diff --git a/.gitignore b/.gitignore index 5d05fb6..57c2127 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ *.RData *.Rhistory *.Rhistory.save +*.ROLD diff --git a/CHI/amperometry2df.R b/CHI/amperometry2df.R index ccee1ed..a6b9b57 100644 --- a/CHI/amperometry2df.R +++ b/CHI/amperometry2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ############### amperometry2df ################### diff --git a/CHI/chronoamp2df.R b/CHI/chronoamp2df.R index f3157b9..981b9c1 100644 --- a/CHI/chronoamp2df.R +++ b/CHI/chronoamp2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ################# chronoamp2df ################### diff --git a/CHI/chronocm2df.R b/CHI/chronocm2df.R index 12550dd..4bc41a5 100644 --- a/CHI/chronocm2df.R +++ b/CHI/chronocm2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ################# chronocm2df #################### diff --git a/CHI/cv2df.R b/CHI/cv2df.R index c209996..0198547 100644 --- a/CHI/cv2df.R +++ b/CHI/cv2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## #################### cv2df ####################### diff --git a/CHI/lsv2df.R b/CHI/lsv2df.R index 0facc0a..60a8951 100644 --- a/CHI/lsv2df.R +++ b/CHI/lsv2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ################### lsv2df ####################### diff --git a/CHI/mps2df.R b/CHI/mps2df.R index ad2edd1..91054c1 100644 --- a/CHI/mps2df.R +++ b/CHI/mps2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ################### mps2df ####################### diff --git a/CHI/ocp2df.R b/CHI/ocp2df.R index 3aef058..78685f2 100644 --- a/CHI/ocp2df.R +++ b/CHI/ocp2df.R @@ -1,4 +1,4 @@ -source("/home/taha/chepec/chetex/common/R/common.R") +source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") ################################################## ################### ocp2df ####################### diff --git a/INCA/eds2df.R b/INCA/eds2df.R index 14b1497..4c42ff3 100644 --- a/INCA/eds2df.R +++ b/INCA/eds2df.R @@ -1,6 +1,3 @@ -################################################## -################### eds2df ####################### -################################################## eds2df <- function(edstxtfile) { ## Description: ## Reads EDS textfile from INCA EDS. @@ -85,4 +82,4 @@ eds2df <- function(edstxtfile) { ff$BeamEnergy <- BeamEnergy # return(ff) -} \ No newline at end of file +} diff --git a/INCA/edsWrapper.R b/INCA/edsWrapper.R new file mode 100644 index 0000000..b16ca70 --- /dev/null +++ b/INCA/edsWrapper.R @@ -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) + } +} diff --git a/INCA/edspk.R b/INCA/edspk.R index e4b4f9c..2b8576b 100644 --- a/INCA/edspk.R +++ b/INCA/edspk.R @@ -1,9 +1,7 @@ -################################################## -#################### edspk ####################### -################################################## -edspk <- function(eds.exp, kerpk = 1, fitmaxiter = 50) { +edspk <- + function(eds.exp, kerpk = 1, fitmaxiter = 50, gam = 1.0, scl.factor = 0.1, maxwdth=0.20) { - 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() # 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.nobasl = eds.nobasl)) -} \ No newline at end of file +} diff --git a/XRD-TF/pdf2df.R b/XRD-TF/pdf2df.R index 17369f9..49189f5 100644 --- a/XRD-TF/pdf2df.R +++ b/XRD-TF/pdf2df.R @@ -1,6 +1,3 @@ -################################################## -################### pdf2df ####################### -################################################## pdf2df <- function(pdffile) { # 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 @@ -17,7 +14,8 @@ pdf2df <- function(pdffile) { # hkl indices (string), # hkl.TeX indices formatted for LaTeX (string), # 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: # ApplicationName, # ApplicationVersion, @@ -56,7 +54,8 @@ pdf2df <- function(pdffile) { xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]])), "$}", sep = "", collapse = ""), 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"]]) )) } # diff --git a/XRF-SPECTRO/xrfpk.R b/XRF-SPECTRO/xrfpk.R index 79e629e..55834e3 100644 --- a/XRF-SPECTRO/xrfpk.R +++ b/XRF-SPECTRO/xrfpk.R @@ -1,5 +1,5 @@ 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") diff --git a/XRF-SPECTRO/xrfspectro2df.R b/XRF-SPECTRO/xrfspectro2df.R index 77ea0fb..e56f883 100644 --- a/XRF-SPECTRO/xrfspectro2df.R +++ b/XRF-SPECTRO/xrfspectro2df.R @@ -2,6 +2,8 @@ source("/home/taha/chepec/chetex/common/R/common/ProvideSampleId.R") xrfspectro2df <- function(smpfile) { ## 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. ## Stores data in data frame and parameters in an attributed dataframe. ## Usage: @@ -11,76 +13,193 @@ xrfspectro2df <- function(smpfile) { ## (with path) to one SMP file (ASCII). ## Value: ## A dataframe with attributed dataframe - # + + #### ONLY BOTHER WITH THE FIRST MEASUREMENT IN THE SMP-FILE. + filecon <- file(smpfile, "r") smpcontents <- readLines(filecon, n = -1) #read all lines of input file close(filecon) - # - sampleid <- ProvideSampleId(smpfile) - # - rgxp.data <- "^Kanal\\s[\\d]+:" - # - numrow.idx <- regexpr(rgxp.data, smpcontents, perl = TRUE) - # scrap the match.length attribute - attr(numrow.idx, "match.length") <- NULL - # - # Determine how many columns the data contains - smpdata.cols <- length(strsplit(smpcontents[which(numrow.idx == 1)][1], "\t")[[1]]) - 1 - # While we are at it, save row count to a variable as well - smpdata.rows <- length(smpcontents[which(numrow.idx == 1)]) - # strip prefix off each data row - #smpdata <- matrix(NA, ncol = smpdata.cols, nrow = smpdata.rows) - smpdata.txt <- vector(length = smpdata.rows) - for (i in 1:smpdata.rows) { - smpdata.txt[i] <- strsplit(smpcontents[which(numrow.idx == 1)][i], ":")[[1]][2] + + # Parameter table + # Those are the parameter we may access later in this function + xrf.param <- data.frame(stringsAsFactors = FALSE, + matrix(c("Method", "^Method:", + "Job", "^Job:", + "Status", "^Status:", + "Description", "^Description:", + "Date", "^Date\\sof\\sMeasurement:", + "Measurements", "^Measurements:", + "Voltage", "^Voltage:", + "Current", "^Current:", + "Target", "^Target:", + "Duration", "^Meas\\.\\sDuration:", + "Impulse", "^Imp\\.\\sRate:", + "DeadTime", "^Rel\\.\\sDead\\sTime:", + "FirstChannel", "^First\\sChannel:", + "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 = "")) - - # - ### Collect attributes of this experiment - SMPattrEdit <- matrix(c("Voltage", "^Voltage:", - "Current", "^Current:", - "Target", "^Target:", - "Duration", "^Meas\\.\\sDuration:", - "Impulse", "^Imp\\.\\sRate:", - "DeadTime", "^Rel\\.\\sDead\\sTime:", - "FirstChannel", "^First\\sChannel:", - "LastChannel", "^Last\\sChannel:", - "PeakTime", "^Peak\\sTime:", - "Gain", "^Gain:", - "ZeroPeak", "^Zero\\sPeak:"), - ncol = 2, byrow = T) - - 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) + + # How many rows of data? + n_rowsdata <- + length(which(regexpr(subset(xrf.data, parameter == "Data", + select = "regexp")$regexp, smpcontents, perl = TRUE) == 1)) + + # Build an empty matrix big enough to hold all data + # (i.e., ncol = 3, and nrow = n_rowsdata * n_measurements) + data.long <- data.frame(matrix(NA, ncol = 5, nrow = 6 * n_rowsdata)) + names(data.long) <- c("sampleid", "measurement", "channel", "energy", "counts") + + + data.mtx <- matrix(NA, ncol = 6, nrow = n_rowsdata) + for (j in 1:n_rowsdata) { + 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]]) } - SMPdf <- data.frame(stringsAsFactors = FALSE, - SMPattr[2:dim(SMPattr)[1], ]) - colnames(SMPdf) <- SMPattr[1, ] - - - ### Now calculate the energy (keV) scale (convert from channels to energy) - ff$X <- ff$channel * (as.numeric(SMPdf$Gain[1]) / as.numeric(SMPdf$LastChannel[1])) + + + # Sampleid to column 1 + data.long[, 1] <- rep(ProvideSampleId(smpfile), n_rowsdata) + # Channel to column 3 + data.long[, 3] <- rep(seq(1, n_rowsdata), dim(data.mtx)[2]) + 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 - attr(ff, "parameters") <- SMPdf - # - return(ff) -} \ No newline at end of file + data.long[, subset(xrf.param, parameter == "DeadTime")$parameter] <- + rep(as.numeric(strsplit(strsplit(smpcontents[which(regexpr(subset(xrf.param, + parameter == "DeadTime")$regexp, smpcontents, perl = TRUE) == 1)], + ":\\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) +}