Browse Source

Refactored code into a rudimentary R package.

master
Taha Ahmed 5 years ago
parent
commit
e22546cb3c
  1. 12
      .gitignore
  2. 8
      AVS2SHE.R
  3. 14
      Celsius2Kelvin.R
  4. 74
      ConvertRefPot.R
  5. 1
      ConvertRefPot.tex
  6. 48
      ConvertRefPotEC.R
  7. 1
      ConvertRefPotEC.tex
  8. 26
      CountRods.R
  9. 10
      DESCRIPTION
  10. 36
      GenericXtableSetAttributes.R
  11. 14
      Kelvin2Celsius.R
  12. 6
      LoadRData2Variable.R
  13. 30
      LongtableXtableHeader.R
  14. 26
      NAMESPACE
  15. 46
      ProvideSampleId.R
  16. 8
      ProvideSampleId.tex
  17. 18
      R/chemistry-tools.R
  18. 99
      R/common.R
  19. 107
      R/latex-xtable.R
  20. 80
      R/latex.R
  21. 44
      R/numeric.R
  22. 66
      R/samples.R
  23. 102
      R/siunitx.R
  24. 157
      R/unit-converters-electrochemical.R
  25. 139
      R/unit-converters.R
  26. 8
      SHE2AVS.R
  27. 37
      SubstrateHistory.R
  28. 13
      TabularXtableHeader.R
  29. 8
      as.degrees.R
  30. 8
      as.radians.R
  31. 17
      capitalize.R
  32. 21
      common.Rproj
  33. 16
      eV2nm.R
  34. 28
      hms2seconds.R
  35. 21
      int2padstr.R
  36. 5
      is.wholenumber.R
  37. 18
      man/AVS2SHE.Rd
  38. 18
      man/Celsius2Kelvin.Rd
  39. 22
      man/ConvertRefPot.Rd
  40. 26
      man/ConvertRefPotEC.Rd
  41. 42
      man/GenericXtableSetAttributes.Rd
  42. 18
      man/Kelvin2Celsius.Rd
  43. 20
      man/LoadRData2Variable.Rd
  44. 24
      man/LongtableXtableHeader.Rd
  45. 23
      man/ProvideSampleId.Rd
  46. 18
      man/SHE2AVS.Rd
  47. 33
      man/SubfigureGenerator.Rd
  48. 20
      man/SubstrateHistory.Rd
  49. 20
      man/TabularXtableHeader.Rd
  50. 18
      man/as.degrees.Rd
  51. 18
      man/as.radians.Rd
  52. 23
      man/int2padstr.Rd
  53. 22
      man/is.wholenumber.Rd
  54. 24
      man/molarity2mass.Rd
  55. 29
      man/numbers2words.Rd
  56. 21
      man/roundup.Rd
  57. 22
      man/siunitx.uncertainty.Rd
  58. 20
      man/thth2d.Rd
  59. 21
      man/trapz.Rd
  60. 20
      man/wavelength2num.Rd
  61. 20
      man/wavenum2length.Rd
  62. 16
      molarity2mass.R
  63. 16
      nm2eV.R
  64. 75
      numbers2words.R
  65. 6
      roundup.R
  66. 38
      thth2d.R
  67. 19
      trapz.R
  68. 13
      wavelength2num.R
  69. 13
      wavenum2length.R

12
.gitignore

@ -1,7 +1,5 @@
*/
*.info
*.RData
*.Rdeprecated
*.Rhistory
*.Rhistory.save
*.ROLD
.Rbuildignore
.Rproj.user
.Rhistory
.RData
.Ruserdata

8
AVS2SHE.R

@ -1,8 +0,0 @@
##################################################
#################### AVS2SHE #####################
##################################################
AVS2SHE <- function(avs) {
# Converts from absolute vacuum scale (AVS) to SHE scale
she <- -(4.5 + avs)
return(she)
}

14
Celsius2Kelvin.R

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

74
ConvertRefPot.R

@ -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
ConvertRefPot.tex

@ -1 +0,0 @@
Both \Rfun{ConvertRefPotEC()} and \Rfun{ConvertRefPot()} \emph{need} to be rewritten to allow for different concentrations of each reference electrode!

48
ConvertRefPotEC.R

@ -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
ConvertRefPotEC.tex

@ -1 +0,0 @@
Both \Rfun{ConvertRefPotEC()} and \Rfun{ConvertRefPot()} \emph{need} to be rewritten to allow for different concentrations of each reference electrode!

26
CountRods.R

@ -1,26 +0,0 @@
##################################################
################## CountRods #####################
##################################################
CountRods <- function() {
## Description:
##
## Usage:
##
## Arguments:
##
##
##
##
##
##
##
##
##
##
##
## Return value:
##
#
return()
}

10
DESCRIPTION

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

36
GenericXtableSetAttributes.R

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

14
Kelvin2Celsius.R

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

6
LoadRData2Variable.R

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

30
LongtableXtableHeader.R

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

26
NAMESPACE

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

46
ProvideSampleId.R

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

8
ProvideSampleId.tex

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

18
R/chemistry-tools.R

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

99
R/common.R

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

107
R/latex-xtable.R

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

80
SubfigureGenerator.R → R/latex.R

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

44
R/numeric.R

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

66
R/samples.R

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

102
siunitx-exp-uncert.R → R/siunitx.R

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

157
R/unit-converters-electrochemical.R

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

139
R/unit-converters.R

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

8
SHE2AVS.R

@ -1,8 +0,0 @@
##################################################
#################### SHE2AVS #####################
##################################################
SHE2AVS <- function(she) {
# Converts from SHE scale to absolute vacuum (AVS) scale
avs <- -(4.5 + she)
return(avs)
}

37
SubstrateHistory.R

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

13
TabularXtableHeader.R

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

8
as.degrees.R

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

8
as.radians.R

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

17
capitalize.R

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

21
common.Rproj

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

16
eV2nm.R

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

28
hms2seconds.R

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

21
int2padstr.R

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

5
is.wholenumber.R

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

18
man/AVS2SHE.Rd

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

18
man/Celsius2Kelvin.Rd

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

22
man/ConvertRefPot.Rd

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

26
man/ConvertRefPotEC.Rd

@ -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{