Refactored code into a rudimentary R package.

master
Taha Ahmed 8 years ago
parent c00fcc54a9
commit e22546cb3c

12
.gitignore vendored

@ -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)
}

@ -1,72 +1,66 @@
##################################################
############# SubfigureGenerator #################
##################################################
SubfigureGenerator <- function(images,
subcaptions,
#' Generate LaTeX subfigure code
#'
#' Generate LaTeX subfigure code for a bunch of supplied image paths,
#' subcaptions, label and subfigure layout.
#' Supports splitting the figures over several pages or using landscape layout.
#'
#' @param images vector with full paths to images (png-files or other LaTeX-compatible format)
#' to be put in a LaTeX subfigure environment
#' @param subcaptions vector with subcaptions for each subfigure
#' @param mainlabel string with LaTeX label for the main figure environment
#' should be set individually if SubfigureGenerator() is called more than once from the same document
#' @param perpage maximum number of images on one page, one A4 page fits six images with subcaptions
#' @param ncol LaTeX subfigure is setup with ncol columns
#' @param landscape set this to TRUE if pages are set in landscape mode
#'
#' @return a string with LaTeX code
#' @export
SubfigureGenerator <- function(images,
subcaptions,
mainlabel = "fig:mainfig",
perpage = 6,
ncol = 2,
perpage = 6,
ncol = 2,
landscape = FALSE) {
## Description:
##
## Usage:
##
## Arguments:
## images: vector with full paths to images
## (png-files or other LaTeX-compatible format)
## to be put in a LaTeX subfigure environment
## subcaptions: vector with subcaptions for each subfigure
## mainlabel: string with LaTeX label for the main figure environment
## Should be set individually if SubfigureGenerator() is called
## more than once from the same document
## perpage: maximum number of images on one page,
## one A4 page fits six images with subcaptions
## ncol: LaTeX subfigure is setup with ncol columns
## landscape: set to TRUE if pages are set in landscape mode
## Return value:
## A string with LaTeX code
#
# Collect all LaTeX code in a textconnection
# Collect all LaTeX code in a textconnection
# that's dumped to a vector before return
zzstring <- ""
zz <- textConnection("zzstring", "w")
# If landscape is TRUE, set pagewidth to \textheight
# pagewidth <- ifelse(landscape == TRUE, "\\textheight", "\\textwidth")
# pagewidth <- ifelse(landscape == TRUE, "\\textheight", "\\textwidth")
pagewidth <- "\\textwidth"
# Check that the vector of images is non-empty
if (length(images) > 0) {
# keep track of the number of pages the images are split across
page.counter <- 1
# Calculate width of subfigure based on ncol-value
subfigure.width <- 1 / ncol - 0.02
# begin figure
if (landscape == TRUE) {
cat("\\begin{sidewaysfigure}\\centering\n", file = zz)
} else {
cat("\\begin{figure}[hb]\\centering\n", file = zz)
}
# display images in a X-by-Y grid
for (i in 1:length(images)) {
cat(paste("\\begin{subfigure}[b]{", round(subfigure.width, 2),
cat(paste("\\begin{subfigure}[b]{", round(subfigure.width, 2),
pagewidth, "}\\centering\n", sep = ""), file = zz)
# this includes the i-th image in a subfigure
cat(paste("\\includegraphics[width=\\linewidth]{",
cat(paste("\\includegraphics[width=\\linewidth]{",
images[i], "}\n", sep = ""), file = zz)
cat(paste("\\caption{", subcaptions[i],
cat(paste("\\caption{", subcaptions[i],
"}\n", sep = ""), file = zz)
cat(paste("\\label{", mainlabel, ":sfig-", int2padstr(ii = i, pchr = "0", w = 3),
cat(paste("\\label{", mainlabel, ":sfig-", int2padstr(ii = i, pchr = "0", w = 3),
"}\n", sep = ""), file = zz)
cat("\\end{subfigure}", file = zz)
#
if (!(i %% (perpage)) && length(images) != (perpage*page.counter)) {
cat("\\caption{Main figure caption.}\n", file = zz)
cat(paste("\\label{", mainlabel, "-",
int2padstr(ii = page.counter, pchr = "0", w = 3),
cat(paste("\\label{", mainlabel, "-",
int2padstr(ii = page.counter, pchr = "0", w = 3),
"}\n", sep = ""), file = zz)
if (landscape == TRUE) {
cat("\\end{sidewaysfigure}\n", file = zz)
@ -90,13 +84,13 @@ SubfigureGenerator <- function(images,
# even number -- add newline and some vspace
cat("\\\\[6pt]\n", file = zz)
}
}
}
}
#
#
# end figure
cat("\\caption{Main caption.}\n", file = zz)
cat(paste("\\label{", mainlabel, "-",
int2padstr(ii= page.counter, pchr = "0", w = 3),
int2padstr(ii= page.counter, pchr = "0", w = 3),
"}\n", sep = ""), file = zz)
if (landscape == TRUE) {
cat("\\end{sidewaysfigure}\n", file = zz)
@ -104,7 +98,7 @@ SubfigureGenerator <- function(images,
cat("\\end{figure}\n", file = zz)
}
}
zzstring <- textConnectionValue(zz)
close(zz)
return(zzstring)

@ -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 #####################
##################################################
as.degrees <- function(radians) {
# Converts from radians to degrees
degrees <- radians * (180 / pi)
return(degrees)
}

@ -1,8 +0,0 @@
##################################################
################# as.radians #####################
##################################################
as.radians <- function(degrees) {
# Converts from degrees to radians
radians <- degrees * (pi / 180)
return(radians)
}

@ -1,17 +0,0 @@
##################################################
################## capitalize ####################
##################################################
capitalize <- function(x) {
## Description:
## Capitalizes the first letter of a string
## == This function was inspired by the function supplied in the base R doc for chartr()
## Usage:
## capitalize(string)
## Arguments:
## x: a string or vector of strings
## Value:
## A string or vector of strings
#
paste(toupper(substring(x, 1, 1)), substring(x, 2),
sep = "")
}

@ -0,0 +1,21 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 3
Encoding: UTF-8
RnwWeave: knitr
LaTeX: pdfLaTeX
AutoAppendNewline: Yes
StripTrailingWhitespace: Yes
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace

@ -1,16 +0,0 @@
##################################################
#################### eV2nm #######################
##################################################
source(HomeByHost("/home/taha/chepec/chetex/common/R/sunlight/solarconstants.R"))
eV2nm <- function(eV) {
# Converts energy in eV to wavelength in nm
#
sun.constants <- solar.constants()
nm <-
sun.constants["h.eV", "value"] *
1E9 * sun.constants["c", "value"] / eV
return(nm)
}

@ -1,28 +0,0 @@
##################################################
################# hms2seconds ####################
##################################################
hms2seconds <- function(hms_vec) {
## Description:
## Converts an hh:mm:ss time into seconds.
## Usage:
## hms2seconds(hh:mm:ss)
## Arguments:
## hms_vec: a character vector
## Value:
## A numeric vector with the same number of elements
## as the input vector
#
seconds <- rep(NA, length(hms_vec))
for (i in 1:length(hms_vec)) {
hms_str <- strsplit(hms_vec[i], ":")[[1]]
# We assume hours:min:sec, anything else, throw an error
if (length(hms_str) != 3) {
error("Input must be formatted as hh:mm:ss")
}
seconds[i] <-
as.numeric(hms_str[1]) * 3600 +
as.numeric(hms_str[2]) * 60 +
as.numeric(hms_str[3])
}
return(seconds)
}

@ -1,21 +0,0 @@
##################################################
################## int2padstr ####################
##################################################
int2padstr <- function (ii, pchr, w) {
## Description:
## Converts an integer or a vector of integers to
## a string padded with characters.
## Usage:
## int2padstr(ii, pchr, w)
## Arguments:
## ii: integer or vector of integers
## pchr: a padding character (e.g., "0")
## 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.
## Value:
## A character string or a vector of character strings
gsub(" ", pchr, formatC(ii, format="s", mode="character", width = w))
}

@ -1,5 +0,0 @@
# This function was copied from R's documentation (see ?is.integer).
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) {
abs(x - round(x)) < tol
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters-electrochemical.R
\name{AVS2SHE}
\alias{AVS2SHE}
\title{AVS -> SHE}
\usage{
AVS2SHE(avs)
}
\arguments{
\item{avs}{Potential in AVS scale}
}
\value{
potential in SHE scale (numeric)
}
\description{
Converts from absolute vacuum scale (AVS) to SHE scale
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{Celsius2Kelvin}
\alias{Celsius2Kelvin}
\title{Convert from Celsius scale to Kelvin}
\usage{
Celsius2Kelvin(Celsius)
}
\arguments{
\item{Celsius}{degrees Celsius (numeric)}
}
\value{
Kelvin (numeric)
}
\description{
Converts temperature from Celsius to Kelvin.
}

@ -0,0 +1,22 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters-electrochemical.R
\name{ConvertRefPot}
\alias{ConvertRefPot}
\title{Convert from one electrochemical scale to another}
\usage{
ConvertRefPot(argpotential, argrefscale, valuerefscale)
}
\arguments{
\item{argpotential}{potential (numeric)}
\item{argrefscale}{input reference scale (char string)}
\item{valuerefscale}{output reference scale (char string)}
}
\value{
potential in output reference scale (numeric)
}
\description{
Convert from one electrochemical scale to another
}

@ -0,0 +1,26 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters-electrochemical.R
\name{ConvertRefPotEC}
\alias{ConvertRefPotEC}
\title{ConvertRefPotEC}
\usage{
ConvertRefPotEC(argpotential, argrefscale, valuerefscale)
}
\arguments{
\item{argpotential}{potential (numeric)}
\item{argrefscale}{input reference scale (character string)}
\item{valuerefscale}{output reference scale (character string)}
}
\value{
potential in output reference scale (numeric)
}
\description{
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
}

@ -0,0 +1,42 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/latex-xtable.R
\name{GenericXtableSetAttributes}
\alias{GenericXtableSetAttributes}
\title{Set the attributes for a generic xtable object}
\usage{
GenericXtableSetAttributes(xtobject, nxtnames = NULL, nxtdigits = NULL,
nxtdisplay = NULL, nxtalign = NULL, caption.text = "nxtcaption",
caption.label = "tab:nxtlabel")
}
\arguments{
\item{xtobject}{the xtable (table)}
\item{nxtnames}{vector of names (column names)}
\item{nxtdigits}{vector of digits (0 if column is non-numeric, numeric of desired number of digits otherwise)}
\item{nxtdisplay}{vector of display format [see formatC(format=...)]}
\item{nxtalign}{vector of LaTeX align (e.g., "l", "c", "r", "S[table-format=1.1]", ...)}
\item{caption.text}{string for the LaTeX caption text}
\item{caption.label}{string for the LaTeX reference label}
}
\value{
xtable object
}
\description{
This function helps you to set the attributes for an xtable
object. It returns an xtable object.
}
\details{
Sets names, digits, display, and align for the passed xtable object
}
\examples{
\dontrun{
xtabWithAttributes <- GenericXtableSetAttributes(xtobject)
xtabWithAttributes <- GenericXtableSetAttributes(xtobject, nxtdigits = c(0, 2, 2, 4))
}
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{Kelvin2Celsius}
\alias{Kelvin2Celsius}
\title{Convert from Kelvin to Celsius scale}
\usage{
Kelvin2Celsius(Kelvin)
}
\arguments{
\item{Kelvin}{(numeric)}
}
\value{
degrees Celsius (numeric)
}
\description{
Converts from temperature in Kelvin to degrees Celsius
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/common.R
\name{LoadRData2Variable}
\alias{LoadRData2Variable}
\title{LoadRData2Variable}
\usage{
LoadRData2Variable(FullPathToRData)
}
\arguments{
\item{FullPathToRData}{path to rda file}
}
\value{
an R object, you will probable want to assign it to a variable
}
\description{
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.
}

@ -0,0 +1,24 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/latex-xtable.R
\name{LongtableXtableHeader}
\alias{LongtableXtableHeader}
\title{Set xtable header in LaTeX longtable format}
\usage{
LongtableXtableHeader(xtobject, caption.text, caption.label)
}
\arguments{
\item{xtobject}{xtable object (table)}
\item{caption.text}{string for the LaTeX caption text}
\item{caption.label}{string for the LaTeX reference label}
}
\value{
character string (with LaTeX escaping)
}
\description{
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}
}

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/samples.R
\name{ProvideSampleId}
\alias{ProvideSampleId}
\title{Create sampleid from path to experiment datafile}
\usage{
ProvideSampleId(pathexpfile, implementation = "filename")
}
\arguments{
\item{pathexpfile}{path to an experiment datafile}
\item{implementation}{defaults to "old" behaviour, can also be set to "dirname"}
}
\value{
a sampleid (character string)
}
\description{
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.
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters-electrochemical.R
\name{SHE2AVS}
\alias{SHE2AVS}
\title{SHE -> AVS}
\usage{
SHE2AVS(she)
}
\arguments{
\item{she}{Potential in SHE scale}
}
\value{
potential in AVS scale (numeric)
}
\description{
Converts from SHE scale to absolute vacuum (AVS) scale
}

@ -0,0 +1,33 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/latex.R
\name{SubfigureGenerator}
\alias{SubfigureGenerator}
\title{Generate LaTeX subfigure code}
\usage{
SubfigureGenerator(images, subcaptions, mainlabel = "fig:mainfig",
perpage = 6, ncol = 2, landscape = FALSE)
}
\arguments{
\item{images}{vector with full paths to images (png-files or other LaTeX-compatible format)
to be put in a LaTeX subfigure environment}
\item{subcaptions}{vector with subcaptions for each subfigure}
\item{mainlabel}{string with LaTeX label for the main figure environment
should be set individually if SubfigureGenerator() is called more than once from the same document}
\item{perpage}{maximum number of images on one page, one A4 page fits six images with subcaptions}
\item{ncol}{LaTeX subfigure is setup with ncol columns}
\item{landscape}{set this to TRUE if pages are set in landscape mode}
}
\value{
a string with LaTeX code
}
\description{
Generate LaTeX subfigure code for a bunch of supplied image paths,
subcaptions, label and subfigure layout.
Supports splitting the figures over several pages or using landscape layout.
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/samples.R
\name{SubstrateHistory}
\alias{SubstrateHistory}
\title{Display the history of a substrate (sampleid)}
\usage{
SubstrateHistory(sampleid, matrix.rda)
}
\arguments{
\item{sampleid}{string}
\item{matrix.rda}{path to rdata file containing the sample matrix}
}
\value{
a dataframe
}
\description{
Display the history of a substrate (sampleid)
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/latex-xtable.R
\name{TabularXtableHeader}
\alias{TabularXtableHeader}
\title{Set xtable header in LaTeX tabular format}
\usage{
TabularXtableHeader(xtobject, names.custom = NULL)
}
\arguments{
\item{xtobject}{xtable object (table)}
\item{names.custom}{Use \code{names.custom} to make more complicated headers, e.g., multiple-row}
}
\value{
character string (with LaTeX escaping)
}
\description{
This function should be used together with \code{booktabs = TRUE}.
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{as.degrees}
\alias{as.degrees}
\title{Convert from radians to degrees}
\usage{
as.degrees(radians)
}
\arguments{
\item{radians}{numeric}
}
\value{
degrees (numeric)
}
\description{
Convert from radians to degrees
}

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{as.radians}
\alias{as.radians}
\title{Convert from degrees to radians}
\usage{
as.radians(degrees)
}
\arguments{
\item{degrees}{numeric}
}
\value{
radians (numeric)
}
\description{
Convert from degrees to radians
}

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/common.R
\name{int2padstr}
\alias{int2padstr}
\title{Create a string of specified width from an integer}
\usage{
int2padstr(ii, pchr, w)
}
\arguments{
\item{ii}{integer or vector of integers}
\item{pchr}{a padding character (e.g., "0")}
\item{w}{width of the return string (an integer)}
}
\value{
a string or a vector of strings
}
\description{
Converts an integer or a vector of integers to a string
of fixed length padded with a specified character (e.g., zeroes).
}

@ -0,0 +1,22 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/numeric.R
\name{is.wholenumber}
\alias{is.wholenumber}
\title{is.wholenumber}
\usage{
is.wholenumber(x, tol = .Machine$double.eps^0.5)
}
\arguments{
\item{x}{number}
\item{tol}{machine's double precision}
}
\value{
logical (TRUE or FALSE)
}
\description{
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).
}

@ -0,0 +1,24 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/chemistry-tools.R
\name{molarity2mass}
\alias{molarity2mass}
\title{Calculate required mass of substance to dissolve}
\usage{
molarity2mass(formulamass, volume, molarity)
}
\arguments{
\item{formulamass}{of the substance (in grams per mole)}
\item{volume}{of the final solution (in liters)}
\item{molarity}{(in moles per liter)}
}
\value{
mass of substance (in grams)
}
\description{
You want to prepare a solution of known molarity and volume of
a particular substance.
This function calculates the required mass to weigh up.
}

@ -0,0 +1,29 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/common.R
\name{numbers2words}
\alias{numbers2words}
\title{numbers2words}
\usage{
numbers2words(x, billion = c("US", "UK"), and = if (billion == "US") "" else
"and")
}
\arguments{
\item{x}{number}
\item{billion}{follow either US or UK usage rules}
\item{and}{follows the choice set in billion arg}
}
\value{
string
}
\description{
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
}

@ -0,0 +1,21 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/numeric.R
\name{roundup}
\alias{roundup}
\title{Round up to the nearest specified interval}
\usage{
roundup(x, nearest = 1000)
}
\arguments{
\item{x}{number}
\item{nearest}{nearest interval, e.g., 5, 10, 100, 1000, etc.}
}
\value{
a number
}
\description{
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
}

@ -0,0 +1,22 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/siunitx.R
\name{siunitx.uncertainty}
\alias{siunitx.uncertainty}
\title{siunitx.uncertainty}
\usage{
siunitx.uncertainty(quantity, uncertainty, digits = 6)
}
\arguments{
\item{quantity}{quantity}
\item{uncertainty}{uncertainty}
\item{digits}{number of digits}
}
\value{
a string suitable for use with siunitx num{} command
}
\description{
Writing number with exponent (such as scientific notation) with uncertainty using siunitx
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{thth2d}
\alias{thth2d}
\title{Calculate d-spacings from 2theta values}
\usage{
thth2d(thth, wavelength = 1.540562)
}
\arguments{
\item{thth}{vector with thth values in degrees}
\item{wavelength}{radiation wavelength in Angstrom}
}
\value{
d-spacings (numeric)
}
\description{
This function applies Bragg's law to calculate d-spacings from thth (n = 1)
}

@ -0,0 +1,21 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/numeric.R
\name{trapz}
\alias{trapz}
\title{Calculate area under a curve}
\usage{
trapz(x, y)
}
\arguments{
\item{x}{vector (of length n)}
\item{y}{vector (of length n)}
}
\value{
vector (of length n - 1)
}
\description{
Numerically calculate area under an arbitrary curve (defined by x, y coord pairs)
using trapezodial integration. See Wikipedia for more info on trapz integration.
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{wavelength2num}
\alias{wavelength2num}
\title{Convert wavelength to wavenumber}
\usage{
wavelength2num(wavelength)
}
\arguments{
\item{wavelength}{number or vector of numbers}
}
\value{
number or vector
}
\description{
Converts wavelength (nm) to wavenumber (cm-1)
Only valid for absolute wavelengths, NOT delta wavelengths (ranges)
http://www.powerstream.com/inverse-cm.htm
}

@ -0,0 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/unit-converters.R
\name{wavenum2length}
\alias{wavenum2length}
\title{Convert wavenumber to wavelength}
\usage{
wavenum2length(wavenumber)
}
\arguments{
\item{wavenumber}{number or vector of numbers}
}
\value{
number ofr vector
}
\description{
Converts wavenumber (cm-1) to wavelength (nm)
Only valid for absolute wavenumbers, NOT delta wavenumbers (ranges)
http://www.powerstream.com/inverse-cm.htm
}

@ -1,16 +0,0 @@
##################################################
############### molarity2mass ####################
##################################################
molarity2mass <- function(formulamass, volume, molarity) {
# Calculates the required mass of
# the substance to be dissolved.
# ARGS: formulamass - formula mass of the substance (in gram per mole)
# volume - volume of the final solution (in liters)
# molarity - molarity (in moles per liter)
# VALUE: mass of substance (in grams)
#
mass <- formulamass * volume * molarity
# Unit check:
# [g * mol-1] * [liter] * [mole * liter-1] = [g]
return(mass)
}

@ -1,16 +0,0 @@
##################################################
#################### nm2eV #######################
##################################################
source(HomeByHost("/home/taha/chepec/chetex/common/R/sunlight/solarconstants.R"))
nm2eV <- function(nm) {
# Converts wavelength in nm to energy in eV
#
sun.constants <- solar.constants()
eV <-
sun.constants["h.eV", "value"] *
1E9 * sun.constants["c", "value"] / nm
return(eV)
}

@ -1,75 +0,0 @@
##################################################
################ numbers2words ###################
##################################################
numbers2words <- function(x, billion = c("US", "UK"), and = if (billion == "US") "" else "and") {
## Description:
## 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, Ontario
## == 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
## Usage:
## numbers2words(number, billion-word, and-or-not)
## Arguments:
## x: number
## billion: follow either US or UK usage rules
## and: follows the choice set in billion arg
## Value:
## Dataframe with the following columns:
## $ sampleid : chr
#
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)
}

@ -1,6 +0,0 @@
# Function that 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
roundup <- function(x, nearest=1000) {
ceiling(max(x+10^-9)/nearest + 1/nearest)*nearest
}

@ -1,38 +0,0 @@
thth2d <- function(thth, wavelength = 1.540562) {
# This function applies Bragg's law to calculate d-spacings from thth (n = 1)
# 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
# Usage:
# thth : vector with thth values in degrees
# wavelength : radiation wavelength in Angstrom
return (wavelength / (2 * sin(as.radians(thth))))
}

@ -1,19 +0,0 @@
#####################################
############# trapz #################
#####################################
trapz <- function(x, y) {
## Description:
## Performs a trapezoidal integration (approximate numerical integration
## of the area under the curve defined by the x and y coordinate pairs.
## See Wikipedia for more info on trapezoidal integration.
## Usage:
## trapz(x, y)
## Arguments:
## x: vector (of length n)
## y: vector (of length n)
## Return value:
## vector of length (n - 1)
#
idx <- 2:length(x)
return (as.double((x[idx] - x[idx - 1]) * (y[idx] + y[idx - 1])) / 2)
}

@ -1,13 +0,0 @@
##################################################
################ wavelength2num ##################
##################################################
wavelength2num <- function(wavelength) {
# Converts wavelength (nm) to wavenumber (cm-1)
# Only valid for absolute wavelengths,
# NOT delta wavelengths (ranges)
# http://www.powerstream.com/inverse-cm.htm
wavenumber <-
10E6 / wavelength
return(wavenumber)
}

@ -1,13 +0,0 @@
##################################################
################ wavenum2length ##################
##################################################
wavenum2length <- function(wavenumber) {
# Converts wavenumber (cm-1) to wavelength (nm)
# Only valid for absolute wavenumbers,
# NOT delta wavenumbers (ranges)
# http://www.powerstream.com/inverse-cm.htm
wavelength <-
10E6 / wavenumber
return(wavelength)
}
Loading…
Cancel
Save