[CHNOSZ-commits] r394 - in pkg/CHNOSZ: . R demo inst inst/extdata inst/extdata/OBIGT inst/extdata/adds inst/extdata/thermo man tests/testthat vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 13 15:47:59 CET 2019
Author: jedick
Date: 2019-02-13 15:47:58 +0100 (Wed, 13 Feb 2019)
New Revision: 394
Added:
pkg/CHNOSZ/R/thermo.R
pkg/CHNOSZ/inst/extdata/OBIGT/refs.csv
pkg/CHNOSZ/inst/extdata/adds/
pkg/CHNOSZ/inst/extdata/adds/BZA10.csv
pkg/CHNOSZ/inst/extdata/adds/DLEN67.csv
pkg/CHNOSZ/inst/extdata/adds/RH98_Table15.csv
pkg/CHNOSZ/inst/extdata/adds/SK95.csv
pkg/CHNOSZ/inst/extdata/adds/obigt_check.csv
pkg/CHNOSZ/inst/extdata/thermo/buffer.csv
pkg/CHNOSZ/inst/extdata/thermo/element.csv
pkg/CHNOSZ/inst/extdata/thermo/groups.csv
pkg/CHNOSZ/inst/extdata/thermo/opt.csv
pkg/CHNOSZ/inst/extdata/thermo/protein.csv
pkg/CHNOSZ/man/thermo.Rd
Removed:
pkg/CHNOSZ/data/
pkg/CHNOSZ/inst/extdata/thermo/BZA10.csv
pkg/CHNOSZ/inst/extdata/thermo/DLEN67.csv
pkg/CHNOSZ/inst/extdata/thermo/RH98_Table15.csv
pkg/CHNOSZ/inst/extdata/thermo/SK95.csv
pkg/CHNOSZ/inst/extdata/thermo/obigt_check.csv
pkg/CHNOSZ/man/data.Rd
Modified:
pkg/CHNOSZ/DESCRIPTION
pkg/CHNOSZ/NAMESPACE
pkg/CHNOSZ/R/add.obigt.R
pkg/CHNOSZ/R/add.protein.R
pkg/CHNOSZ/R/affinity.R
pkg/CHNOSZ/R/basis.R
pkg/CHNOSZ/R/berman.R
pkg/CHNOSZ/R/buffer.R
pkg/CHNOSZ/R/findit.R
pkg/CHNOSZ/R/hkf.R
pkg/CHNOSZ/R/info.R
pkg/CHNOSZ/R/makeup.R
pkg/CHNOSZ/R/mosaic.R
pkg/CHNOSZ/R/nonideal.R
pkg/CHNOSZ/R/palply.R
pkg/CHNOSZ/R/protein.info.R
pkg/CHNOSZ/R/species.R
pkg/CHNOSZ/R/subcrt.R
pkg/CHNOSZ/R/swap.basis.R
pkg/CHNOSZ/R/util.affinity.R
pkg/CHNOSZ/R/util.args.R
pkg/CHNOSZ/R/util.data.R
pkg/CHNOSZ/R/util.expression.R
pkg/CHNOSZ/R/util.formula.R
pkg/CHNOSZ/R/util.misc.R
pkg/CHNOSZ/R/util.plot.R
pkg/CHNOSZ/R/util.seq.R
pkg/CHNOSZ/R/util.units.R
pkg/CHNOSZ/R/water.R
pkg/CHNOSZ/R/zzz.R
pkg/CHNOSZ/demo/DEW.R
pkg/CHNOSZ/demo/Shh.R
pkg/CHNOSZ/demo/TCA.R
pkg/CHNOSZ/demo/adenine.R
pkg/CHNOSZ/demo/affinity.R
pkg/CHNOSZ/demo/bugstab.R
pkg/CHNOSZ/demo/copper.R
pkg/CHNOSZ/demo/dehydration.R
pkg/CHNOSZ/demo/glycinate.R
pkg/CHNOSZ/demo/go-IU.R
pkg/CHNOSZ/demo/mosaic.R
pkg/CHNOSZ/demo/protbuff.R
pkg/CHNOSZ/demo/protein.equil.R
pkg/CHNOSZ/demo/sources.R
pkg/CHNOSZ/demo/wjd.R
pkg/CHNOSZ/demo/yeastgfp.R
pkg/CHNOSZ/inst/NEWS
pkg/CHNOSZ/man/EOSregress.Rd
pkg/CHNOSZ/man/NaCl.Rd
pkg/CHNOSZ/man/add.obigt.Rd
pkg/CHNOSZ/man/add.protein.Rd
pkg/CHNOSZ/man/affinity.Rd
pkg/CHNOSZ/man/basis.Rd
pkg/CHNOSZ/man/berman.Rd
pkg/CHNOSZ/man/buffer.Rd
pkg/CHNOSZ/man/diagram.Rd
pkg/CHNOSZ/man/eos.Rd
pkg/CHNOSZ/man/equilibrate.Rd
pkg/CHNOSZ/man/examples.Rd
pkg/CHNOSZ/man/extdata.Rd
pkg/CHNOSZ/man/info.Rd
pkg/CHNOSZ/man/ionize.aa.Rd
pkg/CHNOSZ/man/makeup.Rd
pkg/CHNOSZ/man/mosaic.Rd
pkg/CHNOSZ/man/nonideal.Rd
pkg/CHNOSZ/man/objective.Rd
pkg/CHNOSZ/man/protein.Rd
pkg/CHNOSZ/man/protein.info.Rd
pkg/CHNOSZ/man/revisit.Rd
pkg/CHNOSZ/man/solubility.Rd
pkg/CHNOSZ/man/species.Rd
pkg/CHNOSZ/man/subcrt.Rd
pkg/CHNOSZ/man/swap.basis.Rd
pkg/CHNOSZ/man/util.array.Rd
pkg/CHNOSZ/man/util.data.Rd
pkg/CHNOSZ/man/util.expression.Rd
pkg/CHNOSZ/man/util.fasta.Rd
pkg/CHNOSZ/man/util.formula.Rd
pkg/CHNOSZ/man/util.matrix.Rd
pkg/CHNOSZ/man/util.misc.Rd
pkg/CHNOSZ/man/util.seq.Rd
pkg/CHNOSZ/man/util.units.Rd
pkg/CHNOSZ/man/util.water.Rd
pkg/CHNOSZ/man/water.Rd
pkg/CHNOSZ/man/wjd.Rd
pkg/CHNOSZ/man/yeast.Rd
pkg/CHNOSZ/tests/testthat/test-DEW.R
pkg/CHNOSZ/tests/testthat/test-add.protein.R
pkg/CHNOSZ/tests/testthat/test-affinity.R
pkg/CHNOSZ/tests/testthat/test-basis.R
pkg/CHNOSZ/tests/testthat/test-berman.R
pkg/CHNOSZ/tests/testthat/test-info.R
pkg/CHNOSZ/tests/testthat/test-ionize.aa.R
pkg/CHNOSZ/tests/testthat/test-protein.info.R
pkg/CHNOSZ/tests/testthat/test-recalculate.R
pkg/CHNOSZ/tests/testthat/test-revisit.R
pkg/CHNOSZ/tests/testthat/test-species.R
pkg/CHNOSZ/tests/testthat/test-subcrt.R
pkg/CHNOSZ/tests/testthat/test-swap.basis.R
pkg/CHNOSZ/tests/testthat/test-thermo.R
pkg/CHNOSZ/tests/testthat/test-util.R
pkg/CHNOSZ/tests/testthat/test-util.data.R
pkg/CHNOSZ/tests/testthat/test-util.program.R
pkg/CHNOSZ/vignettes/anintro.Rmd
pkg/CHNOSZ/vignettes/eos-regress.Rmd
pkg/CHNOSZ/vignettes/equilibrium.Rnw
pkg/CHNOSZ/vignettes/equilibrium.lyx
pkg/CHNOSZ/vignettes/hotspring.Rnw
pkg/CHNOSZ/vignettes/hotspring.lyx
pkg/CHNOSZ/vignettes/mklinks.sh
pkg/CHNOSZ/vignettes/obigt.Rmd
Log:
bye-bye data(thermo)
Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/DESCRIPTION 2019-02-13 14:47:58 UTC (rev 394)
@@ -1,6 +1,6 @@
-Date: 2019-02-09
+Date: 2019-02-13
Package: CHNOSZ
-Version: 1.2.0
+Version: 1.2.0-1
Title: Thermodynamic Calculations and Diagrams for Geochemistry
Authors at R: c(
person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),
Modified: pkg/CHNOSZ/NAMESPACE
===================================================================
--- pkg/CHNOSZ/NAMESPACE 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/NAMESPACE 2019-02-13 14:47:58 UTC (rev 394)
@@ -56,7 +56,9 @@
"calculateEpsilon", "calculateQ", "water.DEW", "berman",
"maxdiff", "expect_maxdiff", "bgamma",
# added 20171121 or later
- "dumpdata", "thermo.axis", "solubility", "NaCl"
+ "dumpdata", "thermo.axis", "solubility", "NaCl",
+# added 20190213 or later
+ "CHNOSZ", "thermo", "reset", "obigt"
)
# Load shared objects
Modified: pkg/CHNOSZ/R/add.obigt.R
===================================================================
--- pkg/CHNOSZ/R/add.obigt.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/add.obigt.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -16,7 +16,7 @@
mod.obigt <- function(...) {
# add or modify species in thermo$obigt
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# the names and values are in the arguments
# this works for providing arguments via do.call
args <- list(...)
@@ -71,7 +71,7 @@
# assign to thermo$obigt
thermo$obigt <- rbind(thermo$obigt, newrows)
rownames(thermo$obigt) <- NULL
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
# update ispecies
ntotal <- nrow(thermo$obigt)
ispecies[inew] <- (ntotal-length(inew)+1):ntotal
@@ -89,7 +89,7 @@
message("mod.obigt: no change for ", args$name[iold[i]], "(", state, ")")
else {
thermo$obigt[ispecies[iold[i]], icol] <- args[iold[i], ]
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
message("mod.obigt: updated ", args$name[iold[i]], "(", state, ")")
}
}
@@ -100,7 +100,7 @@
add.obigt <- function(file, species=NULL, force=TRUE, E.units="cal") {
# add/replace entries in thermo$obigt from values saved in a file
# only replace if force==TRUE
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
to1 <- thermo$obigt
id1 <- paste(to1$name,to1$state)
# we match system files with the file suffixes removed (e.g. "CHNOSZ_aq" or "DEW_aq")
@@ -168,9 +168,9 @@
# commit the change
thermo$obigt <- to1
rownames(thermo$obigt) <- 1:nrow(thermo$obigt)
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
message("add.obigt: read ", length(does.exist), " rows; made ",
nexist, " replacements, ", nrow(to2), " additions, units = ", E.units)
- message("add.obigt: use data(thermo) to restore default database")
+ message("add.obigt: use obigt() or reset() to restore default database")
return(invisible(inew))
}
Modified: pkg/CHNOSZ/R/add.protein.R
===================================================================
--- pkg/CHNOSZ/R/add.protein.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/add.protein.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -57,7 +57,7 @@
add.protein <- function(aa) {
# add a properly constructed data frame of
# amino acid counts to thermo$protein
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
if(!identical(colnames(aa), colnames(thermo$protein)))
stop("'aa' does not have the same columns as thermo$protein")
# find any protein IDs that are duplicated
@@ -75,7 +75,7 @@
}
rownames(tp.new) <- NULL
thermo$protein <- tp.new
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
# return the new rownumbers
ip <- pinfo(po)
# make some noise
Modified: pkg/CHNOSZ/R/affinity.R
===================================================================
--- pkg/CHNOSZ/R/affinity.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/affinity.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -52,7 +52,7 @@
args <- c(args, list(sout=sout, exceed.Ttr=exceed.Ttr, exceed.rhomin=exceed.rhomin))
# the species we're given
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
mybasis <- thermo$basis
myspecies <- thermo$species
@@ -82,7 +82,7 @@
# account for protein activities later
resprot <- paste(resnames,"RESIDUE",sep="_")
species(resprot, 0)
- thermo <- get("thermo", "CHNOSZ")
+ thermo <- get("thermo", CHNOSZ)
ires <- match(resprot, thermo$species$name)
}
@@ -97,7 +97,7 @@
message('affinity: loading buffer species')
if(!is.null(thermo$species)) is.species <- 1:nrow(thermo$species) else is.species <- numeric()
is.buffer <- buffer(logK=NULL)
- thermo <- get("thermo", "CHNOSZ")
+ thermo <- get("thermo", CHNOSZ)
is.buff <- numeric()
for(i in 1:length(is.buffer)) is.buff <- c(is.buff,as.numeric(is.buffer[[i]]))
is.only.buffer <- is.buff[!is.buff %in% is.species]
Modified: pkg/CHNOSZ/R/basis.R
===================================================================
--- pkg/CHNOSZ/R/basis.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/basis.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -2,13 +2,13 @@
# set up the basis species of a thermodynamic system
basis <- function(species=NULL, state=NULL, logact=NULL, delete=FALSE) {
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
oldbasis <- thermo$basis
## delete the basis species if requested
if(delete | identical(species, "")) {
thermo$basis <- NULL
thermo$species <- NULL
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
return(invisible(oldbasis))
}
## return the basis definition if requested
@@ -91,7 +91,7 @@
# to add the basis to thermo$obigt
put.basis <- function(ispecies, logact = rep(NA, length(ispecies))) {
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
state <- thermo$obigt$state[ispecies]
# make the basis matrix, revised 20120114
# get the elemental makeup of each species,
@@ -125,7 +125,7 @@
comp <- cbind(as.data.frame(comp), ispecies, logact, state, stringsAsFactors=FALSE)
# ready to assign to the global thermo object
thermo$basis <- comp
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
# remove the species since there's no guarantee the
# new basis includes all their elements
species(delete=TRUE)
@@ -134,7 +134,7 @@
# modify the states or logact values in the existing basis definition
mod.basis <- function(species, state=NULL, logact=NULL) {
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# the basis must be defined
if(is.null(thermo$basis)) stop("basis is not defined")
# loop over each species to modify
@@ -191,7 +191,7 @@
else thermo$basis$logact[ib] <- logact[i]
}
# assign the result to the CHNOSZ environment
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
}
return(thermo$basis)
}
Modified: pkg/CHNOSZ/R/berman.R
===================================================================
--- pkg/CHNOSZ/R/berman.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/berman.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -22,7 +22,7 @@
DS10 <- read.csv(paste0(dir, "/DS10.csv"), as.is=TRUE)
FDM14 <- read.csv(paste0(dir, "/FDM+14.csv"), as.is=TRUE)
BDat17 <- read.csv(paste0(dir, "/BDat17.csv"), as.is=TRUE)
- userfile <- get("thermo")$opt$Berman
+ userfile <- get("thermo", CHNOSZ)$opt$Berman
userfileexists <- FALSE
dat <- rbind(BDat17, FDM14, DS10, JUN92, ZS92, SHD91, Ber90, Ber88)
if(!is.na(userfile)) {
Modified: pkg/CHNOSZ/R/buffer.R
===================================================================
--- pkg/CHNOSZ/R/buffer.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/buffer.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -2,9 +2,9 @@
# Calculate chemical activities of buffered species
# 20061102 jmd
-mod.buffer <- function(name,species=NULL,state=get("thermo")$opt$state,logact=-3) {
+mod.buffer <- function(name,species=NULL,state=thermo()$opt$state,logact=-3) {
# 20071102 add or change a buffer system
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
if(is.null(species)) {
iname <- which(name==thermo$buffers$name)
if(length(iname)>0) species <- thermo$buffers$species[iname]
@@ -21,7 +21,7 @@
if(length(imod)>0) {
if(state[1]=='') {
thermo$buffers <- thermo$buffers[-imod,]
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
message(paste('mod.buffer: removed ',c2s(species),' in ',
c2s(unique(name)),' buffer',sep=''))
} else {
@@ -33,7 +33,7 @@
logact.old <- thermo$buffers$logact[imod]
thermo$buffers$state[imod] <- state
thermo$buffers$logact[imod] <- logact
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
if(identical(state.old,state) & identical(logact.old,logact)) {
message(paste('mod.buffer: nothing changed for ',
c2s(species),' in ',c2s(unique(name)),' buffer',sep=''))
@@ -50,7 +50,7 @@
if(state[1]=='') state <- rep(thermo$opt$state,length.out=ls)
t <- data.frame(name=name,species=species,state=state,logact=logact)
thermo$buffers <- rbind(thermo$buffers,t)
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
message(paste('mod.buffer: added',c2s(unique(name))))
}
return(invisible(thermo$buffers[thermo$buffers$name %in% name,]))
@@ -59,7 +59,7 @@
### unexported functions ###
buffer <- function(logK=NULL,ibasis=NULL,logact.basis=NULL,is.buffer=NULL,balance='PBB') {
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# if logK is NULL load the buffer species
# otherwise perform buffer calculations.
if(is.null(logK)) {
Modified: pkg/CHNOSZ/R/findit.R
===================================================================
--- pkg/CHNOSZ/R/findit.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/findit.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -34,7 +34,7 @@
}
# the initial values of the guesses (if midpoint==FALSE)
- basis <- get("thermo")$basis
+ basis <- get("thermo", CHNOSZ)$basis
# a hack so that we can use pH as a variable
if("pH" %in% names(lims)) {
@@ -224,7 +224,7 @@
for(i in which) {
niter <- length(x$value[[i]])
ylab <- names(x$value)[i]
- if(ylab %in% c(rownames(get("thermo")$basis),"T","P","pH","Eh")) ylab <- axis.label(ylab)
+ if(ylab %in% c(rownames(get("thermo", CHNOSZ)$basis),"T","P","pH","Eh")) ylab <- axis.label(ylab)
# the values
plot(1:niter,x$value[[i]],xlab=xlab,ylab=ylab,...)
lines(1:niter,x$value[[i]])
Modified: pkg/CHNOSZ/R/hkf.R
===================================================================
--- pkg/CHNOSZ/R/hkf.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/hkf.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -27,7 +27,7 @@
# rho - for subcrt() output and g function
# Born functions and epsilon - for HKF calculations
H2O.props <- c(H2O.props, "QBorn", "XBorn", "YBorn", "epsilon")
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
if(grepl("SUPCRT", thermo$opt$water)) {
# using H2O92D.f from SUPCRT92: alpha, daldT, beta - for partial derivatives of omega (g function)
H2O.props <- c(H2O.props, "alpha", "daldT", "beta")
Modified: pkg/CHNOSZ/R/info.R
===================================================================
--- pkg/CHNOSZ/R/info.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/info.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -9,7 +9,7 @@
info <- function(species=NULL, state=NULL, check.it=TRUE) {
## return information for one or more species in thermo$obigt
## if no species are requested, summarize the available data 20101129
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
if(is.null(species)) {
message("info: 'species' is NULL; summarizing information about thermodynamic data...")
message(paste("thermo$obigt has", nrow(thermo$obigt[thermo$obigt$state=="aq", ]), "aqueous,",
@@ -63,7 +63,7 @@
info.text <- function(ispecies) {
# a textual description of species name, formula, source, e.g.
# CO2 [CO2(aq)] (SSW01, SHS89, 11.Oct.07)
- this <- get("thermo")$obigt[ispecies, ]
+ this <- get("thermo", CHNOSZ)$obigt[ispecies, ]
sourcetext <- this$ref1
ref2 <- this$ref2
if(!is.na(ref2)) sourcetext <- paste(sourcetext, ref2, sep=", ")
@@ -78,7 +78,7 @@
# thermo$obigt$[species|abbrv|formula] or NA otherwise
# a match to thermo$obigt$state is also required if 'state' is not NULL
# (first occurence of a match to species is returned otherwise)
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# find matches for species name, abbreviation or formula
matches.species <- thermo$obigt$name==species | thermo$obigt$abbrv==species | thermo$obigt$formula==species
# since thermo$obigt$abbrv contains NAs, convert NA results to FALSE
@@ -101,7 +101,7 @@
eos <- protein.obigt(ip, state=state)
# the real assignment work
nrows <- suppressMessages(mod.obigt(eos))
- thermo <- get("thermo", "CHNOSZ")
+ thermo <- get("thermo", CHNOSZ)
matches.species <- rep(FALSE, nrows)
matches.species[nrows] <- TRUE
} else return(NA)
@@ -168,7 +168,7 @@
info.numeric <- function(ispecies, check.it=TRUE) {
# from a numeric species index in 'ispecies' return the
# thermodynamic properties and equations-of-state parameters
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# if we're called with NA, return an empty row
if(is.na(ispecies)) {
this <- thermo$obigt[1,]
@@ -222,7 +222,7 @@
# returns species indices that have an approximate match of 'species'
# to thermo$obigt$[name|abbrv|formula],
# possibly restricted to a given state
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
if(!is.null(state)) this <- thermo$obigt[thermo$obigt$state==state, ]
else this <- thermo$obigt
# only look for fairly close matches
Modified: pkg/CHNOSZ/R/makeup.R
===================================================================
--- pkg/CHNOSZ/R/makeup.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/makeup.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -48,8 +48,8 @@
# if the formula argument is numeric,
# and if the thermo object is available,
# get the formula of that numbered species from thermo$obigt
- if("CHNOSZ" %in% search()) {
- thermo <- get("thermo", "CHNOSZ")
+ if(exists("CHNOSZ")) {
+ thermo <- get("thermo", CHNOSZ)
if(is.numeric(formula)) formula <- thermo$obigt$formula[formula]
}
# first deal with charge
@@ -76,7 +76,7 @@
# all done with the counting, now apply the multiplier
out <- out * multiplier
# complain if there are any elements that look strange
- if("CHNOSZ" %in% search()) {
+ if(exists("CHNOSZ")) {
are.elements <- names(out) %in% thermo$element$element
if(!all(are.elements)) warning(paste("element(s) not in thermo$element:",
paste(names(out)[!are.elements], collapse=" ") ))
Modified: pkg/CHNOSZ/R/mosaic.R
===================================================================
--- pkg/CHNOSZ/R/mosaic.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/mosaic.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -52,8 +52,8 @@
}
# save starting basis and species definition
- basis0 <- get("thermo")$basis
- species0 <- get("thermo")$species
+ basis0 <- get("thermo", CHNOSZ)$basis
+ species0 <- get("thermo", CHNOSZ)$species
# get species indices of requested basis species
ispecies <- lapply(bases, info)
if(any(is.na(unlist(ispecies)))) stop("one or more of the requested basis species is unavailable")
Modified: pkg/CHNOSZ/R/nonideal.R
===================================================================
--- pkg/CHNOSZ/R/nonideal.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/nonideal.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -3,7 +3,7 @@
# moved to nonideal.R from util.misc.R 20151107
# added Helgeson method 20171012
-nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal) {
+nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=thermo()$opt$nonideal) {
# generate nonideal contributions to thermodynamic properties
# number of species, same length as speciesprops list
# T in Kelvin, same length as nrows of speciespropss
@@ -19,10 +19,10 @@
# we can use this function to change the nonideal method option
if(missing(speciesprops)) {
if(species[1] %in% c("Bdot", "Bdot0", "bgamma", "bgamma0", "Alberty")) {
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
oldnon <- thermo$opt$nonideal
thermo$opt$nonideal <- species[1]
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
message("nonideal: setting nonideal option to use ", mettext(species))
return(invisible(oldnon))
} else stop(species[1], " is not a valid nonideality setting (Bdot, Bdot0, bgamma, bgamma0, or Alberty)")
@@ -93,7 +93,7 @@
Z[i] <- thisZ
}
# get species formulas to assign acirc 20181105
- formula <- get("thermo")$obigt$formula[species]
+ formula <- get("thermo", CHNOSZ)$obigt$formula[species]
if(grepl("Bdot", method)) {
# "ion size paramter" taken from UT_SIZES.REF of HCh package (Shvarov and Bastrakov, 1999),
# based on Table 2.7 of Garrels and Christ, 1965
@@ -132,18 +132,18 @@
for(i in 1:length(species)) {
myprops <- speciesprops[[i]]
# to keep unit activity coefficients of the proton and electron
- if(species[i] == iH & get("thermo")$opt$ideal.H) next
- if(species[i] == ie & get("thermo")$opt$ideal.e) next
+ if(species[i] == iH & get("thermo", CHNOSZ)$opt$ideal.H) next
+ if(species[i] == ie & get("thermo", CHNOSZ)$opt$ideal.e) next
didcharged <- didneutral <- FALSE
# logic for neutral and charged species 20181106
if(Z[i]==0) {
for(j in 1:ncol(myprops)) {
pname <- colnames(myprops)[j]
if(!pname %in% c("G", "H", "S", "Cp")) next
- if(get("thermo")$opt$Setchenow == "bgamma") {
+ if(get("thermo", CHNOSZ)$opt$Setchenow == "bgamma") {
myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma)
didneutral <- TRUE
- } else if(get("thermo")$opt$Setchenow == "bgamma0") {
+ } else if(get("thermo", CHNOSZ)$opt$Setchenow == "bgamma0") {
myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma = 0)
didneutral <- TRUE
}
@@ -167,8 +167,8 @@
else myprops <- cbind(myprops, loggam = Helgeson("loggamma", Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma))
}
if(didneutral) {
- if(get("thermo")$opt$Setchenow == "bgamma") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma))
- else if(get("thermo")$opt$Setchenow == "bgamma0") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma = 0))
+ if(get("thermo", CHNOSZ)$opt$Setchenow == "bgamma") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma))
+ else if(get("thermo", CHNOSZ)$opt$Setchenow == "bgamma0") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma = 0))
}
# save the calculated properties and increment progress counters
speciesprops[[i]] <- myprops
Modified: pkg/CHNOSZ/R/palply.R
===================================================================
--- pkg/CHNOSZ/R/palply.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/palply.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -3,10 +3,10 @@
palply <- function(varlist, X, FUN, ...) {
# a wrapper function to run parLapply if length(X) >= thermo$opt$paramin
# and package 'parallel' is available, otherwise run lapply
- if(length(X) >= get("thermo")$opt$paramin) {
+ if(length(X) >= get("thermo", CHNOSZ)$opt$paramin) {
# Use option mc.cores to choose an appropriate cluster size.
# and set max at 2 for now (per CRAN policies)
- nCores <- min(getOption("mc.cores"), get("thermo")$opt$maxcores)
+ nCores <- min(getOption("mc.cores"), get("thermo", CHNOSZ)$opt$maxcores)
# don't load methods package, to save startup time - ?makeCluster
cl <- parallel::makeCluster(nCores, methods=FALSE)
# export the variables and notify the user
Modified: pkg/CHNOSZ/R/protein.info.R
===================================================================
--- pkg/CHNOSZ/R/protein.info.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/protein.info.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -16,7 +16,7 @@
# character `protein` and `organism`, e.g. 'LYSC', 'CHICK'
# return the row(s) of thermo$protein (possibly per residue) for:
# numeric `protein` (the rownumber itself)
- t_p <- get("thermo")$protein
+ t_p <- get("thermo", CHNOSZ)$protein
if(is.data.frame(protein)) out <- protein
if(is.numeric(protein)) {
# drop NA matches to thermo$protein
@@ -65,7 +65,7 @@
return(pl)
}
-protein.obigt <- function(protein, organism=NULL, state=get("thermo")$opt$state) {
+protein.obigt <- function(protein, organism=NULL, state=thermo()$opt$state) {
# display and return the properties of
# proteins calculated from amino acid composition
aa <- pinfo(pinfo(protein, organism))
@@ -78,7 +78,7 @@
groups <- paste("[", groups, "]", sep="")
# the rownumbers of the groups in thermo$obigt
groups_state <- paste(groups, state)
- obigt <- get("thermo")$obigt
+ obigt <- get("thermo", CHNOSZ)$obigt
obigt_state <- paste(obigt$name, obigt$state)
igroup <- match(groups_state, obigt_state)
# the properties are in columns 8-20 of thermo$obigt
@@ -130,7 +130,7 @@
# what are the coefficients of the basis species in the formation reactions
sb <- species.basis(pf)
# calculate ionization states if H+ is a basis species
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
iHplus <- match("H+", rownames(thermo$basis))
if(!is.na(iHplus)) {
pH <- -thermo$basis$logact[iHplus]
@@ -163,7 +163,7 @@
pname <- paste(aa$protein, aa$organism, sep="_")
plength <- protein.length(aa)
# use thermo$basis to decide whether to ionize the proteins
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
ionize.it <- FALSE
iword <- "nonionized"
bmat <- basis.elements()
Modified: pkg/CHNOSZ/R/species.R
===================================================================
--- pkg/CHNOSZ/R/species.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/species.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -6,7 +6,7 @@
# 20080925 default quiet=TRUE 20101003 default quiet=FALSE
# 20120128 remove 'quiet' argument (messages can be hidden with suppressMessages())
# 20120523 return thermo$species instead of rownumbers therein, and remove message showing thermo$species
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
## argument processing
# we can't deal with NA species
if(identical(species, NA)) {
@@ -19,7 +19,7 @@
# delete the entire definition if requested
if(is.null(species)) {
thermo$species <- NULL
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
return(thermo$species)
}
# from here we're trying to delete already defined species
@@ -40,7 +40,7 @@
thermo$species <- thermo$species[-isp,]
if(nrow(thermo$species)==0) thermo$species <- NULL
else rownames(thermo$species) <- 1:nrow(thermo$species)
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
}
return(thermo$species)
}
@@ -75,7 +75,7 @@
# look for species in thermo$obigt
iobigt <- suppressMessages(info(species, state))
# since that could have updated thermo$obigt (with proteins), re-read thermo
- thermo <- get("thermo", "CHNOSZ")
+ thermo <- get("thermo", CHNOSZ)
# check if we got all the species
ina <- is.na(iobigt)
if(any(ina)) stop(paste("species not available:", paste(species[ina], collapse=" ")))
@@ -156,7 +156,7 @@
}
}
}
- assign("thermo", thermo, "CHNOSZ")
+ assign("thermo", thermo, CHNOSZ)
# return the new species definition or the index(es) of affected species
if(index.return) return(ispecies)
else return(thermo$species)
@@ -165,7 +165,7 @@
### unexported functions ###
# to retrieve the coefficients of reactions to form the species from the basis species
-species.basis <- function(species=get("thermo")$species$ispecies) {
+species.basis <- function(species=get("thermo", CHNOSZ)$species$ispecies) {
# current basis elements
bmat <- basis.elements()
tbmat <- t(bmat)
Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/subcrt.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -109,7 +109,7 @@
}
# get species information
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
# pre-20110808, we sent numeric species argument through info() to
# get species name and state(s)
# but why slow things down if we already have a species index?
@@ -133,7 +133,7 @@
if(!si %in% 1:nrow(thermo$obigt)) stop(paste(species[i], "is not a row number of thermo$obigt"))
}
# that could have the side-effect of adding a protein; re-read thermo
- thermo <- get("thermo", "CHNOSZ")
+ thermo <- get("thermo", CHNOSZ)
if(is.na(si[1])) stop('no info found for ',species[i],' ',state[i])
if(!is.null(state[i])) is.cr <- state[i]=='cr' else is.cr <- FALSE
if(thermo$obigt$state[si[1]]=='cr' & (is.null(state[i]) | is.cr)) {
Modified: pkg/CHNOSZ/R/swap.basis.R
===================================================================
--- pkg/CHNOSZ/R/swap.basis.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/swap.basis.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -6,13 +6,13 @@
#source("basis.R")
# return the current basis elements
-basis.elements <- function(basis = get("thermo")$basis) {
+basis.elements <- function(basis = thermo()$basis) {
if(is.null(basis)) stop("basis species are not defined")
return(as.matrix(basis[, 1:nrow(basis), drop=FALSE]))
}
# calculate chemical potentials of elements from logarithms of activity of basis species
-element.mu <- function(basis = get("thermo")$basis, T = 25) {
+element.mu <- function(basis = thermo()$basis, T = 25) {
# matrix part of the basis definition
basis.mat <- basis.elements(basis)
# the standard Gibbs energies of the basis species
@@ -29,7 +29,7 @@
}
# calculate logarithms of activity of basis species from chemical potentials of elements
-basis.logact <- function(emu, basis = get("thermo")$basis, T = 25) {
+basis.logact <- function(emu, basis = thermo()$basis, T = 25) {
# matrix part of the basis definition
basis.mat <- basis.elements(basis)
# elements in emu can't be less than the number in the basis
@@ -60,7 +60,7 @@
# character: first look for formula of basis species
ib <- match(species, rownames(basis))
# if that doesn't work, look for name of basis species
- if(is.na(ib)) ib <- match(species, get("thermo")$obigt$name[basis$ispecies])
+ if(is.na(ib)) ib <- match(species, get("thermo", CHNOSZ)$obigt$name[basis$ispecies])
}
return(ib)
}
@@ -68,7 +68,7 @@
# swap in one basis species for another
swap.basis <- function(species, species2, T = 25) {
# before we do anything, remember the old basis and species definitions
- oldbasis <- get("thermo")$basis
+ oldbasis <- get("thermo", CHNOSZ)$basis
ts <- species()
if(is.null(oldbasis))
stop("swapping basis species requires an existing basis definition")
@@ -111,7 +111,7 @@
species(delete=TRUE)
if(!is.null(ts)) {
suppressMessages(species(ts$ispecies))
- suppressMessages(species(1:nrow(get("thermo")$species), ts$logact))
+ suppressMessages(species(1:nrow(get("thermo", CHNOSZ)$species), ts$logact))
}
# all done, return the new basis definition
return(mb)
Copied: pkg/CHNOSZ/R/thermo.R (from rev 393, pkg/CHNOSZ/data/thermo.R)
===================================================================
--- pkg/CHNOSZ/R/thermo.R (rev 0)
+++ pkg/CHNOSZ/R/thermo.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -0,0 +1,87 @@
+# CHNOSZ/data/thermo.R
+# create or restore, and access the 'thermo' data object
+
+# 20190213: move from data/thermo.R to R/thermo.R
+# --> invocation changes from data(thermo) to reset()
+# --> invocation changes from data(OBIGT) to obigt()
+
+reset <- function() {
+ # create thermo list
+ thermodir <- system.file("extdata/thermo/", package="CHNOSZ")
+ thermo <- list(
+ # as.is: keep character values as character and not factor
+ opt = as.list(read.csv(file.path(thermodir, "opt.csv"), as.is=TRUE)),
+ element = read.csv(file.path(thermodir, "element.csv"), as.is=1:3),
+ obigt = NULL,
+ refs = NULL,
+ buffers = read.csv(file.path(thermodir, "buffer.csv"), as.is=1:3),
+ protein = read.csv(file.path(thermodir, "protein.csv"), as.is=1:4),
+ groups = read.csv(file.path(thermodir, "groups.csv"), row.names=1, check.names=FALSE),
+ basis = NULL,
+ species = NULL,
+ opar = NULL
+ )
+ # give a summary of what we are doing
+ if(!"thermo" %in% ls(CHNOSZ)) message("reset: creating \"thermo\" object")
+ else message("reset: resetting \"thermo\" object")
+ # place thermo in CHNOSZ environment
+ assign("thermo", thermo, CHNOSZ)
+ # run obigt() to add the thermodynamic data
+ obigt()
+}
+
+# load default thermodynamic data (OBIGT) in thermo
+obigt <- function() {
+ # we only work if thermo is already in the CHNOSZ environment
+ if(!"thermo" %in% ls(CHNOSZ)) stop("The CHNOSZ environment doesn't have a \"thermo\" object. Try running reset()")
+ # create obigt data frame
+ sources_aq <- paste0(c("H2O", "inorganic", "organic", "biotic"), "_aq")
+ sources_cr <- paste0(c("inorganic", "organic", "Berman"), "_cr")
+ sources_liq <- paste0(c("organic"), "_liq")
+ sources_gas <- paste0(c("inorganic", "organic"), "_gas")
+ sources <- c(sources_aq, sources_cr, sources_liq, sources_gas)
+ OBIGTdir <- system.file("extdata/OBIGT/", package="CHNOSZ")
+ # need explicit "/" for Windows
+ sourcefiles <- paste0(OBIGTdir, "/", c(sources_aq, sources_cr, sources_liq, sources_gas), ".csv")
+ sourcefiles[!sources=="Berman_cr"] <- paste0(sourcefiles[!sources=="Berman_cr"], ".xz")
+ datalist <- lapply(sourcefiles, read.csv, as.is=TRUE)
+ obigt <- do.call(rbind, datalist)
+ # also read references file
+ refs <- read.csv(file.path(OBIGTdir, "refs.csv"), as.is=TRUE)
+ # get thermo from CHNOSZ environment
+ thermo <- get("thermo", CHNOSZ)
+ # set obigt and refs
+ thermo$obigt <- obigt
+ thermo$refs <- refs
+ # place modified thermo in CHNOSZ environment
+ assign("thermo", thermo, CHNOSZ)
+ # give a summary of some of the data
+ message(paste("obigt: loading default database with",
+ nrow(thermo$obigt[thermo$obigt$state=="aq",]),
+ "aqueous,", nrow(thermo$obigt), "total species"))
+ # warn if there are duplicated species
+ idup <- duplicated(paste(thermo$obigt$name, thermo$obigt$state))
+ if(any(idup)) warning("obigt: duplicated species: ",
+ paste(thermo$obigt$name[idup], "(", thermo$obigt$state[idup], ")", sep="", collapse=" "))
+}
+
+# a function to access or modify the thermo object 20190214
+thermo <- function(...) {
+ args <- list(...)
+ # get the object
+ thermo <- get("thermo", CHNOSZ)
+ if(length(args) > 0) {
+ # assign into the object
+ slots <- names(args)
+ for(i in 1:length(slots)) {
+ # parse the name of the slot
+ names <- strsplit(slots[i], "$", fixed=TRUE)[[1]]
+ if(length(names) == 1) thermo[[names]] <- args[[i]]
+ if(length(names) == 2) thermo[[names[1]]][[names[2]]] <- args[[i]]
+ }
+ assign("thermo", thermo, CHNOSZ)
+ } else {
+ # return the object
+ thermo
+ }
+}
Modified: pkg/CHNOSZ/R/util.affinity.R
===================================================================
--- pkg/CHNOSZ/R/util.affinity.R 2019-02-09 10:49:34 UTC (rev 393)
+++ pkg/CHNOSZ/R/util.affinity.R 2019-02-13 14:47:58 UTC (rev 394)
@@ -40,7 +40,7 @@
mybasis <- basis()
nbasis <- nrow(mybasis)
## species definition / number of species
- myspecies <- get("thermo")$species
+ myspecies <- get("thermo", CHNOSZ)$species
if(is.character(what)) {
if(is.null(myspecies)) stop('species properties requested, but species have not been defined')
nspecies <- nrow(myspecies)
@@ -244,7 +244,7 @@
# over which to calculate logQ, logK and affinity
# the names should be T, P, IS and names of basis species
# (or pH, pe, Eh)
- thermo <- get("thermo")
+ thermo <- get("thermo", CHNOSZ)
## inputs are like c(T1,T2,res)
# and outputs are like seq(T1,T2,length.out=res)
# unless transect: do the variables specify a transect? 20090627
Modified: pkg/CHNOSZ/R/util.args.R
===================================================================
--- pkg/CHNOSZ/R/util.args.R 2019-02-09 10:49:34 UTC (rev 393)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/chnosz -r 394
More information about the CHNOSZ-commits
mailing list