Contains my own R functions. First commit.
Taha Ahmed
14 years ago
commit
996a79787c
@ -0,0 +1,7 @@
|
|||||||
|
as.radians <- function(degrees) {
|
||||||
|
radians <- degrees * (pi / 180)
|
||||||
|
}
|
||||||
|
|
||||||
|
as.degrees <- function(radians) {
|
||||||
|
radians <- radians * (180 / pi)
|
||||||
|
}
|
||||||
@ -0,0 +1,568 @@
|
|||||||
|
# Collection of R functions for analysis of thin-film X-ray diffraction patterns
|
||||||
|
# Maintainer: Taha Ahmed
|
||||||
|
|
||||||
|
# CONTENTS
|
||||||
|
# >>>> matchpdf
|
||||||
|
# >>>> scherrer
|
||||||
|
# >>>> pdf2df
|
||||||
|
# >>>> uxd2mtx
|
||||||
|
# >>>> uxd2df
|
||||||
|
# >>>> muxd2df
|
||||||
|
# >>>> muxd2mtx
|
||||||
|
# >>>> muxd2ls
|
||||||
|
# - REPAIR SHOP
|
||||||
|
# - print.xtable.booktabs
|
||||||
|
# - split.muxd
|
||||||
|
# - strip.ka2
|
||||||
|
# - pearson.beta
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################## matchpdf ######################
|
||||||
|
##################################################
|
||||||
|
matchpdf <- function(expcol, pdfrow) {
|
||||||
|
# Function for matching each element of two numeric vectors
|
||||||
|
# to the closest-lying element (numerically) in the other
|
||||||
|
# vector. For example for matching 2th values of PDF to
|
||||||
|
# 2th values of recorded diffractogram.
|
||||||
|
## Args: two vectors to be matched (any special considerations on vector lengths?)
|
||||||
|
## Values: A list of 5 numeric vectors. See description inside function.
|
||||||
|
# A word of caution. This function creates a matrix with dimensions pdfrow * expcol.
|
||||||
|
# Usually both of these vectors are rather short. But watch out if large vectors
|
||||||
|
# are submitted --- the looping below could make this function very slow.
|
||||||
|
#
|
||||||
|
diff.thth <- matrix(NA, length(pdfrow), length(expcol))
|
||||||
|
diff.indx <- matrix(NA, length(pdfrow), length(expcol))
|
||||||
|
|
||||||
|
for (pdf.row in 1:length(pdfrow)) {
|
||||||
|
# For every row, calculate differences between that pdf value and all exp values
|
||||||
|
diff.thth[pdf.row, ] <- expcol - pdfrow[pdf.row]
|
||||||
|
}
|
||||||
|
#
|
||||||
|
# Now we go on to find the minimum along each row of diff.thth
|
||||||
|
# and set all other values to some arbitrary value
|
||||||
|
diff.rmin <- diff.thth
|
||||||
|
for (pdf.row in 1:dim(diff.thth)[1]) {
|
||||||
|
for (exp.col in 1:dim(diff.thth)[2]) {
|
||||||
|
if (abs(diff.thth[pdf.row, exp.col]) != min(abs(diff.thth[pdf.row, ]))) {
|
||||||
|
diff.rmin[pdf.row, exp.col] <- Inf
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#
|
||||||
|
# We likewise find the minimum along each column and set any other,
|
||||||
|
# non-Inf values to Inf
|
||||||
|
diff.cmin <- diff.rmin
|
||||||
|
for (exp.col in 1:dim(diff.rmin)[2]) {
|
||||||
|
for (pdf.row in 1:dim(diff.rmin)[1]) {
|
||||||
|
if (abs(diff.rmin[pdf.row, exp.col]) != min(abs(diff.rmin[, exp.col]))) {
|
||||||
|
diff.cmin[pdf.row, exp.col] <- Inf
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#
|
||||||
|
# The matrix now contains at most one non-Inf value per row and column.
|
||||||
|
# To make the use of colSums and rowSums possible (next step) all Inf are set zero,
|
||||||
|
# and all matches are set to 1.
|
||||||
|
for (pdf.row in 1:dim(diff.cmin)[1]) {
|
||||||
|
for (exp.col in 1:dim(diff.cmin)[2]) {
|
||||||
|
if ((diff.cmin[pdf.row, exp.col]) != Inf) {
|
||||||
|
diff.indx[pdf.row, exp.col] <- 1
|
||||||
|
} else {
|
||||||
|
diff.indx[pdf.row, exp.col] <- 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#
|
||||||
|
# Attach error message to return list if sum(rowSums(diff.indx)) == sum(colSums(diff.indx))
|
||||||
|
matchpdf.err.msg <-"matchpdf() failed to complete. It seems rowSums != colSums."
|
||||||
|
mtch <- matchpdf.err.msg
|
||||||
|
#
|
||||||
|
# Check that sum(rowSums(diff.indx)) == sum(colSums(diff.indx))
|
||||||
|
if (sum(rowSums(diff.indx)) == sum(colSums(diff.indx))) {
|
||||||
|
# Reset mtch
|
||||||
|
mtch <- list()
|
||||||
|
mtch <- list(csums = colSums(diff.indx), rsums = rowSums(diff.indx), expthth = expcol[colSums(diff.indx) != 0], pdfthth = pdfrow[rowSums(diff.indx) != 0], deltathth = expcol[colSums(diff.indx) != 0] - pdfrow[rowSums(diff.indx) != 0])
|
||||||
|
# List of 5
|
||||||
|
# $ csums : num - consisting of ones and zeroes. Shows you which positions of expcol matched.
|
||||||
|
# $ rsums : num - consisting of ones and zeroes. Shows you which positions of pdfrow matched.
|
||||||
|
# $ expthth : num - consisting of the matching elements of expcol.
|
||||||
|
# $ pdfthth : num - consisting of the matching elements of pdfrow.
|
||||||
|
# $ deltathth : num - element-wise difference of expcol and pdfrow.
|
||||||
|
}
|
||||||
|
#
|
||||||
|
return(mtch)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################## scherrer ######################
|
||||||
|
##################################################
|
||||||
|
scherrer <- function(integralbreadth, thth, wavelength = 1.54056, shapeconstant = ((4/3)*(pi/6))^(1/3)) {
|
||||||
|
# Function for calculating crystallite grain size from reflection data
|
||||||
|
# ARGS: integralbreadth - vector with integral breadth of reflections (in degrees)
|
||||||
|
# thth - vector with 2theta values of reflections (in degrees)
|
||||||
|
# wavelength - X-ray wavelength used (default 1.54056 Å, Cu Ka)
|
||||||
|
# shapeconstant - Scherrer constant (default spherical, ~0.9)
|
||||||
|
# VALUE: vector with size parameters
|
||||||
|
## REQUIRES: as.radians(), source("/home/taha/chepec/chetex/common/R/common.R")
|
||||||
|
D <- (shapeconstant * wavelength) / (as.radians(integralbreadth) * cos(as.radians(thth)))
|
||||||
|
# cos() - angles must be in radians, not degrees!
|
||||||
|
return(D) #units of angstrom
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################### pdf2df #######################
|
||||||
|
##################################################
|
||||||
|
pdf2df <- function(pdffile) {
|
||||||
|
# Function for extracting information from ICDD PDF XML-files
|
||||||
|
# For example the PDF files produced by the PDF database at Ångström's X-ray lab
|
||||||
|
# NOTE: sometimes intensity values are specified as less than some value.
|
||||||
|
# In those cases, this function simply strips the less-than character.
|
||||||
|
# ARGS: pdffile (complete path and filename to PDF file)
|
||||||
|
# VALUE: dataframe with 9 columns:
|
||||||
|
# thth angles (numeric),
|
||||||
|
# d (numeric),
|
||||||
|
# h index (numeric),
|
||||||
|
# k index (numeric),
|
||||||
|
# l index (numeric),
|
||||||
|
# hkl indices (factor of strings),
|
||||||
|
# hkl.TeX indices formatted for LaTeX (factor of strings),
|
||||||
|
# intensity (numeric),
|
||||||
|
# int.TeX intensity formatted for LaTeX (factor of strings)
|
||||||
|
# attr: This function sets the following attributes:
|
||||||
|
# ApplicationName,
|
||||||
|
# ApplicationVersion,
|
||||||
|
# pdfNumber,
|
||||||
|
# chemicalformula,
|
||||||
|
# wavelength
|
||||||
|
#
|
||||||
|
require(XML)
|
||||||
|
doc <- xmlTreeParse(pdffile)
|
||||||
|
pdf <- xmlRoot(doc)
|
||||||
|
rmchar <- "[^0-9]"
|
||||||
|
#
|
||||||
|
angles <- data.frame(NULL)
|
||||||
|
for (i in 1:length(pdf[["graphs"]][["stick_series"]])) {
|
||||||
|
angles <- rbind(angles, data.frame(#
|
||||||
|
thth = as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["theta"]])),
|
||||||
|
d = as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["da"]])),
|
||||||
|
h = as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["h"]])),
|
||||||
|
k = as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["k"]])),
|
||||||
|
l = as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]])),
|
||||||
|
hkl = paste(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["h"]]),
|
||||||
|
xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["k"]]),
|
||||||
|
xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]]), sep = ""),
|
||||||
|
hkl.TeX = paste("\\mbox{$", ifelse(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["h"]])) < 0,
|
||||||
|
paste("\\bar{", abs(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["h"]]))),
|
||||||
|
"}", sep = ""),
|
||||||
|
xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["h"]])),
|
||||||
|
"\\,", ifelse(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["k"]])) < 0,
|
||||||
|
paste("\\bar{", abs(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["k"]]))),
|
||||||
|
"}", sep = ""),
|
||||||
|
xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["k"]])),
|
||||||
|
"\\,", ifelse(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]])) < 0,
|
||||||
|
paste("\\bar{", abs(as.numeric(xmlValue(pdf[["graphs"]][["stick_series"]][[i]][["l"]]))),
|
||||||
|
"}", sep = ""),
|
||||||
|
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 = "")
|
||||||
|
))
|
||||||
|
}
|
||||||
|
#
|
||||||
|
attr(angles, "ApplicationName") <- xmlAttrs(pdf)[[1]]
|
||||||
|
attr(angles, "ApplicationVersion") <- xmlAttrs(pdf)[[2]]
|
||||||
|
attr(angles, "pdfNumber") <- xmlValue(pdf[["pdf_data"]][["pdf_number"]])
|
||||||
|
attr(angles, "chemicalformula") <- gsub("[ ]", "", xmlValue(pdf[["pdf_data"]][["chemical_formula"]]))
|
||||||
|
attr(angles, "wavelength") <- as.numeric(xmlValue(pdf[["graphs"]][["wave_length"]]))
|
||||||
|
# Caution: Do not subset. Subsetting causes all attributes to be lost.
|
||||||
|
return(angles)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################### uxd2mtx ######################
|
||||||
|
##################################################
|
||||||
|
uxd2mtx <- function(uxdfile) {
|
||||||
|
# Function for reading UXD files
|
||||||
|
# Assumptions: data in two columns
|
||||||
|
# Args: uxdfile (filename with extension)
|
||||||
|
# Return value: matrix with two columns
|
||||||
|
|
||||||
|
cchar <- "[;_]" #regexpr matching the comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]" #regexpr matching one character of any digit
|
||||||
|
|
||||||
|
# A new file (datafile) containing only data will be created,
|
||||||
|
# extension ".data" appended to uxdfile
|
||||||
|
#datafile <- paste(uxdfile,".data",sep="")
|
||||||
|
|
||||||
|
ufile <- file(uxdfile, "r")
|
||||||
|
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||||
|
close(ufile)
|
||||||
|
|
||||||
|
# This way we identify data rows by looking for numeric characters.
|
||||||
|
#wh <- regexpr("[0-9]", f)
|
||||||
|
# This way we identify header rows
|
||||||
|
# We assume that all other rows are data
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
|
||||||
|
mh <- wh[1:length(wh)] # this gives you the corresponding index vector
|
||||||
|
# the value of each element corresponds to the position of the regexp match.
|
||||||
|
# value = 1 means the first character of the row is cchar (row is header)
|
||||||
|
# value =-1 means no cchar occur on the row (row is data)
|
||||||
|
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1
|
||||||
|
ends <- length(mh)
|
||||||
|
f <- f[starts:ends]
|
||||||
|
|
||||||
|
zz <- textConnection(f, "r")
|
||||||
|
ff <- matrix(scan(zz, what = numeric()), ncol=2, byrow=T)
|
||||||
|
close(zz)
|
||||||
|
|
||||||
|
#zz <- file(datafile, "w") #open connection to datafile
|
||||||
|
#write.table(ff, file=datafile, row.names=F, sep=",")
|
||||||
|
#close(zz)
|
||||||
|
|
||||||
|
# Return matrix
|
||||||
|
ff
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
#################### uxd2df ######################
|
||||||
|
##################################################
|
||||||
|
uxd2df <- function(uxdfile) {
|
||||||
|
# Function for reading UXD files # Assumptions: data in two columns
|
||||||
|
# Args: uxdfile (filename with extension)
|
||||||
|
# Returns: dataframe with three columns
|
||||||
|
|
||||||
|
cchar <- "[;_]" #regexpr matching the comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]" #regexpr matching one character of any digit
|
||||||
|
|
||||||
|
# A new file (datafile) containing only data will be created,
|
||||||
|
# extension ".data" appended to uxdfile
|
||||||
|
#datafile <- paste(uxdfile,".data",sep="")
|
||||||
|
|
||||||
|
ufile <- file(uxdfile, "r")
|
||||||
|
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||||
|
close(ufile)
|
||||||
|
|
||||||
|
# This way we identify data rows by looking for numeric characters.
|
||||||
|
#wh <- regexpr("[0-9]", f)
|
||||||
|
# This way we identify header rows
|
||||||
|
# We assume that all other rows are data
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
|
||||||
|
mh <- wh[1:length(wh)] # this gives you the corresponding index vector
|
||||||
|
# the value of each element corresponds to the position of the regexp match.
|
||||||
|
# value = 1 means the first character of the row is cchar (row is header)
|
||||||
|
# value =-1 means no cchar occur on the row (row is data)
|
||||||
|
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1
|
||||||
|
ends <- length(mh)
|
||||||
|
f <- f[starts:ends]
|
||||||
|
|
||||||
|
zz <- textConnection(f, "r")
|
||||||
|
ff <- data.frame(uxdfile, matrix(scan(zz,
|
||||||
|
what = numeric()), ncol=2, byrow=T))
|
||||||
|
names(ff) <- c("sampleid", "angle", "intensity")
|
||||||
|
close(zz)
|
||||||
|
|
||||||
|
#zz <- file(datafile, "w") #open connection to datafile
|
||||||
|
#write.table(ff, file=datafile, row.names=F, sep=",")
|
||||||
|
#close(zz)
|
||||||
|
|
||||||
|
# Return dataframe
|
||||||
|
ff
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################### muxd2df ######################
|
||||||
|
##################################################
|
||||||
|
muxd2df <- function(uxdfile, range.descriptor) {
|
||||||
|
# Function that reads an UXD file which contains several ranges
|
||||||
|
# (created in a programmed run, for example)
|
||||||
|
# Arguments
|
||||||
|
# :: uxdfile (filename with extension)
|
||||||
|
# :: range.descriptor (an array with as many elements as
|
||||||
|
# there are ranges in the uxdfile)
|
||||||
|
# Returns: dataframe with 3 columns
|
||||||
|
|
||||||
|
cchar <- "[;_]" #regexpr matching the comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]" #regexpr matching one character of any digit
|
||||||
|
# Create filenames for the output # no longer used, return dataframe instead
|
||||||
|
#datafile <- paste(uxdfile,"-",range.descriptor,".data",sep="")
|
||||||
|
|
||||||
|
# Read the input multirange file
|
||||||
|
ufile <- file(uxdfile, "r")
|
||||||
|
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||||
|
close(ufile)
|
||||||
|
|
||||||
|
# This way we identify data rows by looking for numeric characters.
|
||||||
|
#wh <- regexpr("[0-9]", f)
|
||||||
|
# This way we identify header rows
|
||||||
|
# Later we will assume that all other rows are data
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
|
||||||
|
mh <- wh[1:length(wh)] # this gives you the corresponding index vector
|
||||||
|
# the value of each element corresponds to the position of the regexp match.
|
||||||
|
# value = 1 means the first character of the row is cchar (row is header)
|
||||||
|
# value =-1 means no cchar occur on the row (row is data)
|
||||||
|
|
||||||
|
#length(mh[mh == -1]) #total number of datarows in uxdfile
|
||||||
|
#mh[mh > 1 | mh < 0] <- 0 #set all header-rows to zero (just to make things easier)
|
||||||
|
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1 #start indices
|
||||||
|
ends <- which(mh[i] != 1 & mh[j] == 1) #end indices, except the last
|
||||||
|
ends <- c(ends, length(mh)) #fixed the last index of ends
|
||||||
|
|
||||||
|
ff <- data.frame(NULL)
|
||||||
|
for (s in 1:length(range.descriptor)) {
|
||||||
|
zz <- textConnection(f[starts[s]:ends[s]], "r")
|
||||||
|
ff <- rbind(ff, data.frame(range.descriptor[s],
|
||||||
|
matrix(scan(zz, what = numeric()), ncol=2, byrow=T)))
|
||||||
|
close(zz)
|
||||||
|
}
|
||||||
|
names(ff) <- c("sampleid", "angle", "intensity")
|
||||||
|
|
||||||
|
# Return dataframe
|
||||||
|
ff
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################### muxd2mtx #####################
|
||||||
|
##################################################
|
||||||
|
muxd2mtx <- function(uxdfile, range) {
|
||||||
|
# Function that reads an UXD file which contains several ranges
|
||||||
|
# (created in a programmed run, for example)
|
||||||
|
# Arguments
|
||||||
|
# :: uxdfile (filename with extension)
|
||||||
|
# :: range (an integer, the number of ranges in the uxdfile)
|
||||||
|
# Returns: matrix with 2 columns
|
||||||
|
|
||||||
|
cchar <- "[;_]" #regexpr matching the comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]" #regexpr matching one character of any digit
|
||||||
|
# Create filenames for the output # no longer used, return dataframe instead
|
||||||
|
#datafile <- paste(uxdfile,"-",range.descriptor,".data",sep="")
|
||||||
|
|
||||||
|
# Read the input multirange file
|
||||||
|
ufile <- file(uxdfile, "r")
|
||||||
|
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||||
|
close(ufile)
|
||||||
|
|
||||||
|
# We identify header rows. We will assume that all other rows are data
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
# length(wh) equals length(f)
|
||||||
|
# wh has either 1 or -1 for each element
|
||||||
|
# value = 1 means the first character of that row is cchar (row is header)
|
||||||
|
# value =-1 means absence of cchar on that row (row is data)
|
||||||
|
|
||||||
|
# Since wh contains some attributes (given by regexpr function), we strip out everything
|
||||||
|
# but the index vector and assign it to the new vector mh
|
||||||
|
mh <- wh[1:length(wh)] # this gives you the corresponding index vector
|
||||||
|
|
||||||
|
#length(mh[mh == -1]) #total number of datarows in uxdfile
|
||||||
|
#mh[mh > 1 | mh < 0] <- 0 #set all header-rows to zero (just to make things easier)
|
||||||
|
|
||||||
|
# Set counters i and j used in assignment below
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1 #start indices
|
||||||
|
ends <- which(mh[i] != 1 & mh[j] == 1) #end indices, except the last
|
||||||
|
ends <- c(ends, length(mh)) #fixes the last index of ends
|
||||||
|
# note that length of starts (or ends) gives the number of ranges
|
||||||
|
|
||||||
|
ff <- matrix(NA, length(f), 2)
|
||||||
|
for (s in 1:range) {
|
||||||
|
zz <- textConnection(f[starts[s]:ends[s]], "r")
|
||||||
|
ff <- rbind(ff, matrix(scan(zz, what = numeric()), ncol=2, byrow=T))
|
||||||
|
close(zz)
|
||||||
|
}
|
||||||
|
|
||||||
|
# Clean up matrix: remove extra rows
|
||||||
|
ff[apply(ff,1,function(x)any(!is.na(x))), ]
|
||||||
|
|
||||||
|
# Return matrix
|
||||||
|
ff
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################### muxd2ls ######################
|
||||||
|
##################################################
|
||||||
|
muxd2ls <- function(uxdfile) {
|
||||||
|
# Function that reads an UXD file which contains several ranges
|
||||||
|
# (created in a programmed run, for example)
|
||||||
|
# Arguments
|
||||||
|
# :: uxdfile (filename with extension)
|
||||||
|
# Returns: List of matrices, as many as there were ranges
|
||||||
|
# Requires: ??
|
||||||
|
# See extensive comments in muxd2mtx()
|
||||||
|
|
||||||
|
cchar <- "[;_]" #comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]"
|
||||||
|
|
||||||
|
ufile <- file(uxdfile, "r")
|
||||||
|
f <- readLines(ufile, n=-1) #read _all_ lines from UXD file
|
||||||
|
close(ufile)
|
||||||
|
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
mh <- wh[1:length(wh)]
|
||||||
|
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1
|
||||||
|
ends <- which(mh[i] != 1 & mh[j] == 1)
|
||||||
|
ends <- c(ends, length(mh))
|
||||||
|
|
||||||
|
ff <- list()
|
||||||
|
for (s in 1:length(starts)) {
|
||||||
|
zz <- textConnection(f[starts[s]:ends[s]], "r")
|
||||||
|
ms <- matrix(scan(zz, what = numeric()), ncol = 2, byrow = T)
|
||||||
|
close(zz)
|
||||||
|
ff[[s]] <- ms
|
||||||
|
}
|
||||||
|
# Return list of matrices
|
||||||
|
return(ff)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# -------- ##################### -------- #
|
||||||
|
# -------- #### REPAIR SHOP #### -------- #
|
||||||
|
# -------- ##################### -------- #
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################ pearson.beta ####################
|
||||||
|
##################################################
|
||||||
|
pearson.beta <- function(m, w) {
|
||||||
|
# Function for calculating integral breadth, \beta, of
|
||||||
|
# an X-ray reflection using the half-width of FWHM (w)
|
||||||
|
# and m parameter from a Pearson fit.
|
||||||
|
## Args: m - shape parameter from Pearson fit (numeric)
|
||||||
|
## w - half the FWHM for the reflection (numeric)
|
||||||
|
## **** NOTE: gamma(x) out of range for x > 171
|
||||||
|
## Values: The integral breadth of the reflection (numeric)
|
||||||
|
# Ref: Birkholz2006, page 96 (Eq. 3.5)
|
||||||
|
beta <- ((pi * 2^(2 * (1 - m)) * gamma(2 * m - 1)) /
|
||||||
|
((2^(1 / m) - 1) * (gamma(m))^2)) * w
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
################## strip.ka2 #####################
|
||||||
|
##################################################
|
||||||
|
strip.ka <- function(angle, intensity) {
|
||||||
|
# Function that strips (removes) the Cu Ka2 contribution
|
||||||
|
# from an experimental diffractogram (2Th, I(2Th))
|
||||||
|
# using the Rachinger algorithm.
|
||||||
|
## Args: 2theta vector
|
||||||
|
## intensity vector
|
||||||
|
## Values: intensity vector
|
||||||
|
# Ref: Birkholz2006, page 99 (Eq. 3.12), and page 31
|
||||||
|
Cu.Kai <- 0.154059 # nanometre
|
||||||
|
Cu.Kaii <- 0.154441 # nanometre
|
||||||
|
alpha.int.ratio <- 0.5
|
||||||
|
int.stripped <- intensity - alpha.int.ratio*intensity
|
||||||
|
return(int.stripped)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
print.xtable.booktabs <- function(x){
|
||||||
|
# Make xtable print booktabs tables
|
||||||
|
# ARGS: x (matrix)
|
||||||
|
require(xtable)
|
||||||
|
print(xtable(x), floating=F, hline.after=NULL,
|
||||||
|
add.to.row=list(pos=list(-1,0, nrow(x)),
|
||||||
|
command=c("\\toprule ", "\\midrule ", "\\bottomrule ")))
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
split.muxd <- function(uxdfile, range.descriptor) {
|
||||||
|
# Fix this some other day!!
|
||||||
|
# Function that reads an UXD file which contains several ranges
|
||||||
|
# (created in a programmed run, for example) and splits it into
|
||||||
|
# its ranges and writes to that number of files
|
||||||
|
# Arguments
|
||||||
|
# :: uxdfile (filename with extension)
|
||||||
|
# :: range.descriptor (an array with as many elements as
|
||||||
|
# there are ranges in the uxdfile)
|
||||||
|
# Returns: nothing. Writes files to HDD.
|
||||||
|
|
||||||
|
cchar <- "[;_]" #regexpr matching the comment characters used in Bruker's UXD
|
||||||
|
cdata <- "[0-9]" #regexpr matching one character of any digit
|
||||||
|
# Create filenames for the output # no longer used, return dataframe instead
|
||||||
|
datafile <- paste(uxdfile,"-",range.descriptor,".data",sep="")
|
||||||
|
|
||||||
|
# Read the input multirange file
|
||||||
|
f <- readLines(uxdfile, n=-1)
|
||||||
|
|
||||||
|
|
||||||
|
# This way we identify data rows by looking for numeric characters.
|
||||||
|
#wh <- regexpr("[0-9]", f)
|
||||||
|
# This way we identify header rows
|
||||||
|
# Later we will assume that all other rows are data
|
||||||
|
wh <- regexpr(cchar, f)
|
||||||
|
|
||||||
|
mh <- wh[1:length(wh)] # this gives you the corresponding index vector
|
||||||
|
# the value of each element corresponds to the position of the regexp match.
|
||||||
|
# value = 1 means the first character of the row is cchar (row is header)
|
||||||
|
# value =-1 means no cchar occur on the row (row is data)
|
||||||
|
|
||||||
|
#length(mh[mh == -1]) #total number of datarows in uxdfile
|
||||||
|
#mh[mh > 1 | mh < 0] <- 0 #set all header-rows to zero (just to make things easier)
|
||||||
|
|
||||||
|
i <- seq(1, length(mh) - 1, 1)
|
||||||
|
j <- seq(2, length(mh), 1)
|
||||||
|
starts <- which(mh[i] == 1 & mh[j] != 1) + 1 #start indices
|
||||||
|
ends <- which(mh[i] != 1 & mh[j] == 1) #end indices, except the last
|
||||||
|
ends <- c(ends, length(mh)) #fixed the last index of ends
|
||||||
|
|
||||||
|
#ff <- data.frame(NULL)
|
||||||
|
for (s in 1:length(range.descriptor)) {
|
||||||
|
matrix(scan(file=textConnection(f[starts[s]:ends[s]]),
|
||||||
|
what = numeric()), ncol=2, byrow=T)
|
||||||
|
}
|
||||||
|
names(ff) <- c("sampleid", "angle", "intensity")
|
||||||
|
|
||||||
|
# Return dataframe
|
||||||
|
ff
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue