Taha Ahmed
6 years ago
parent
c00fcc54a9
commit
e22546cb3c
@ -1,7 +1,5 @@ |
||||
*/ |
||||
*.info |
||||
*.RData |
||||
*.Rdeprecated |
||||
*.Rhistory |
||||
*.Rhistory.save |
||||
*.ROLD |
||||
.Rbuildignore |
||||
.Rproj.user |
||||
.Rhistory |
||||
.RData |
||||
.Ruserdata |
||||
|
||||
@ -1,8 +0,0 @@ |
||||
################################################## |
||||
#################### AVS2SHE ##################### |
||||
################################################## |
||||
AVS2SHE <- function(avs) { |
||||
# Converts from absolute vacuum scale (AVS) to SHE scale |
||||
she <- -(4.5 + avs) |
||||
return(she) |
||||
} |
||||
@ -1,14 +0,0 @@ |
||||
################################################## |
||||
############### Celsius2Kelvin ################### |
||||
################################################## |
||||
Celsius2Kelvin <- function(Celsius) { |
||||
# Converts temperature from Celsius to Kelvin |
||||
# |
||||
# Check and correct for values below -273.15 |
||||
if (Celsius < -273.15) { |
||||
# If Celsis is less than absolute zero, set it to absolute zero |
||||
Celsius <- -273.15 |
||||
} |
||||
Kelvin <- Celsius + 273.15 |
||||
return(Kelvin) |
||||
} |
||||
@ -1,74 +0,0 @@ |
||||
source(HomeByHost("/home/taha/chepec/chetex/common/R/common/SHE2AVS.R")) |
||||
source(HomeByHost("/home/taha/chepec/chetex/common/R/common/AVS2SHE.R")) |
||||
source(HomeByHost("/home/taha/chepec/chetex/common/R/common/ConvertRefPotEC.R")) |
||||
|
||||
################################################## |
||||
################# ConvertRefPot ################## |
||||
################################################## |
||||
ConvertRefPot <- function(argpotential, argrefscale, valuerefscale) { |
||||
# Check that argpotential is valid numeric |
||||
|
||||
# IDEA: make a matrix out of these (scale names and flags) |
||||
|
||||
# Valid scales |
||||
scale.names <- list() |
||||
scale.names[["SHE"]] <- c("SHE", "NHE", "she", "nhe") |
||||
scale.names[["AgCl"]] <- c("Ag/AgCl", "AgCl", "ag/agcl", "agcl") |
||||
scale.names[["SCE"]] <- c("SCE", "sce") |
||||
scale.names[["Li"]] <- c("Li/Li+", "Li", "Li+", "li", "li+", "li/li+") |
||||
scale.names[["AVS"]] <- c("AVS", "avs") |
||||
|
||||
# Set flags |
||||
bool.flags <- as.data.frame(matrix(0, nrow = length(scale.names), ncol = 2)) |
||||
names(bool.flags) <- c("argref", "valueref") |
||||
row.names(bool.flags) <- names(scale.names) |
||||
|
||||
# argrefscale |
||||
# Check that argrefscale is valid character mode |
||||
# ... |
||||
|
||||
for (j in 1:length(row.names(bool.flags))) { |
||||
if (any(scale.names[[row.names(bool.flags)[j]]] == argrefscale)) { |
||||
bool.flags[row.names(bool.flags)[j], "argref"] <- j |
||||
} |
||||
} |
||||
|
||||
|
||||
# valuerefscale |
||||
# Check that valuerefscale is valid character mode |
||||
# ... |
||||
|
||||
for (k in 1:length(row.names(bool.flags))) { |
||||
if (any(scale.names[[row.names(bool.flags)[k]]] == valuerefscale)) { |
||||
bool.flags[row.names(bool.flags)[k], "valueref"] <- k |
||||
} |
||||
} |
||||
|
||||
# Depending on which flags are set, call the corresponding function |
||||
|
||||
decision.vector <- colSums(bool.flags) |
||||
|
||||
# Check if both scales are the same (no conversion needed). If so, abort gracefully. |
||||
# ... |
||||
|
||||
if (decision.vector["argref"] == 5 || decision.vector["valueref"] == 5) { |
||||
# AVS is requested, deal with it it |
||||
if (decision.vector["argref"] == 5) { |
||||
# Conversion _from_ AVS |
||||
rnpotential <- ConvertRefPotEC(AVS2SHE(argpotential), |
||||
"SHE", |
||||
scale.names[[decision.vector["valueref"]]][1]) |
||||
} |
||||
if (decision.vector["valueref"] == 5) { |
||||
# Conversion _to_ AVS |
||||
rnpotential <- SHE2AVS(ConvertRefPotEC(argpotential, |
||||
scale.names[[decision.vector["argref"]]][1], |
||||
"SHE")) |
||||
} |
||||
} else { |
||||
rnpotential <- ConvertRefPotEC(argpotential, |
||||
scale.names[[decision.vector["argref"]]][1], |
||||
scale.names[[decision.vector["valueref"]]][1]) |
||||
} |
||||
return(rnpotential) |
||||
} |
||||
@ -1 +0,0 @@ |
||||
Both \Rfun{ConvertRefPotEC()} and \Rfun{ConvertRefPot()} \emph{need} to be rewritten to allow for different concentrations of each reference electrode! |
||||
@ -1,48 +0,0 @@ |
||||
################################################## |
||||
############### ConvertRefPotEC ################## |
||||
################################################## |
||||
ConvertRefPotEC <- function(argpotential, argrefscale, valuerefscale) { |
||||
# Converts from an electrochemical reference potential scale into another |
||||
# SHE: standard hydrogen electrode scale |
||||
# Ag/AgCl: silver silver-chloride electrode scale |
||||
# SCE: standard calomel scale |
||||
# |
||||
|
||||
##### Add more reference electrodes here >> |
||||
refpotatSHEzero <- c( 0, -0.21, -0.24, 3) |
||||
refrownames <- c( "SHE", "Ag/AgCl", "SCE", "Li/Li+") |
||||
refcolnames <- c("SHE0", "AgCl0", "SCE0", "Li0") |
||||
##### Add more reference electrodes here << |
||||
# |
||||
SHE0 <- data.frame(matrix(refpotatSHEzero, ncol=length(refpotatSHEzero), byrow=T)) |
||||
refpotmtx <- matrix(NA, length(SHE0), length(SHE0)) |
||||
refpotmtx[,1] <- matrix(as.matrix(SHE0), ncol=1, byrow=T) |
||||
for (c in 2:length(SHE0)) { |
||||
# loop over columns (except the first) |
||||
for (r in 1:length(SHE0)) { |
||||
# loop over rows |
||||
refpotmtx[r, c] <- refpotmtx[r, 1] - refpotmtx[c, 1] |
||||
} |
||||
} |
||||
refpotdf <- as.data.frame(refpotmtx) |
||||
names(refpotdf) <- refcolnames |
||||
row.names(refpotdf) <- refrownames |
||||
## So far we have made a matrix of all the possible combinations, |
||||
## given the vector refpotatSHEzero. The matrix is not strictly necessary, |
||||
## but it may prove useful later. It does. |
||||
# |
||||
# Match argrefscale to the refrownames |
||||
argmatch <- match(argrefscale, refrownames, nomatch = 0) |
||||
# Match valuerefscale to the refrownames |
||||
valuematch <- match(valuerefscale, refrownames, nomatch = 0) |
||||
# We simply assume that the match was well-behaved |
||||
valuepotential <- argpotential + refpotdf[valuematch, argmatch] |
||||
# Check that arg and value electrodes are within bounds for a match |
||||
if (argmatch == 0 || valuematch == 0) { |
||||
# No match |
||||
# Perform suitable action |
||||
message("Arg out of bounds in call to ConvertRefPot") |
||||
valuepotential <- NA |
||||
} |
||||
return(valuepotential) |
||||
} |
||||
@ -1 +0,0 @@ |
||||
Both \Rfun{ConvertRefPotEC()} and \Rfun{ConvertRefPot()} \emph{need} to be rewritten to allow for different concentrations of each reference electrode! |
||||
@ -1,26 +0,0 @@ |
||||
################################################## |
||||
################## CountRods ##################### |
||||
################################################## |
||||
CountRods <- function() { |
||||
## Description: |
||||
## |
||||
## Usage: |
||||
## |
||||
## Arguments: |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## |
||||
## Return value: |
||||
## |
||||
# |
||||
|
||||
return() |
||||
} |
||||
@ -0,0 +1,10 @@ |
||||
Package: common |
||||
Type: Package |
||||
Title: chepec common |
||||
Version: 0.1.0 |
||||
Description: Commonly used functions and scripts. |
||||
Authors@R: person("Taha", "Ahmed", email = "taha@chepec.se", role = c("aut", "cre")) |
||||
License: GPL-3 |
||||
LazyData: TRUE |
||||
RoxygenNote: 5.0.1 |
||||
Imports: xtable |
||||
@ -1,36 +0,0 @@ |
||||
GenericXtableSetAttributes <- function(xtobject, |
||||
nxtnames = NULL, |
||||
nxtdigits = NULL, |
||||
nxtdisplay = NULL, |
||||
nxtalign = NULL, |
||||
caption = "nxtcaption", |
||||
label = "tab:nxtlabel") { |
||||
#' @title Set the attributes for a generic xtable |
||||
#' |
||||
#' @description |
||||
#' Sets attributes for the passed xtable object |
||||
#' |
||||
#' @details |
||||
#' Sets names, digits, display, and align for the passed xtable object |
||||
#' |
||||
#' @param xtobject the xtable(table) |
||||
#' @param nxtnames vector of names (column names) |
||||
#' @param nxtdigits vector of digits (0 if column is non-numeric, numeric of desired number of digits otherwise) |
||||
#' @param nxtdisplay vector of display format [see formatC(format=...)] |
||||
#' @param nxtalign vector of LaTeX align (e.g., "l", "c", "r", "S[table-format=1.1]", ...) |
||||
#' @examples |
||||
#' GenericXtableSetAttributes(xtable(yourtable), nxtdigits = c(0, 2, 2, 4)) |
||||
#' @author Taha Ahmed <taha@@chepec.se> |
||||
#' @return xtable |
||||
|
||||
# remember to put all names inside "{}" if you use siunitx |
||||
if (!is.null(nxtnames)) {names(xtobject) <- nxtnames} |
||||
# the prepended column due to "row.names" |
||||
if (!is.null(nxtdigits)) {digits(xtobject) <- c(0, nxtdigits)} |
||||
if (!is.null(nxtdisplay)) {display(xtobject) <- c("s", nxtdisplay)} |
||||
if (!is.null(nxtalign)) {align(xtobject) <- c("l", nxtalign)} |
||||
caption(xtobject) <- caption |
||||
label(xtobject) <- label |
||||
# |
||||
return (xtobject) |
||||
} |
||||
@ -1,14 +0,0 @@ |
||||
################################################## |
||||
############### Kelvin2Celsius ################### |
||||
################################################## |
||||
Kelvin2Celsius <- function(Kelvin) { |
||||
# Converts temperature from Kelvin to Celsius |
||||
# |
||||
# Check and correct for negative values |
||||
if (Kelvin < 0) { |
||||
# If Kelvin is less than zero, set it to zero |
||||
Kelvin <- 0 |
||||
} |
||||
Celsius <- Kelvin - 273.15 |
||||
return(Celsius) |
||||
} |
||||
@ -1,6 +0,0 @@ |
||||
# 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)))) |
||||
} |
||||
@ -1,30 +0,0 @@ |
||||
LongtableXtableHeader <- function(xtobject, caption.text, caption.label) { |
||||
# this function uses the \booktabs package |
||||
# should NOT be used together with booktabs = TRUE |
||||
ltxt.header <- |
||||
paste(paste("\\caption{", caption.text, "}", sep = "", collapse = ""), |
||||
paste("\\label{", caption.label, "}\\\\ ", sep = "", collapse = ""), |
||||
"\\toprule ", |
||||
attr(xtobject, "names")[1], |
||||
paste(" &", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\\midrule ", |
||||
"\\endfirsthead ", |
||||
paste("\\multicolumn{", |
||||
ncol(xtobject), |
||||
"}{c}{{\\tablename\\ \\thetable{} -- continued from previous page}}\\\\ ", |
||||
sep = ""), |
||||
"\\toprule ", |
||||
attr(xtobject, "names")[1], |
||||
paste("&", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\\midrule ", |
||||
"\\endhead ", |
||||
"\\midrule ", |
||||
paste("\\multicolumn{", |
||||
as.character(ncol(xtobject)), |
||||
"}{r}{{Continued on next page}}\\\\ ", |
||||
sep = "", collapse = ""), |
||||
"\\bottomrule \\endfoot ", |
||||
"\\bottomrule \\endlastfoot ", |
||||
collapse = "") |
||||
return(ltxt.header) |
||||
} |
||||
@ -0,0 +1,26 @@ |
||||
# Generated by roxygen2: do not edit by hand |
||||
|
||||
export(AVS2SHE) |
||||
export(Celsius2Kelvin) |
||||
export(ConvertRefPot) |
||||
export(GenericXtableSetAttributes) |
||||
export(Kelvin2Celsius) |
||||
export(LoadRData2Variable) |
||||
export(LongtableXtableHeader) |
||||
export(ProvideSampleId) |
||||
export(SHE2AVS) |
||||
export(SubfigureGenerator) |
||||
export(SubstrateHistory) |
||||
export(TabularXtableHeader) |
||||
export(as.degrees) |
||||
export(as.radians) |
||||
export(int2padstr) |
||||
export(is.wholenumber) |
||||
export(molarity2mass) |
||||
export(numbers2words) |
||||
export(roundup) |
||||
export(siunitx.uncertainty) |
||||
export(thth2d) |
||||
export(trapz) |
||||
export(wavelength2num) |
||||
export(wavenum2length) |
||||
@ -1,46 +0,0 @@ |
||||
ProvideSampleId <- function (pathexpfile, implementation = "filename") { |
||||
# Returns a "unique" sample ID when supplied |
||||
# with a path to an experimental file. |
||||
# The second arg is optional, defaults to "old" behaviour, |
||||
# but can be set to "dirname" for another behaviour |
||||
# The second arg was added so as not to break older code. |
||||
## Note to myself: the sample ID must derive directly from the file or path. |
||||
|
||||
if (implementation == "dirname") { |
||||
# basename(dirname()) returns the name of the lowest sub-directory |
||||
# split()[[1]][2] splits the dirname at the hyphen and returns the sampleid |
||||
sampleid <- strsplit(x = basename(dirname(pathexpfile)), |
||||
split = "-")[[1]][2] |
||||
} else { |
||||
# basename() returns the filename sans path |
||||
# sub() returns the filename sans extension |
||||
sampleid <- sub("\\.[\\w]+$", "", basename(pathexpfile), perl = TRUE) |
||||
} |
||||
|
||||
#### The code below is the old ProvideSampleId() function |
||||
# ### OBS! Only very rudimentary error-checking. |
||||
# ### If the filename is formatted as \w*-\w*-\w*, we use the middle segment, |
||||
# ### otherwise we use the whole string (excluding the extension) |
||||
# # Extract the name of the parent directory of the datafilename argument |
||||
# substrateid <- basename(dirname(fullpathwithfilename)) |
||||
# # Extract the name of the method from the filename-part |
||||
# # First split the filename over all hyphens |
||||
# nameparts <- strsplit(basename(fullpathwithfilename), "-")[[1]] |
||||
# # If the number of nameparts exceed 3, save the whole filename |
||||
# # as methodid, otherwise use the middle part |
||||
# if (length(nameparts) > 3) { |
||||
# # We need to lose the file extension from the last namepart |
||||
# nameparts[length(nameparts)] <- |
||||
# strsplit(nameparts[length(nameparts)], "\\.")[[1]][1] |
||||
# methodid <- paste(nameparts, collapse = "-") |
||||
# } else { |
||||
# methodid <- nameparts[2] |
||||
# } |
||||
# # Make an informative sampleid |
||||
# sampleid <- paste(substrateid, methodid, sep = "-") |
||||
# # |
||||
# return(sampleid) |
||||
#### |
||||
|
||||
return(sampleid) |
||||
} |
||||
@ -1,8 +0,0 @@ |
||||
The aim with \Rfun{ProvideSampleId()} is to supply a unique sample ID from any full path supplied to it. |
||||
|
||||
The function solves this using two approaches: |
||||
\begin{enumerate} |
||||
\item using only the filename, |
||||
\item using only the name of the subdirectory in question. |
||||
\end{enumerate} |
||||
|
||||
@ -0,0 +1,18 @@ |
||||
#' Calculate required mass of substance to dissolve |
||||
#' |
||||
#' You want to prepare a solution of known molarity and volume of |
||||
#' a particular substance. |
||||
#' This function calculates the required mass to weigh up. |
||||
#' |
||||
#' @param formulamass of the substance (in grams per mole) |
||||
#' @param volume of the final solution (in liters) |
||||
#' @param molarity (in moles per liter) |
||||
#' |
||||
#' @return mass of substance (in grams) |
||||
#' @export |
||||
molarity2mass <- function(formulamass, volume, molarity) { |
||||
mass <- formulamass * volume * molarity |
||||
# Double-check units: |
||||
# [g * mol-1] * [liter] * [mole * liter-1] = [g] |
||||
return(mass) |
||||
} |
||||
@ -0,0 +1,99 @@ |
||||
#' LoadRData2Variable |
||||
#' |
||||
#' This 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 more than one variable. |
||||
#' |
||||
#' @param FullPathToRData path to rda file |
||||
#' |
||||
#' @return an R object, you will probable want to assign it to a variable |
||||
#' @export |
||||
LoadRData2Variable <- function(FullPathToRData) { |
||||
return(eval(parse(text = load(FullPathToRData)))) |
||||
} |
||||
|
||||
|
||||
#' Create a string of specified width from an integer |
||||
#' |
||||
#' Converts an integer or a vector of integers to a string |
||||
#' of fixed length padded with a specified character (e.g., zeroes). |
||||
#' |
||||
#' @param ii integer or vector of integers |
||||
#' @param pchr a padding character (e.g., "0") |
||||
#' @param w width of the return string (an integer) |
||||
## Make sure to set the width longer than or equal to the length of the biggest integer. |
||||
## For example, if the integers (ii) are in the range 1 - 100, set w to at least 3. |
||||
#' |
||||
#' @return a string or a vector of strings |
||||
#' @export |
||||
int2padstr <- function (ii, pchr, w) { |
||||
gsub(" ", pchr, formatC(ii, format = "s", mode = "character", width = w)) |
||||
} |
||||
|
||||
|
||||
#' numbers2words |
||||
#' |
||||
#' Converts a number into its corresponding words in English |
||||
#' THIS FUNCTION WAS PUBLISHED IN: R-News, vol 5, iss 1, May 2005, pp. 51 |
||||
#' Original author: John Fox, Department of Sociology, McMaster University, Hamilton, Ontari |
||||
#' Canada L8S 4M4, 905-525-9140x23604 |
||||
#' http://socserv.mcmaster.ca/jfox |
||||
#' http://cran.csiro.au/doc/Rnews/Rnews_2005-1.pdf |
||||
#' http://finzi.psych.upenn.edu/R/Rhelp02a/archive/46843.html |
||||
#' |
||||
#' @param x number |
||||
#' @param billion follow either US or UK usage rules |
||||
#' @param and follows the choice set in billion arg |
||||
#' |
||||
#' @return string |
||||
#' @export |
||||
numbers2words <- function(x, billion = c("US", "UK"), and = if (billion == "US") "" else "and") { |
||||
billion <- match.arg(billion) |
||||
trim <- function(text) { |
||||
gsub("(^\ *)|((\ *|-|,\ zero|-zero)$)", "", text) |
||||
} |
||||
makeNumber <- function(x) as.numeric(paste(x, collapse = "")) |
||||
makeDigits <- function(x) strsplit(as.character(x), "")[[1]] |
||||
helper <- function(x) { |
||||
negative <- x < 0 |
||||
x <- abs(x) |
||||
digits <- makeDigits(x) |
||||
nDigits <- length(digits) |
||||
result <- if (nDigits == 1) as.vector(ones[digits]) |
||||
else if (nDigits == 2) |
||||
if (x <= 19) as.vector(teens[digits[2]]) |
||||
else trim(paste(tens[digits[1]], "-", ones[digits[2]], sep="")) |
||||
else if (nDigits == 3) { |
||||
tail <- makeNumber(digits[2:3]) |
||||
if (tail == 0) paste(ones[digits[1]], "hundred") |
||||
else trim(paste(ones[digits[1]], trim(paste("hundred", and)), |
||||
helper(tail))) |
||||
} else { |
||||
nSuffix <- ((nDigits + 2) %/% 3) - 1 |
||||
if (nSuffix > length(suffixes) || nDigits > 15) |
||||
stop(paste(x, "is too large!")) |
||||
pick <- 1:(nDigits - 3 * nSuffix) |
||||
trim(paste(helper(makeNumber(digits[pick])), suffixes[nSuffix], helper(makeNumber(digits[-pick])))) |
||||
} |
||||
if (billion == "UK") { |
||||
words <- strsplit(result, " ")[[1]] |
||||
if (length(grep("million,", words)) > 1) |
||||
result <- sub(" million, ", ", ", result) |
||||
} |
||||
if (negative) paste("minus", result) else result |
||||
} |
||||
opts <- options(scipen = 100) |
||||
on.exit(options(opts)) |
||||
ones <- c("zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine") |
||||
teens <- c("ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", " seventeen", "eighteen", "nineteen") |
||||
names(ones) <- names(teens) <- 0:9 |
||||
tens <- c("twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety") |
||||
names(tens) <- 2:9 |
||||
suffixes <- if (billion == "US") { |
||||
c("thousand,", "million,", "billion,", "trillion,") |
||||
} else { |
||||
c("thousand,", "million,", "thousand million,", "billion,") |
||||
} |
||||
x <- round(x) |
||||
if (length(x) > 1) sapply(x, helper) else helper(x) |
||||
} |
||||
@ -0,0 +1,107 @@ |
||||
#' Set the attributes for a generic xtable object |
||||
#' |
||||
#' This function helps you to set the attributes for an xtable |
||||
#' object. It returns an xtable object. |
||||
#' |
||||
#' @param xtobject the xtable (table) |
||||
#' @param nxtnames vector of names (column names) |
||||
#' @param nxtdigits vector of digits (0 if column is non-numeric, numeric of desired number of digits otherwise) |
||||
#' @param nxtdisplay vector of display format [see formatC(format=...)] |
||||
#' @param nxtalign vector of LaTeX align (e.g., "l", "c", "r", "S[table-format=1.1]", ...) |
||||
#' @param caption.text string for the LaTeX caption text |
||||
#' @param caption.label string for the LaTeX reference label |
||||
#' |
||||
#' @details |
||||
#' Sets names, digits, display, and align for the passed xtable object |
||||
#' |
||||
#' @return xtable object |
||||
#' @export |
||||
#' |
||||
#' @examples |
||||
#' \dontrun{ |
||||
#' xtabWithAttributes <- GenericXtableSetAttributes(xtobject) |
||||
#' xtabWithAttributes <- GenericXtableSetAttributes(xtobject, nxtdigits = c(0, 2, 2, 4)) |
||||
#' } |
||||
GenericXtableSetAttributes <- function(xtobject, |
||||
nxtnames = NULL, |
||||
nxtdigits = NULL, |
||||
nxtdisplay = NULL, |
||||
nxtalign = NULL, |
||||
caption.text = "nxtcaption", |
||||
caption.label = "tab:nxtlabel") { |
||||
|
||||
# remember to put all names inside "{}" if you use siunitx |
||||
if (!is.null(nxtnames)) {names(xtobject) <- nxtnames} |
||||
# the prepended column due to "row.names" |
||||
if (!is.null(nxtdigits)) {xtable::digits(xtobject) <- c(0, nxtdigits)} |
||||
if (!is.null(nxtdisplay)) {xtable::display(xtobject) <- c("s", nxtdisplay)} |
||||
if (!is.null(nxtalign)) {xtable::align(xtobject) <- c("l", nxtalign)} |
||||
xtable::caption(xtobject) <- caption.text |
||||
xtable::label(xtobject) <- caption.label |
||||
# |
||||
return (xtobject) |
||||
} |
||||
|
||||
|
||||
#' Set xtable header in LaTeX longtable format |
||||
#' |
||||
#' This function creates a longtable header assuming |
||||
#' that the LaTeX document will use the booktabs package. |
||||
#' This function should not be used together with \code{booktabs = TRUE} |
||||
#' |
||||
#' @param xtobject xtable object (table) |
||||
#' @param caption.text string for the LaTeX caption text |
||||
#' @param caption.label string for the LaTeX reference label |
||||
#' |
||||
#' @return character string (with LaTeX escaping) |
||||
#' @export |
||||
LongtableXtableHeader <- function(xtobject, caption.text, caption.label) { |
||||
ltxt.header <- |
||||
paste(paste("\\caption{", caption.text, "}", sep = "", collapse = ""), |
||||
paste("\\label{", caption.label, "}\\\\ ", sep = "", collapse = ""), |
||||
"\\toprule ", |
||||
attr(xtobject, "names")[1], |
||||
paste(" &", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\\midrule ", |
||||
"\\endfirsthead ", |
||||
paste("\\multicolumn{", |
||||
ncol(xtobject), |
||||
"}{c}{{\\tablename\\ \\thetable{} -- continued from previous page}}\\\\ ", |
||||
sep = ""), |
||||
"\\toprule ", |
||||
attr(xtobject, "names")[1], |
||||
paste("&", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\\midrule ", |
||||
"\\endhead ", |
||||
"\\midrule ", |
||||
paste("\\multicolumn{", |
||||
as.character(ncol(xtobject)), |
||||
"}{r}{{Continued on next page}}\\\\ ", |
||||
sep = "", collapse = ""), |
||||
"\\bottomrule \\endfoot ", |
||||
"\\bottomrule \\endlastfoot ", |
||||
collapse = "") |
||||
return(ltxt.header) |
||||
} |
||||
|
||||
|
||||
#' Set xtable header in LaTeX tabular format |
||||
#' |
||||
#' This function should be used together with \code{booktabs = TRUE}. |
||||
#' |
||||
#' @param xtobject xtable object (table) |
||||
#' @param names.custom Use \code{names.custom} to make more complicated headers, e.g., multiple-row |
||||
#' |
||||
#' @return character string (with LaTeX escaping) |
||||
#' @export |
||||
TabularXtableHeader <- function(xtobject, names.custom = NULL) { |
||||
if (is.null(names.custom)) { |
||||
txt.header <- |
||||
paste(attr(xtobject, "names")[1], |
||||
paste(" &", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\n") |
||||
} else { |
||||
txt.header <- names.custom |
||||
} |
||||
return(txt.header) |
||||
} |
||||
@ -0,0 +1,44 @@ |
||||
#' Calculate area under a curve |
||||
#' |
||||
#' Numerically calculate area under an arbitrary curve (defined by x, y coord pairs) |
||||
#' using trapezodial integration. See Wikipedia for more info on trapz integration. |
||||
#' |
||||
#' @param x vector (of length n) |
||||
#' @param y vector (of length n) |
||||
#' |
||||
#' @return vector (of length n - 1) |
||||
#' @export |
||||
trapz <- function(x, y) { |
||||
idx <- 2:length(x) |
||||
return (as.double((x[idx] - x[idx - 1]) * (y[idx] + y[idx - 1])) / 2) |
||||
} |
||||
|
||||
#' Round up to the nearest specified interval |
||||
#' |
||||
#' This function rounds UP to the nearest interval specified by "nearest" |
||||
#' http://stackoverflow.com/questions/6461209/how-to-round-up-to-the-nearest-10-or-100-or-x |
||||
#' |
||||
#' @param x number |
||||
#' @param nearest nearest interval, e.g., 5, 10, 100, 1000, etc. |
||||
#' |
||||
#' @return a number |
||||
#' @export |
||||
roundup <- function(x, nearest=1000) { |
||||
ceiling(max(x+10^-9)/nearest + 1/nearest)*nearest |
||||
} |
||||
|
||||
|
||||
#' is.wholenumber |
||||
#' |
||||
#' I am not even sure this function is useful any longer. |
||||
#' Kept for legacy purposes just in case some old code depends on it. |
||||
#' This function was copied from R's documentation (see ?is.integer). |
||||
#' |
||||
#' @param x number |
||||
#' @param tol machine's double precision |
||||
#' |
||||
#' @return logical (TRUE or FALSE) |
||||
#' @export |
||||
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) { |
||||
abs(x - round(x)) < tol |
||||
} |
||||
@ -0,0 +1,66 @@ |
||||
#' Create sampleid from path to experiment datafile |
||||
#' |
||||
#' Returns a "unique" sample ID when supplied with a path to an experimental file. |
||||
#' The second arg is optional, defaults to "old" behaviour, |
||||
#' but can be set to "dirname" for another behaviour. |
||||
#' The second arg was added so as not to break older code. |
||||
#' |
||||
#' @param pathexpfile path to an experiment datafile |
||||
#' @param implementation defaults to "old" behaviour, can also be set to "dirname" |
||||
#' |
||||
#' @return a sampleid (character string) |
||||
#' @export |
||||
ProvideSampleId <- function (pathexpfile, implementation = "filename") { |
||||
## Note to myself: the sample ID must derive directly from the file or path. |
||||
if (implementation == "dirname") { |
||||
# basename(dirname()) returns the name of the lowest sub-directory |
||||
# split()[[1]][2] splits the dirname at the hyphen and returns the sampleid |
||||
sampleid <- strsplit(x = basename(dirname(pathexpfile)), |
||||
split = "-")[[1]][2] |
||||
} else { |
||||
# basename() returns the filename sans path |
||||
# sub() returns the filename sans extension |
||||
sampleid <- sub("\\.[\\w]+$", "", basename(pathexpfile), perl = TRUE) |
||||
} |
||||
|
||||
return(sampleid) |
||||
} |
||||
|
||||
|
||||
#' Display the history of a substrate (sampleid) |
||||
#' |
||||
#' @param sampleid string |
||||
#' @param matrix.rda path to rdata file containing the sample matrix |
||||
#' |
||||
#' @return a dataframe |
||||
#' @export |
||||
SubstrateHistory <- function(sampleid, matrix.rda) { |
||||
matrix <- LoadRData2Variable(matrix.rda) |
||||
# Extract the rows pertaining to the current sampleid |
||||
sample.history <- matrix[which(matrix$sampleid == sampleid), ] |
||||
# Loops remove all "\\labreport{...}" strings (they make the table too wide otherwise) |
||||
for (j in 1:dim(sample.history)[1]) { |
||||
for (k in 1:dim(sample.history)[2]) { |
||||
sample.history[j, k] <- gsub("^\\\\labreport.*?\\}\\{", "", sample.history[j, k]) |
||||
sample.history[j, k] <- gsub("\\}$", "", sample.history[j, k]) |
||||
} |
||||
} |
||||
# Find empty columns and collect their column indices |
||||
empty.cols <- matrix(data = FALSE, nrow = 1, ncol = dim(sample.history)[2]) |
||||
for (k in 1:dim(sample.history)[2]) { |
||||
if (paste(sample.history[, k], collapse = "") == "") { |
||||
empty.cols[, k] <- TRUE |
||||
} |
||||
} |
||||
# Save the names of the empty columns |
||||
empty.names <- names(sample.history)[which(empty.cols)] |
||||
# Remove the identified empty columns plus those columns deemed unwanted |
||||
sample.history <- sample.history[, -c(which(empty.cols == TRUE), |
||||
#which(names(sample.history) == "sampleid"), |
||||
which(names(sample.history) == "created"), |
||||
which(names(sample.history) == "project"))] |
||||
# Save the empty column names as attribute to sample.history dataframe |
||||
attr(sample.history, "empty.names") <- empty.names |
||||
|
||||
return(sample.history) |
||||
} |
||||
@ -1,81 +1,75 @@ |
||||
# Writing number with exponent (such as scientific notation) with uncertainty using siunitx |
||||
|
||||
# Origin of problem, this kind of code: |
||||
# \SI[separate-uncertainty=true]{\Sexpr{formatC(cd.flux, format = "e", digits = 2)} \pm \Sexpr{formatC(cd.flux.error, format = "e", digits = 2)}}{\milli\coulomb\per\square\cm\per\second} |
||||
# makes siunitx throw the error: |
||||
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||||
# ! |
||||
# ! siunitx error: "misplaced-sign-token" |
||||
# ! |
||||
# ! Misplaced sign token '\pm '. |
||||
# ! |
||||
# ! See the siunitx documentation for further information. |
||||
# ! |
||||
# ! For immediate help type H <return>. |
||||
# !............................................... |
||||
|
||||
|
||||
# This is status-by-design according to Joseph Wright. |
||||
# http://tex.stackexchange.com/questions/123771/exponent-notation-in-siunitx |
||||
|
||||
# But if the two numbers (number and uncertainty) have the same exponent, that is ok. |
||||
# So here we try to write a function that accepts two numbers, |
||||
# and returns them written in a common exponent (as strings). |
||||
|
||||
#' siunitx.uncertainty |
||||
#' |
||||
#' Writing number with exponent (such as scientific notation) with uncertainty using siunitx |
||||
#' |
||||
#' @param quantity quantity |
||||
#' @param uncertainty uncertainty |
||||
#' @param digits number of digits |
||||
#' |
||||
#' @return a string suitable for use with siunitx num{} command |
||||
#' @export |
||||
siunitx.uncertainty <- function(quantity, uncertainty, digits = 6) { |
||||
# Origin of problem, this kind of code: |
||||
# \SI[separate-uncertainty=true]{\Sexpr{formatC(cd.flux, format = "e", digits = 2)} \pm \Sexpr{formatC(cd.flux.error, format = "e", digits = 2)}}{\milli\coulomb\per\square\cm\per\second} |
||||
# makes siunitx throw the error: |
||||
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||||
# ! |
||||
# ! siunitx error: "misplaced-sign-token" |
||||
# ! |
||||
# ! Misplaced sign token '\pm '. |
||||
# ! |
||||
# ! See the siunitx documentation for further information. |
||||
# ! |
||||
# ! For immediate help type H <return>. |
||||
# !............................................... |
||||
|
||||
# This is status-by-design according to Joseph Wright. |
||||
# http://tex.stackexchange.com/questions/123771/exponent-notation-in-siunitx |
||||
|
||||
# But if the two numbers (number and uncertainty) have the same exponent, that is ok. |
||||
# So here we try to write a function that accepts two numbers, |
||||
# and returns them written in a common exponent (as strings). |
||||
|
||||
# both arguments should be numeric |
||||
|
||||
|
||||
# how to find common exponent for two numbers? |
||||
|
||||
|
||||
# find exponent of quantity (tiopotensen for kvantiteten) |
||||
quantity.exponent <- floor(log(abs(quantity), 10)) |
||||
|
||||
|
||||
# find coefficient of quantity |
||||
# warning, numeric-to-string-to-numeric conversion ... |
||||
quantity.coefficient <- |
||||
quantity.coefficient <- |
||||
as.numeric(strsplit(formatC(quantity, format="e", digits=digits), "[Ee]-")[[1]][1]) |
||||
|
||||
|
||||
# construct return quantity string |
||||
rquantity.string <- |
||||
rquantity.string <- |
||||
paste0(formatC(quantity.coefficient, format="f", digits=digits), "e", quantity.exponent) |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# find exponent of uncertainty (tiopotensen for the uncertainty) |
||||
uncertainty.exponent <- floor(log(abs(uncertainty), 10)) |
||||
|
||||
|
||||
# find coefficient of uncertainty |
||||
# warning, numeric-to-string-to-numeric conversion ... |
||||
uncertainty.coefficient <- |
||||
uncertainty.coefficient <- |
||||
as.numeric(strsplit(formatC(uncertainty, format="e", digits=digits), "[Ee]-")[[1]][1]) |
||||
|
||||
|
||||
# adjust uncertainty to the same exponent as the quantity |
||||
# express uncertainty with the same exponent as quantity |
||||
# express uncertainty with the same exponent as quantity |
||||
# (adjust number of uncertainty accordingly) |
||||
runcertainty.exponent <- quantity.exponent |
||||
runcertainty.coefficient <- uncertainty.coefficient * 10^(uncertainty.exponent - quantity.exponent) |
||||
|
||||
runcertainty.string <- |
||||
|
||||
runcertainty.string <- |
||||
paste0(formatC(runcertainty.coefficient, format="f", digits=digits), "e", runcertainty.exponent) |
||||
|
||||
|
||||
|
||||
# create a string directly suitable for the siunitx \num{} command |
||||
siunitx.string <- paste(quantity.coefficient, "\\pm", runcertainty.string) |
||||
|
||||
return(c(quantity = rquantity.string, |
||||
return(c(quantity = rquantity.string, |
||||
uncertainty = runcertainty.string, |
||||
siunitx = siunitx.string)) |
||||
} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,157 @@ |
||||
#' AVS -> SHE |
||||
#' |
||||
#' Converts from absolute vacuum scale (AVS) to SHE scale |
||||
#' |
||||
#' @param avs Potential in AVS scale |
||||
#' |
||||
#' @return potential in SHE scale (numeric) |
||||
#' @export |
||||
AVS2SHE <- function(avs) { |
||||
she <- -(4.5 + avs) |
||||
return(she) |
||||
} |
||||
|
||||
|
||||
#' SHE -> AVS |
||||
#' |
||||
#' Converts from SHE scale to absolute vacuum (AVS) scale |
||||
#' |
||||
#' @param she Potential in SHE scale |
||||
#' |
||||
#' @return potential in AVS scale (numeric) |
||||
#' @export |
||||
SHE2AVS <- function(she) { |
||||
avs <- -(4.5 + she) |
||||
return(avs) |
||||
} |
||||
|
||||
|
||||
#' ConvertRefPotEC |
||||
#' |
||||
#' This function does the heavy lifting. |
||||
#' Converts from an electrochemical reference scale into another. |
||||
#' SHE: standard hydrogen electrode scale |
||||
#' Ag/AgCl: silver silver-chloride electrode scale (3M KCl) |
||||
#' SCE: standard calomel scale |
||||
#' |
||||
#' @param argpotential potential (numeric) |
||||
#' @param argrefscale input reference scale (character string) |
||||
#' @param valuerefscale output reference scale (character string) |
||||
#' |
||||
#' @return potential in output reference scale (numeric) |
||||
ConvertRefPotEC <- function(argpotential, argrefscale, valuerefscale) { |
||||
##### Add more reference electrodes here >> |
||||
refpotatSHEzero <- c( 0, -0.21, -0.24, 3) |
||||
refrownames <- c( "SHE", "Ag/AgCl", "SCE", "Li/Li+") |
||||
refcolnames <- c("SHE0", "AgCl0", "SCE0", "Li0") |
||||
##### Add more reference electrodes here << |
||||
# |
||||
SHE0 <- data.frame(matrix(refpotatSHEzero, ncol=length(refpotatSHEzero), byrow=T)) |
||||
refpotmtx <- matrix(NA, length(SHE0), length(SHE0)) |
||||
refpotmtx[,1] <- matrix(as.matrix(SHE0), ncol=1, byrow=T) |
||||
for (c in 2:length(SHE0)) { |
||||
# loop over columns (except the first) |
||||
for (r in 1:length(SHE0)) { |
||||
# loop over rows |
||||
refpotmtx[r, c] <- refpotmtx[r, 1] - refpotmtx[c, 1] |
||||
} |
||||
} |
||||
refpotdf <- as.data.frame(refpotmtx) |
||||
names(refpotdf) <- refcolnames |
||||
row.names(refpotdf) <- refrownames |
||||
## So far we have made a matrix of all the possible combinations, |
||||
## given the vector refpotatSHEzero. The matrix is not strictly necessary, |
||||
## but it may prove useful later. It does. |
||||
# |
||||
# Match argrefscale to the refrownames |
||||
argmatch <- match(argrefscale, refrownames, nomatch = 0) |
||||
# Match valuerefscale to the refrownames |
||||
valuematch <- match(valuerefscale, refrownames, nomatch = 0) |
||||
# We simply assume that the match was well-behaved |
||||
valuepotential <- argpotential + refpotdf[valuematch, argmatch] |
||||
# Check that arg and value electrodes are within bounds for a match |
||||
if (argmatch == 0 || valuematch == 0) { |
||||
# No match |
||||
# Perform suitable action |
||||
message("Arg out of bounds in call to ConvertRefPot") |
||||
valuepotential <- NA |
||||
} |
||||
return(valuepotential) |
||||
} |
||||
|
||||
|
||||
#' Convert from one electrochemical scale to another |
||||
#' |
||||
#' @param argpotential potential (numeric) |
||||
#' @param argrefscale input reference scale (char string) |
||||
#' @param valuerefscale output reference scale (char string) |
||||
#' |
||||
#' @return potential in output reference scale (numeric) |
||||
#' @export |
||||
ConvertRefPot <- function(argpotential, argrefscale, valuerefscale) { |
||||
# You should check that argpotential is valid numeric |
||||
|
||||
# IDEA: make a matrix out of these (scale names and flags) |
||||
|
||||
# Valid scales |
||||
scale.names <- list() |
||||
scale.names[["SHE"]] <- c("SHE", "NHE", "she", "nhe") |
||||
scale.names[["AgCl"]] <- c("Ag/AgCl", "AgCl", "ag/agcl", "agcl") |
||||
scale.names[["SCE"]] <- c("SCE", "sce") |
||||
scale.names[["Li"]] <- c("Li/Li+", "Li", "Li+", "li", "li+", "li/li+") |
||||
scale.names[["AVS"]] <- c("AVS", "avs") |
||||
|
||||
# Set flags |
||||
bool.flags <- as.data.frame(matrix(0, nrow = length(scale.names), ncol = 2)) |
||||
names(bool.flags) <- c("argref", "valueref") |
||||
row.names(bool.flags) <- names(scale.names) |
||||
|
||||
# argrefscale |
||||
# Check that argrefscale is valid character mode |
||||
# ... |
||||
|
||||
for (j in 1:length(row.names(bool.flags))) { |
||||
if (any(scale.names[[row.names(bool.flags)[j]]] == argrefscale)) { |
||||
bool.flags[row.names(bool.flags)[j], "argref"] <- j |
||||
} |
||||
} |
||||
|
||||
|
||||
# valuerefscale |
||||
# Check that valuerefscale is valid character mode |
||||
# ... |
||||
|
||||
for (k in 1:length(row.names(bool.flags))) { |
||||
if (any(scale.names[[row.names(bool.flags)[k]]] == valuerefscale)) { |
||||
bool.flags[row.names(bool.flags)[k], "valueref"] <- k |
||||
} |
||||
} |
||||
|
||||
# Depending on which flags are set, call the corresponding function |
||||
|
||||
decision.vector <- colSums(bool.flags) |
||||
|
||||
# Check if both scales are the same (no conversion needed). If so, abort gracefully. |
||||
# ... |
||||
|
||||
if (decision.vector["argref"] == 5 || decision.vector["valueref"] == 5) { |
||||
# AVS is requested, deal with it it |
||||
if (decision.vector["argref"] == 5) { |
||||
# Conversion _from_ AVS |
||||
rnpotential <- ConvertRefPotEC(AVS2SHE(argpotential), |
||||
"SHE", |
||||
scale.names[[decision.vector["valueref"]]][1]) |
||||
} |
||||
if (decision.vector["valueref"] == 5) { |
||||
# Conversion _to_ AVS |
||||
rnpotential <- SHE2AVS(ConvertRefPotEC(argpotential, |
||||
scale.names[[decision.vector["argref"]]][1], |
||||
"SHE")) |
||||
} |
||||
} else { |
||||
rnpotential <- ConvertRefPotEC(argpotential, |
||||
scale.names[[decision.vector["argref"]]][1], |
||||
scale.names[[decision.vector["valueref"]]][1]) |
||||
} |
||||
return(rnpotential) |
||||
} |
||||
@ -0,0 +1,139 @@ |
||||
#' Convert wavelength to wavenumber |
||||
#' |
||||
#' Converts wavelength (nm) to wavenumber (cm-1) |
||||
#' Only valid for absolute wavelengths, NOT delta wavelengths (ranges) |
||||
#' http://www.powerstream.com/inverse-cm.htm |
||||
#' |
||||
#' @param wavelength number or vector of numbers |
||||
#' |
||||
#' @return number or vector |
||||
#' @export |
||||
wavelength2num <- function(wavelength) { |
||||
wavenumber <- |
||||
10E6 / wavelength |
||||
return(wavenumber) |
||||
} |
||||
|
||||
|
||||
#' Convert wavenumber to wavelength |
||||
#' |
||||
#' Converts wavenumber (cm-1) to wavelength (nm) |
||||
#' Only valid for absolute wavenumbers, NOT delta wavenumbers (ranges) |
||||
#' http://www.powerstream.com/inverse-cm.htm |
||||
#' |
||||
#' @param wavenumber number or vector of numbers |
||||
#' |
||||
#' @return number ofr vector |
||||
#' @export |
||||
wavenum2length <- function(wavenumber) { |
||||
wavelength <- |
||||
10E6 / wavenumber |
||||
return(wavelength) |
||||
} |
||||
|
||||
|
||||
#' Convert from radians to degrees |
||||
#' |
||||
#' @param radians numeric |
||||
#' |
||||
#' @return degrees (numeric) |
||||
#' @export |
||||
as.degrees <- function(radians) { |
||||
degrees <- radians * (180 / pi) |
||||
return(degrees) |
||||
} |
||||
|
||||
|
||||
#' Convert from degrees to radians |
||||
#' |
||||
#' @param degrees numeric |
||||
#' |
||||
#' @return radians (numeric) |
||||
#' @export |
||||
as.radians <- function(degrees) { |
||||
radians <- degrees * (pi / 180) |
||||
return(radians) |
||||
} |
||||
|
||||
|
||||
#' Convert from Celsius scale to Kelvin |
||||
#' |
||||
#' Converts temperature from Celsius to Kelvin. |
||||
#' |
||||
#' @param Celsius degrees Celsius (numeric) |
||||
#' |
||||
#' @return Kelvin (numeric) |
||||
#' @export |
||||
Celsius2Kelvin <- function(Celsius) { |
||||
# Check and correct for values below -273.15 |
||||
if (Celsius < -273.15) { |
||||
# If Celsis is less than absolute zero, set it to absolute zero |
||||
Celsius <- -273.15 |
||||
} |
||||
Kelvin <- Celsius + 273.15 |
||||
return(Kelvin) |
||||
} |
||||
|
||||
|
||||
#' Convert from Kelvin to Celsius scale |
||||
#' |
||||
#' Converts from temperature in Kelvin to degrees Celsius |
||||
#' |
||||
#' @param Kelvin (numeric) |
||||
#' |
||||
#' @return degrees Celsius (numeric) |
||||
#' @export |
||||
Kelvin2Celsius <- function(Kelvin) { |
||||
# Check and correct for negative values |
||||
if (Kelvin < 0) { |
||||
# If Kelvin is less than zero, set it to zero |
||||
Kelvin <- 0 |
||||
} |
||||
Celsius <- Kelvin - 273.15 |
||||
return(Celsius) |
||||
} |
||||
|
||||
|
||||
#' Calculate d-spacings from 2theta values |
||||
#' |
||||
#' This function applies Bragg's law to calculate d-spacings from thth (n = 1) |
||||
#' |
||||
#' @param thth vector with thth values in degrees |
||||
#' @param wavelength radiation wavelength in Angstrom |
||||
#' |
||||
#' @return d-spacings (numeric) |
||||
#' @export |
||||
thth2d <- function(thth, wavelength = 1.540562) { |
||||
# Wavelengths: |
||||
# Ag-Ka1 wavelength=0.5594075 |
||||
# Ag-Ka2 wavelength=0.563798 |
||||
# Ag-Kb1 wavelength=0.497069 |
||||
# Ag-Kb2 wavelength=0.497685 |
||||
# Co-Ka1 wavelength=1.788965 |
||||
# Co-Ka2 wavelength=1.792850 |
||||
# Co-Kb1 wavelength=1.620790 |
||||
# Cr-Ka1 wavelength=2.289700 |
||||
# Cr-Ka2 wavelength=2.293606 |
||||
# Cr-Kb1 wavelength=2.084870 |
||||
# Cu-Ka1 wavelength=1.540562 |
||||
# Cu-Ka2 wavelength=1.544398 |
||||
# Cu-Kb1 wavelength=1.392218 |
||||
# Fe-Ka1 wavelength=1.936042 |
||||
# Fe-Ka2 wavelength=1.939980 |
||||
# Fe-Kb1 wavelength=1.756610 |
||||
# Ge-Ka1 wavelength=1.254054 |
||||
# Ge-Ka2 wavelength=1.258011 |
||||
# Ge-Kb1 wavelength=1.057300 |
||||
# Ge-Kb2 wavelength=1.057830 |
||||
# Mo-Ka1 wavelength=0.709300 |
||||
# Mo-Ka2 wavelength=0.713590 |
||||
# Mo-Kb1 wavelength=0.632288 |
||||
# Mo-Kb2 wavelength=0.632860 |
||||
# Ni-Ka1 wavelength=1.657910 |
||||
# Ni-Ka2 wavelength=1.661747 |
||||
# Ni-Kb1 wavelength=1.500135 |
||||
# Zn-Ka1 wavelength=1.435155 |
||||
# Zn-Ka2 wavelength=1.439000 |
||||
# Zn-Kb1 wavelength=1.295250 |
||||
return (wavelength / (2 * sin(as.radians(thth)))) |
||||
} |
||||
@ -1,8 +0,0 @@ |
||||
################################################## |
||||
#################### SHE2AVS ##################### |
||||
################################################## |
||||
SHE2AVS <- function(she) { |
||||
# Converts from SHE scale to absolute vacuum (AVS) scale |
||||
avs <- -(4.5 + she) |
||||
return(avs) |
||||
} |
||||
@ -1,37 +0,0 @@ |
||||
source(HomeByHost("/home/taha/chepec/chetex/common/R/common/LoadRData2Variable.R")) |
||||
|
||||
################################################## |
||||
############## SubstrateHistory ################## |
||||
################################################## |
||||
SubstrateHistory <- function(sampleid) { |
||||
# |
||||
# |
||||
matrix <- LoadRData2Variable("/home/taha/chepec/chetex/sample-matrix/sample-matrix-substrates.rda") |
||||
# Extract the rows pertaining to the current sampleid |
||||
sample.history <- matrix[which(matrix$sampleid == sampleid), ] |
||||
# Loops remove all "\\labreport{...}" strings (they make the table too wide otherwise) |
||||
for (j in 1:dim(sample.history)[1]) { |
||||
for (k in 1:dim(sample.history)[2]) { |
||||
sample.history[j, k] <- gsub("^\\\\labreport.*?\\}\\{", "", sample.history[j, k]) |
||||
sample.history[j, k] <- gsub("\\}$", "", sample.history[j, k]) |
||||
} |
||||
} |
||||
# Find empty columns and collect their column indices |
||||
empty.cols <- matrix(data = FALSE, nrow = 1, ncol = dim(sample.history)[2]) |
||||
for (k in 1:dim(sample.history)[2]) { |
||||
if (paste(sample.history[, k], collapse = "") == "") { |
||||
empty.cols[, k] <- TRUE |
||||
} |
||||
} |
||||
# Save the names of the empty columns |
||||
empty.names <- names(sample.history)[which(empty.cols)] |
||||
# Remove the identified empty columns plus those columns deemed unwanted |
||||
sample.history <- sample.history[, -c(which(empty.cols == TRUE), |
||||
#which(names(sample.history) == "sampleid"), |
||||
which(names(sample.history) == "created"), |
||||
which(names(sample.history) == "project"))] |
||||
# Save the empty column names as attribute to sample.history dataframe |
||||
attr(sample.history, "empty.names") <- empty.names |
||||
|
||||
return(sample.history) |
||||
} |
||||
@ -1,13 +0,0 @@ |
||||
TabularXtableHeader <- function(xtobject, names.custom = NULL) { |
||||
# use names.custom to make more complicated headers, e.g. multiple-row |
||||
# should be used together with booktabs = TRUE |
||||
if (is.null(names.custom)) { |
||||
txt.header <- |
||||
paste(attr(xtobject, "names")[1], |
||||
paste(" &", attr(xtobject, "names")[2:length(attr(xtobject, "names"))], collapse = ""), |
||||
"\\\\\n") |
||||
} else { |
||||
txt.header <- names.custom |
||||
} |
||||
return(txt.header) |
||||
} |
||||
@ -1,8 +0,0 @@ |
||||
################################################## |
||||
################# as.degrees ##################### |
||||
################################################## |
||||