Added XRD peak wrapper functions (as done previously for XRF and Raman).
Also put the short R-data loading function I wrote into the common directory.master
Taha Ahmed
13 years ago
parent
0579b5ea52
commit
3d4244f1fd
@ -0,0 +1,92 @@
|
||||
xrdpk <-
|
||||
function(xrd.exp, kerpk = 1, fitmaxiter = 50, gam = 1.0, scl.factor = 1.2, maxwdth=5.0) {
|
||||
|
||||
xrd.base <- baselinefit(xrd.exp, tau=2.5, 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
|
||||
# separated peak for some baseline parameters
|
||||
xrd.pks <- data.frame()
|
||||
xrd.pks.basl <- data.frame()
|
||||
xrd.pks.pmg <- data.frame()
|
||||
xrd.pks.spl <- data.frame()
|
||||
peaks <- 1:length(xrd.base$npks)
|
||||
for (s in peaks) {
|
||||
# recorded data in long form by separated peak
|
||||
xrd.pks <- rbind(xrd.pks, # column names assigned after loop
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
kernel = NA,
|
||||
xrd.exp[xrd.base$indlsep[s]:xrd.base$indrsep[s], ]))
|
||||
# the calculated baseline in long form by separated peak
|
||||
xrd.pks.basl <- rbind(xrd.pks.basl,
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
kernel = NA,
|
||||
x = xrd.exp[xrd.base$indlsep[s]:xrd.base$indrsep[s], ],
|
||||
y = xrd.base$baseline$basisl[xrd.base$indlsep[s]:xrd.base$indrsep[s]]))
|
||||
# the taut string estimation in long form by separated peak
|
||||
xrd.pks.pmg <- rbind(xrd.pks.pmg,
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
kernel = NA,
|
||||
x = xrd.exp[xrd.base$indlsep[s]:xrd.base$indrsep[s], ],
|
||||
y = xrd.base$pmg$fn[xrd.base$indlsep[s]:xrd.base$indrsep[s]]))
|
||||
# the weighted smoothed spline in long form by separated peak
|
||||
xrd.pks.spl <- rbind(xrd.pks.spl,
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
kernel = NA,
|
||||
x = xrd.exp[xrd.base$indlsep[s]:xrd.base$indrsep[s], ],
|
||||
y = xrd.base$spl$reg[xrd.base$indlsep[s]:xrd.base$indrsep[s]]))
|
||||
}
|
||||
# Column names assigned to d.pks
|
||||
names(xrd.pks) <- c("peak", "kernel", "x", "y")
|
||||
|
||||
|
||||
# This loop calls pkdecompint() on each peak separately
|
||||
# It makes a "melted" dataframe in long form for:
|
||||
xrd.fit <- list() # holds pkdecompint output
|
||||
xrd.fit.fitpk <- data.frame() # contains fitting curves
|
||||
xrd.fit.parpk <- data.frame() # physical parameters by peak and kernel
|
||||
xrd.nobasl <- data.frame() # data with baseline removed
|
||||
peaks <- 1:length(xrd.base$npks)
|
||||
for (s in peaks) {
|
||||
######## PKDECOMPINT ########
|
||||
if (length(kerpk) > 1) {
|
||||
# set number of kernels per peak manually
|
||||
xrd.fit[[s]] <- pkdecompint(xrd.base, intnum = s,
|
||||
k = kerpk[s], maxiter = fitmaxiter)
|
||||
} else {
|
||||
# use number of kernels determined by baselinefit()
|
||||
xrd.fit[[s]] <- pkdecompint(xrd.base, intnum = s,
|
||||
k = xrd.base$npks[s], maxiter = fitmaxiter)
|
||||
}
|
||||
# Setup the dataframe that makes up the peak table
|
||||
for (kernel in 1:xrd.fit[[s]]$num.ker) {
|
||||
xrd.fit.parpk <- rbind(xrd.fit.parpk,
|
||||
data.frame(peak = factor(xrd.fit[[s]]$intnr),
|
||||
kernel = factor(kernel),
|
||||
x = xrd.fit[[s]]$parpks[kernel, "loc"],
|
||||
height = xrd.fit[[s]]$parpks[kernel, "height"],
|
||||
area = xrd.fit[[s]]$parpks[kernel, "intens"],
|
||||
fwhm = xrd.fit[[s]]$parpks[kernel, "FWHM"],
|
||||
m = xrd.fit[[s]]$parpks[kernel, "m"],
|
||||
accept = xrd.fit[[s]]$accept))
|
||||
xrd.fit.fitpk <- rbind(xrd.fit.fitpk,
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
kernel = factor(kernel),
|
||||
x = xrd.fit[[s]]$x,
|
||||
y = xrd.fit[[s]]$fitpk[kernel, ]))
|
||||
}
|
||||
xrd.nobasl <- rbind(xrd.nobasl,
|
||||
data.frame(peak = factor(peaks[s]),
|
||||
x = xrd.fit[[s]]$x,
|
||||
y = xrd.fit[[s]]$y))
|
||||
}
|
||||
|
||||
|
||||
|
||||
return(list(xrd.base = xrd.base,
|
||||
xrd.peaks = xrd.pks,
|
||||
xrd.fit.parpk = xrd.fit.parpk,
|
||||
xrd.fit.fitpk = xrd.fit.fitpk,
|
||||
xrd.nobasl = xrd.nobasl))
|
||||
|
||||
}
|
||||
@ -0,0 +1,63 @@
|
||||
xrdpkWrapper <-
|
||||
function(data.exp, run, override = FALSE,
|
||||
kerpk = 1, fitmaxiter = 50, gam = 1.0, scl.factor = 1.2, maxwdth=5.0) {
|
||||
|
||||
print("... Started xrdpkWrapper")
|
||||
|
||||
# check if xrdpk has already completed successfully for the current job
|
||||
current.dirname <- getwd()
|
||||
print(current.dirname)
|
||||
current.filename <- "xrd-peak-data.rda"
|
||||
xrddatafile <- paste(current.dirname, current.filename, sep = "/")
|
||||
|
||||
|
||||
if (file.exists(xrddatafile) && !override) {
|
||||
print("... Started if-clause 1")
|
||||
|
||||
# File already exists
|
||||
# return the data using load() or data()
|
||||
|
||||
load(file = xrddatafile)
|
||||
|
||||
if (run > length(xrdres)) {
|
||||
|
||||
print("... Started if-clause 1:1")
|
||||
|
||||
# then it does not really exist
|
||||
xrdres[[run]] <- xrdpk(data.exp,
|
||||
kerpk = kerpk,
|
||||
fitmaxiter = fitmaxiter,
|
||||
gam = gam,
|
||||
scl.factor = scl.factor,
|
||||
maxwdth = maxwdth)
|
||||
save(xrdres, file = xrddatafile)
|
||||
|
||||
print("... Ended if-clause 1:1")
|
||||
}
|
||||
|
||||
print("... Ended if-clause 1")
|
||||
|
||||
return(xrdres)
|
||||
} else {
|
||||
|
||||
print("... Started else-clause 1")
|
||||
|
||||
if (!exists("xrdres")) {
|
||||
xrdres <- list()
|
||||
print("... xrdres list created")
|
||||
}
|
||||
|
||||
# Need to call xrdpk() and save its results to file as above
|
||||
xrdres[[run]] <- xrdpk(data.exp,
|
||||
kerpk = kerpk,
|
||||
fitmaxiter = fitmaxiter,
|
||||
gam = gam,
|
||||
scl.factor = scl.factor,
|
||||
maxwdth = maxwdth)
|
||||
save(xrdres, file = xrddatafile)
|
||||
|
||||
print("... Ended else-clause 1")
|
||||
|
||||
return(xrdres)
|
||||
}
|
||||
}
|
||||
@ -0,0 +1,6 @@
|
||||
# Function loads R-data file into a variable instead of into the workspace
|
||||
# Works well when the R-data file contains only ONE variable
|
||||
# NOT TESTED for when the R-data file contains many variables
|
||||
LoadRData2Variable <- function(FullPathToRData) {
|
||||
return(eval(parse(text = load(FullPathToRData))))
|
||||
}
|
||||
Loading…
Reference in New Issue