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