[CHNOSZ-commits] r542 - in pkg/CHNOSZ: . R demo inst inst/extdata/Berman/testing inst/extdata/OBIGT inst/extdata/adds inst/extdata/supcrt man tests/testthat vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 4 06:53:42 CEST 2020
Author: jedick
Date: 2020-07-04 06:53:42 +0200 (Sat, 04 Jul 2020)
New Revision: 542
Added:
pkg/CHNOSZ/R/add.OBIGT.R
pkg/CHNOSZ/inst/extdata/Berman/testing/BA96_OBIGT.csv
pkg/CHNOSZ/inst/extdata/adds/OBIGT_check.csv
pkg/CHNOSZ/man/add.OBIGT.Rd
pkg/CHNOSZ/vignettes/OBIGT.Rmd
pkg/CHNOSZ/vignettes/OBIGT.bib
Removed:
pkg/CHNOSZ/R/add.obigt.R
pkg/CHNOSZ/inst/extdata/Berman/testing/BA96_obigt.csv
pkg/CHNOSZ/inst/extdata/adds/obigt_check.csv
pkg/CHNOSZ/man/add.obigt.Rd
pkg/CHNOSZ/vignettes/obigt.Rmd
pkg/CHNOSZ/vignettes/obigt.bib
Modified:
pkg/CHNOSZ/DESCRIPTION
pkg/CHNOSZ/NAMESPACE
pkg/CHNOSZ/R/basis.R
pkg/CHNOSZ/R/berman.R
pkg/CHNOSZ/R/cgl.R
pkg/CHNOSZ/R/equilibrate.R
pkg/CHNOSZ/R/examples.R
pkg/CHNOSZ/R/hkf.R
pkg/CHNOSZ/R/info.R
pkg/CHNOSZ/R/ionize.aa.R
pkg/CHNOSZ/R/makeup.R
pkg/CHNOSZ/R/nonideal.R
pkg/CHNOSZ/R/protein.info.R
pkg/CHNOSZ/R/retrieve.R
pkg/CHNOSZ/R/species.R
pkg/CHNOSZ/R/subcrt.R
pkg/CHNOSZ/R/swap.basis.R
pkg/CHNOSZ/R/thermo.R
pkg/CHNOSZ/R/util.data.R
pkg/CHNOSZ/R/util.formula.R
pkg/CHNOSZ/R/util.misc.R
pkg/CHNOSZ/R/util.seq.R
pkg/CHNOSZ/R/water.R
pkg/CHNOSZ/demo/AkDi.R
pkg/CHNOSZ/demo/DEW.R
pkg/CHNOSZ/demo/NaCl.R
pkg/CHNOSZ/demo/Shh.R
pkg/CHNOSZ/demo/adenine.R
pkg/CHNOSZ/demo/affinity.R
pkg/CHNOSZ/demo/aluminum.R
pkg/CHNOSZ/demo/bugstab.R
pkg/CHNOSZ/demo/copper.R
pkg/CHNOSZ/demo/dehydration.R
pkg/CHNOSZ/demo/glycinate.R
pkg/CHNOSZ/demo/mosaic.R
pkg/CHNOSZ/demo/protein.equil.R
pkg/CHNOSZ/demo/sources.R
pkg/CHNOSZ/inst/CHECKLIST
pkg/CHNOSZ/inst/NEWS
pkg/CHNOSZ/inst/extdata/OBIGT/refs.csv
pkg/CHNOSZ/inst/extdata/supcrt/compare.R
pkg/CHNOSZ/man/CHNOSZ-package.Rd
pkg/CHNOSZ/man/EOSregress.Rd
pkg/CHNOSZ/man/affinity.Rd
pkg/CHNOSZ/man/basis.Rd
pkg/CHNOSZ/man/berman.Rd
pkg/CHNOSZ/man/eos.Rd
pkg/CHNOSZ/man/extdata.Rd
pkg/CHNOSZ/man/info.Rd
pkg/CHNOSZ/man/makeup.Rd
pkg/CHNOSZ/man/protein.Rd
pkg/CHNOSZ/man/protein.info.Rd
pkg/CHNOSZ/man/retrieve.Rd
pkg/CHNOSZ/man/species.Rd
pkg/CHNOSZ/man/subcrt.Rd
pkg/CHNOSZ/man/swap.basis.Rd
pkg/CHNOSZ/man/thermo.Rd
pkg/CHNOSZ/man/util.data.Rd
pkg/CHNOSZ/man/util.formula.Rd
pkg/CHNOSZ/man/util.misc.Rd
pkg/CHNOSZ/man/wjd.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-eos.R
pkg/CHNOSZ/tests/testthat/test-info.R
pkg/CHNOSZ/tests/testthat/test-ionize.aa.R
pkg/CHNOSZ/tests/testthat/test-makeup.R
pkg/CHNOSZ/tests/testthat/test-protein.info.R
pkg/CHNOSZ/tests/testthat/test-recalculate.R
pkg/CHNOSZ/tests/testthat/test-retrieve.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-thermo.R
pkg/CHNOSZ/tests/testthat/test-util.R
pkg/CHNOSZ/tests/testthat/test-util.data.R
pkg/CHNOSZ/vignettes/.install_extras
pkg/CHNOSZ/vignettes/anintro.Rmd
pkg/CHNOSZ/vignettes/eos-regress.Rmd
pkg/CHNOSZ/vignettes/equilibrium.Rnw
pkg/CHNOSZ/vignettes/equilibrium.lyx
pkg/CHNOSZ/vignettes/mklinks.sh
Log:
Change obigt to OBIGT everywhere
Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/DESCRIPTION 2020-07-04 04:53:42 UTC (rev 542)
@@ -1,6 +1,6 @@
Date: 2020-07-04
Package: CHNOSZ
-Version: 1.3.6-16
+Version: 1.3.6-17
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 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/NAMESPACE 2020-07-04 04:53:42 UTC (rev 542)
@@ -11,12 +11,12 @@
"pinfo", "protein.length", "protein.formula",
"read.fasta", "protein.basis", "add.protein",
"unitize", "revisit", "seq2aa", "findit",
- "thermo.refs", "mod.obigt", "today",
+ "thermo.refs", "mod.OBIGT", "today",
# examples
"examples", "demos", "mtitle",
"list2array", "slice", "dimSums", "slice.affinity",
"def2gi", "read.blast", "id.blast",
- "add.obigt", "RH2obigt",
+ "add.OBIGT", "RH2OBIGT",
"expr.property", "expr.units",
"mass", "entropy", "GHS", "water",
"i2A", "invertible.combs",
@@ -24,7 +24,7 @@
"count.aa", "nucleic.complement", "nucleic.formula",
"rho.IAPWS95", "IAPWS95", "water.AW90", "WP02.auxiliary", "water.IAPWS95",
"getrank", "parent", "sciname", "allparents", "getnodes", "getnames",
- "protein.obigt", "hkf", "cgl", "which.pmax",
+ "protein.OBIGT", "hkf", "cgl", "which.pmax",
"equil.boltzmann", "equil.reaction", "find.tp",
"ionize.aa", "MP90.cp", "aasum",
"qqr", "RMSD", "CVRMSD", "spearman", "DGmix", "DDGmix", "DGtr",
@@ -42,7 +42,7 @@
"count.elements",
# (no other functions are used in the tests)
# other exported functions that are not used above
- "write.blast", "checkEOS", "checkGHS", "check.obigt",
+ "write.blast", "checkEOS", "checkGHS", "check.OBIGT",
"V_s_var", "Cp_s_var",
"DGinf", "SD", "pearson", "shannon", "CV", "logact",
"EOSlab", "EOScalc",
@@ -56,7 +56,7 @@
# added 20171121 or later
"dumpdata", "thermo.axis", "solubility", "NaCl",
# added 20190213 or later
- "CHNOSZ", "thermo", "reset", "obigt", "retrieve", "AkDi", "moles",
+ "CHNOSZ", "thermo", "reset", "OBIGT", "retrieve", "AkDi", "moles",
"lNaCl", "lS", "lT", "lP", "lTP", "lex"
)
Copied: pkg/CHNOSZ/R/add.OBIGT.R (from rev 541, pkg/CHNOSZ/R/add.obigt.R)
===================================================================
--- pkg/CHNOSZ/R/add.OBIGT.R (rev 0)
+++ pkg/CHNOSZ/R/add.OBIGT.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -0,0 +1,181 @@
+# CHNOSZ/add.OBIGT.R
+# add or change entries in the thermodynamic database
+
+## if this file is interactively sourced, the following are also needed to provide unexported functions:
+#source("info.R")
+
+today <- function() {
+ # write today's date in the format used in SUPCRT data files
+ # e.g. 13.May.12 for 2012-05-13
+ t <- date()
+ tt <- unlist(strsplit(t, " "))
+ # for single-digit days there is an extra space
+ tt <- tt[!tt==""]
+ tday <- tt[3]
+ tmonth <- tt[2]
+ tyear <- substr(tt[5], start=3, stop=4)
+ return(paste(tday, tmonth, tyear, sep="."))
+}
+
+mod.OBIGT <- function(...) {
+ # add or modify species in thermo$OBIGT
+ thermo <- get("thermo", CHNOSZ)
+ # the names and values are in the arguments
+ # this works for providing arguments via do.call
+ args <- list(...)
+ # this is needed if we are called with a list as the actual argument
+ if(is.list(args[[1]])) args <- args[[1]]
+ if(length(args) < 2) stop("please supply at least a species name and a property to update")
+ if(is.null(names(args))) stop("all arguments after the first should be named")
+ if(any(tail(nchar(names(args)), -1)==0)) stop("all arguments after the first should be named")
+ # if the first argument is numeric, it's the species index
+ if(is.numeric(args[[1]][1])) {
+ ispecies <- args[[1]]
+ } else {
+ # if the name of the first argument is missing, assume it's the species name
+ if(names(args)[1]=="") names(args)[1] <- "name"
+ # search for this species, use check.protein=FALSE to avoid infinite loop when adding proteins
+ # and suppressMessages to not show messages about matches of this name to other states
+ if("state" %in% names(args)) ispecies <- suppressMessages(mapply(info.character,
+ species=args$name, state=args$state, check.protein=FALSE, SIMPLIFY=TRUE, USE.NAMES=FALSE))
+ else ispecies <- suppressMessages(mapply(info.character,
+ species=args$name, check.protein=FALSE, SIMPLIFY=TRUE, USE.NAMES=FALSE))
+ }
+ # the column names of thermo$OBIGT, split at the "."
+ cnames <- c(do.call(rbind, strsplit(colnames(thermo$OBIGT), ".", fixed=TRUE)), colnames(thermo$OBIGT))
+ # the columns we are updating
+ icol <- match(names(args), cnames)
+ if(any(is.na(icol))) stop(paste("properties not in thermo$OBIGT:", paste(names(args)[is.na(icol)], collapse=" ")) )
+ # the column numbers for properties that matched after the split
+ icol[icol > 42] <- icol[icol > 42] - 42
+ icol[icol > 21] <- icol[icol > 21] - 21
+ # which species are new and which are old
+ inew <- which(is.na(ispecies))
+ iold <- which(!is.na(ispecies))
+ # the arguments as data frame
+ args <- data.frame(args, stringsAsFactors=FALSE)
+ if(length(inew) > 0) {
+ # the right number of blank rows of thermo$OBIGT
+ newrows <- thermo$OBIGT[1:length(inew), ]
+ # if we don't know something it's NA
+ newrows[] <- NA
+ # put in a default state
+ newrows$state <- thermo$opt$state
+ # the formula defaults to the name
+ newrows$formula <- args$name[inew]
+ # the units should also be set 20190530
+ newrows$E_units <- thermo$opt$E.units
+ # fill in the columns
+ newrows[, icol] <- args[inew, ]
+ # now check the formulas
+ e <- tryCatch(makeup(newrows$formula), error=function(e) e)
+ if(inherits(e, "error")) {
+ warning("please supply a valid chemical formula as the species name or in the 'formula' argument")
+ # transmit the error from makeup
+ stop(e)
+ }
+ # for aqueous species, supply a value for Z if it is missing, otherwise NA triggers AkDi model 20190224
+ isaq <- newrows$state == "aq"
+ if(any(isaq)) {
+ mnrf <- makeup(newrows$formula)
+ if(nrow(newrows)==1) mnrf <- list(mnrf)
+ Z <- sapply(mnrf, "[", "Z")
+ Z[is.na(Z)] <- 0
+ newrows$z.T[isaq] <- Z[isaq]
+ }
+ # assign to thermo$OBIGT
+ thermo$OBIGT <- rbind(thermo$OBIGT, newrows)
+ rownames(thermo$OBIGT) <- NULL
+ assign("thermo", thermo, CHNOSZ)
+ # update ispecies
+ ntotal <- nrow(thermo$OBIGT)
+ ispecies[inew] <- (ntotal-length(inew)+1):ntotal
+ # inform user
+ message(paste("mod.OBIGT: added ", newrows$name, "(", newrows$state, ")", " with energy units of ", newrows$E_units, sep="", collapse="\n"))
+ }
+ if(length(iold) > 0) {
+ # loop over species
+ for(i in 1:length(iold)) {
+ # the old values and the state
+ oldprop <- thermo$OBIGT[ispecies[iold[i]], icol]
+ state <- thermo$OBIGT$state[ispecies[iold[i]]]
+ # tell user if they're the same, otherwise update the data entry
+ if(isTRUE(all.equal(oldprop, args[iold[i], ], check.attributes=FALSE)))
+ 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)
+ message("mod.OBIGT: updated ", args$name[iold[i]], "(", state, ")")
+ }
+ }
+ }
+ return(ispecies)
+}
+
+add.OBIGT <- function(file, species=NULL, force=TRUE) {
+ # add/replace entries in thermo$OBIGT from values saved in a file
+ # only replace if force==TRUE
+ thermo <- get("thermo", CHNOSZ)
+ to1 <- thermo$OBIGT
+ id1 <- paste(to1$name,to1$state)
+ # we match system files with the file suffixes (.csv) removed
+ sysfiles <- dir(system.file("extdata/OBIGT/", package="CHNOSZ"))
+ sysnosuffix <- sapply(strsplit(sysfiles, "\\."), "[", 1)
+ isys <- match(file, sysnosuffix)
+ if(!is.na(isys)) file <- system.file(paste0("extdata/OBIGT/", sysfiles[isys]), package="CHNOSZ")
+# else {
+# # we also match single system files with the state suffix removed
+# # (e.g. "DEW" for "DEW_aq", but not "organic" because we have "organic_aq", "organic_cr", etc.)
+# sysnostate <- sapply(strsplit(sysnosuffix, "_"), "[", 1)
+# isys <- which(file==sysnostate)
+# if(length(isys)==1) file <- system.file(paste0("extdata/OBIGT/", sysfiles[isys]), package="CHNOSZ")
+# }
+ # read data from the file
+ to2 <- read.csv(file, as.is=TRUE)
+ # add E_units column if it's missing 20190529
+ if(!"E_units" %in% colnames(to2)) to2 <- data.frame(to2[, 1:7], E_units = "cal", to2[, 8:20], stringsAsFactors = FALSE)
+ Etxt <- paste(unique(to2$E_units), collapse = " and ")
+ # load only selected species if requested
+ if(!is.null(species)) {
+ idat <- match(species, to2$name)
+ ina <- is.na(idat)
+ if(!any(ina)) to2 <- to2[idat, ]
+ else stop(paste("file", file, "doesn't have", paste(species[ina], collapse=", ")))
+ }
+ id2 <- paste(to2$name,to2$state)
+ # check if the data is compatible with thermo$OBIGT
+ tr <- tryCatch(rbind(to1, to2), error = identity)
+ if(inherits(tr, "error")) stop(paste(file, "is not compatible with thermo$OBIGT data table."))
+ # match the new species to existing ones
+ does.exist <- id2 %in% id1
+ ispecies.exist <- na.omit(match(id2, id1))
+ nexist <- sum(does.exist)
+ # keep track of the species we've added
+ inew <- numeric()
+ if(force) {
+ # replace existing entries
+ if(nexist > 0) {
+ to1[ispecies.exist, ] <- to2[does.exist, ]
+ to2 <- to2[!does.exist, ]
+ inew <- c(inew, ispecies.exist)
+ }
+ } else {
+ # ignore any new entries that already exist
+ to2 <- to2[!does.exist, ]
+ nexist <- 0
+ }
+ # add new entries
+ if(nrow(to2) > 0) {
+ to1 <- rbind(to1, to2)
+ inew <- c(inew, (length(id1)+1):nrow(to1))
+ }
+ # commit the change
+ thermo$OBIGT <- to1
+ rownames(thermo$OBIGT) <- 1:nrow(thermo$OBIGT)
+ assign("thermo", thermo, CHNOSZ)
+ # give the user a message
+ message("add.OBIGT: read ", length(does.exist), " rows; made ",
+ nexist, " replacements, ", nrow(to2), " additions [energy units: ", Etxt, "]")
+ #message("add.OBIGT: use OBIGT() or reset() to restore default database")
+ return(invisible(inew))
+}
Deleted: pkg/CHNOSZ/R/add.obigt.R
===================================================================
--- pkg/CHNOSZ/R/add.obigt.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/add.obigt.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -1,181 +0,0 @@
-# CHNOSZ/add.obigt.R
-# add or change entries in the thermodynamic database
-
-## if this file is interactively sourced, the following are also needed to provide unexported functions:
-#source("info.R")
-
-today <- function() {
- # write today's date in the format used in SUPCRT data files
- # e.g. 13.May.12 for 2012-05-13
- t <- date()
- tt <- unlist(strsplit(t, " "))
- # for single-digit days there is an extra space
- tt <- tt[!tt==""]
- tday <- tt[3]
- tmonth <- tt[2]
- tyear <- substr(tt[5], start=3, stop=4)
- return(paste(tday, tmonth, tyear, sep="."))
-}
-
-mod.obigt <- function(...) {
- # add or modify species in thermo$obigt
- thermo <- get("thermo", CHNOSZ)
- # the names and values are in the arguments
- # this works for providing arguments via do.call
- args <- list(...)
- # this is needed if we are called with a list as the actual argument
- if(is.list(args[[1]])) args <- args[[1]]
- if(length(args) < 2) stop("please supply at least a species name and a property to update")
- if(is.null(names(args))) stop("all arguments after the first should be named")
- if(any(tail(nchar(names(args)), -1)==0)) stop("all arguments after the first should be named")
- # if the first argument is numeric, it's the species index
- if(is.numeric(args[[1]][1])) {
- ispecies <- args[[1]]
- } else {
- # if the name of the first argument is missing, assume it's the species name
- if(names(args)[1]=="") names(args)[1] <- "name"
- # search for this species, use check.protein=FALSE to avoid infinite loop when adding proteins
- # and suppressMessages to not show messages about matches of this name to other states
- if("state" %in% names(args)) ispecies <- suppressMessages(mapply(info.character,
- species=args$name, state=args$state, check.protein=FALSE, SIMPLIFY=TRUE, USE.NAMES=FALSE))
- else ispecies <- suppressMessages(mapply(info.character,
- species=args$name, check.protein=FALSE, SIMPLIFY=TRUE, USE.NAMES=FALSE))
- }
- # the column names of thermo$obigt, split at the "."
- cnames <- c(do.call(rbind, strsplit(colnames(thermo$obigt), ".", fixed=TRUE)), colnames(thermo$obigt))
- # the columns we are updating
- icol <- match(names(args), cnames)
- if(any(is.na(icol))) stop(paste("properties not in thermo$obigt:", paste(names(args)[is.na(icol)], collapse=" ")) )
- # the column numbers for properties that matched after the split
- icol[icol > 42] <- icol[icol > 42] - 42
- icol[icol > 21] <- icol[icol > 21] - 21
- # which species are new and which are old
- inew <- which(is.na(ispecies))
- iold <- which(!is.na(ispecies))
- # the arguments as data frame
- args <- data.frame(args, stringsAsFactors=FALSE)
- if(length(inew) > 0) {
- # the right number of blank rows of thermo$obigt
- newrows <- thermo$obigt[1:length(inew), ]
- # if we don't know something it's NA
- newrows[] <- NA
- # put in a default state
- newrows$state <- thermo$opt$state
- # the formula defaults to the name
- newrows$formula <- args$name[inew]
- # the units should also be set 20190530
- newrows$E_units <- thermo$opt$E.units
- # fill in the columns
- newrows[, icol] <- args[inew, ]
- # now check the formulas
- e <- tryCatch(makeup(newrows$formula), error=function(e) e)
- if(inherits(e, "error")) {
- warning("please supply a valid chemical formula as the species name or in the 'formula' argument")
- # transmit the error from makeup
- stop(e)
- }
- # for aqueous species, supply a value for Z if it is missing, otherwise NA triggers AkDi model 20190224
- isaq <- newrows$state == "aq"
- if(any(isaq)) {
- mnrf <- makeup(newrows$formula)
- if(nrow(newrows)==1) mnrf <- list(mnrf)
- Z <- sapply(mnrf, "[", "Z")
- Z[is.na(Z)] <- 0
- newrows$z.T[isaq] <- Z[isaq]
- }
- # assign to thermo$obigt
- thermo$obigt <- rbind(thermo$obigt, newrows)
- rownames(thermo$obigt) <- NULL
- assign("thermo", thermo, CHNOSZ)
- # update ispecies
- ntotal <- nrow(thermo$obigt)
- ispecies[inew] <- (ntotal-length(inew)+1):ntotal
- # inform user
- message(paste("mod.obigt: added ", newrows$name, "(", newrows$state, ")", " with energy units of ", newrows$E_units, sep="", collapse="\n"))
- }
- if(length(iold) > 0) {
- # loop over species
- for(i in 1:length(iold)) {
- # the old values and the state
- oldprop <- thermo$obigt[ispecies[iold[i]], icol]
- state <- thermo$obigt$state[ispecies[iold[i]]]
- # tell user if they're the same, otherwise update the data entry
- if(isTRUE(all.equal(oldprop, args[iold[i], ], check.attributes=FALSE)))
- 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)
- message("mod.obigt: updated ", args$name[iold[i]], "(", state, ")")
- }
- }
- }
- return(ispecies)
-}
-
-add.obigt <- function(file, species=NULL, force=TRUE) {
- # add/replace entries in thermo$obigt from values saved in a file
- # only replace if force==TRUE
- thermo <- get("thermo", CHNOSZ)
- to1 <- thermo$obigt
- id1 <- paste(to1$name,to1$state)
- # we match system files with the file suffixes (.csv) removed
- sysfiles <- dir(system.file("extdata/OBIGT/", package="CHNOSZ"))
- sysnosuffix <- sapply(strsplit(sysfiles, "\\."), "[", 1)
- isys <- match(file, sysnosuffix)
- if(!is.na(isys)) file <- system.file(paste0("extdata/OBIGT/", sysfiles[isys]), package="CHNOSZ")
-# else {
-# # we also match single system files with the state suffix removed
-# # (e.g. "DEW" for "DEW_aq", but not "organic" because we have "organic_aq", "organic_cr", etc.)
-# sysnostate <- sapply(strsplit(sysnosuffix, "_"), "[", 1)
-# isys <- which(file==sysnostate)
-# if(length(isys)==1) file <- system.file(paste0("extdata/OBIGT/", sysfiles[isys]), package="CHNOSZ")
-# }
- # read data from the file
- to2 <- read.csv(file, as.is=TRUE)
- # add E_units column if it's missing 20190529
- if(!"E_units" %in% colnames(to2)) to2 <- data.frame(to2[, 1:7], E_units = "cal", to2[, 8:20], stringsAsFactors = FALSE)
- Etxt <- paste(unique(to2$E_units), collapse = " and ")
- # load only selected species if requested
- if(!is.null(species)) {
- idat <- match(species, to2$name)
- ina <- is.na(idat)
- if(!any(ina)) to2 <- to2[idat, ]
- else stop(paste("file", file, "doesn't have", paste(species[ina], collapse=", ")))
- }
- id2 <- paste(to2$name,to2$state)
- # check if the data is compatible with thermo$obigt
- tr <- tryCatch(rbind(to1, to2), error = identity)
- if(inherits(tr, "error")) stop(paste(file, "is not compatible with thermo$obigt data table."))
- # match the new species to existing ones
- does.exist <- id2 %in% id1
- ispecies.exist <- na.omit(match(id2, id1))
- nexist <- sum(does.exist)
- # keep track of the species we've added
- inew <- numeric()
- if(force) {
- # replace existing entries
- if(nexist > 0) {
- to1[ispecies.exist, ] <- to2[does.exist, ]
- to2 <- to2[!does.exist, ]
- inew <- c(inew, ispecies.exist)
- }
- } else {
- # ignore any new entries that already exist
- to2 <- to2[!does.exist, ]
- nexist <- 0
- }
- # add new entries
- if(nrow(to2) > 0) {
- to1 <- rbind(to1, to2)
- inew <- c(inew, (length(id1)+1):nrow(to1))
- }
- # commit the change
- thermo$obigt <- to1
- rownames(thermo$obigt) <- 1:nrow(thermo$obigt)
- assign("thermo", thermo, CHNOSZ)
- # give the user a message
- message("add.obigt: read ", length(does.exist), " rows; made ",
- nexist, " replacements, ", nrow(to2), " additions [energy units: ", Etxt, "]")
- #message("add.obigt: use obigt() or reset() to restore default database")
- return(invisible(inew))
-}
Modified: pkg/CHNOSZ/R/basis.R
===================================================================
--- pkg/CHNOSZ/R/basis.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/basis.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -71,7 +71,7 @@
# if species argument is numeric, it's species indices
if(is.numeric(species[1])) {
ispecies <- species
- ina <- ispecies > nrow(thermo$obigt)
+ ina <- ispecies > nrow(thermo$OBIGT)
} else {
# get species indices using states from the argument, or default states
if(!is.null(state)) ispecies <- suppressMessages(info(species, state, check.it=FALSE))
@@ -89,10 +89,10 @@
### unexported functions ###
-# to add the basis to thermo$obigt
+# to add the basis to thermo$OBIGT
put.basis <- function(ispecies, logact = rep(NA, length(ispecies))) {
thermo <- get("thermo", CHNOSZ)
- state <- thermo$obigt$state[ispecies]
+ state <- thermo$OBIGT$state[ispecies]
# make the basis matrix, revised 20120114
# get the elemental makeup of each species,
# counting zero for any element that only appears in other species in the set
@@ -103,7 +103,7 @@
comp <- t(comp)
# note, makeup(count.zero=TRUE) above gave elements (colnames) sorted alphabetically
# rownames identify the species
- rownames(comp) <- as.character(thermo$obigt$formula[ispecies])
+ rownames(comp) <- as.character(thermo$OBIGT$formula[ispecies])
# FIXME: the electron doesn't look like a chemical formula
# this is needed for affinity() to understand a 'pe' or 'Eh' variable
if("(Z-1)" %in% rownames(comp)) rownames(comp)[rownames(comp)=="(Z-1)"] <- "e-"
@@ -168,11 +168,11 @@
thermo$basis$logact[ib] <- state[i]
} else {
# first, look for a species with the same _name_ in the requested state
- myname <- thermo$obigt$name[thermo$basis$ispecies[ib]]
+ myname <- thermo$OBIGT$name[thermo$basis$ispecies[ib]]
ispecies <- suppressMessages(info(myname, state[i], check.it=FALSE))
if(is.na(ispecies) | is.list(ispecies)) {
# if that failed, look for a species with the same _formula_ in the requested state
- myformula <- thermo$obigt$formula[thermo$basis$ispecies[ib]]
+ myformula <- thermo$OBIGT$formula[thermo$basis$ispecies[ib]]
ispecies <- suppressMessages(info(myformula, state[i], check.it=FALSE))
if(is.na(ispecies) | is.list(ispecies)) {
# if that failed, we're out of luck
Modified: pkg/CHNOSZ/R/berman.R
===================================================================
--- pkg/CHNOSZ/R/berman.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/berman.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -46,7 +46,7 @@
irow <- which(dat$name == name)
if(length(irow)==0) {
if(userfileexists) stop("Data for ", name, " not available. Please add it to ", userfile)
- if(!userfileexists) stop("Data for ", name, " not available. Please add it to your_data_file.csv and run thermo$obigt$Berman <<- 'path/to/your_data_file.csv'")
+ if(!userfileexists) stop("Data for ", name, " not available. Please add it to your_data_file.csv and run thermo$OBIGT$Berman <<- 'path/to/your_data_file.csv'")
}
# the function works fine with just the following assign() call,
# but an explicit dummy assignment here is used to avoid "Undefined global functions or variables" in R CMD check
@@ -55,7 +55,7 @@
k4 <- k5 <- k6 <- l1 <- l2 <- v1 <- v2 <- v3 <- v4 <- NA
# assign values to the variables used below
for(i in 1:ncol(dat)) assign(colnames(dat)[i], dat[irow, i])
- # get the entropy of the elements using the chemical formula in thermo$obigt
+ # get the entropy of the elements using the chemical formula in thermo$OBIGT
if(is.null(thisinfo)) thisinfo <- info(info(name, "cr", check.it=FALSE))
SPrTr_elements <- convert(entropy(thisinfo$formula), "J")
# check that G in data file is the G of formation from the elements --> Benson-Helgeson convention (DG = DH - T*DS)
Modified: pkg/CHNOSZ/R/cgl.R
===================================================================
--- pkg/CHNOSZ/R/cgl.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/cgl.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -15,7 +15,7 @@
# the parameters for *this* species
PAR <- parameters[k, ]
if(all(is.na(PAR[9:21]))) {
- # use Berman equations (parameters not in thermo$obigt)
+ # use Berman equations (parameters not in thermo$OBIGT)
properties <- berman(PAR$name, T=T, P=P, thisinfo=PAR)
iprop <- match(property, colnames(properties))
values <- properties[, iprop, drop=FALSE]
@@ -28,7 +28,7 @@
values <- data.frame(matrix(NA, ncol = length(property), nrow=ncond))
colnames(values) <- property
# a test for availability of heat capacity coefficients (a, b, c, d, e, f)
- # based on the column assignments in thermo$obigt
+ # based on the column assignments in thermo$OBIGT
if(any(!is.na(PAR[, 14:19]))) {
# we have at least one of the heat capacity coefficients;
# zero out any NA's in the rest (leave lambda and T of transition (columns 19-20) alone)
@@ -85,7 +85,7 @@
if(property[i] == "H") values[, i] <- PAR$H + intCpdT + intVdP - T*intdVdTdP
if(property[i] == "S") values[, i] <- PAR$S + intCpdlnT - intdVdTdP
}
- } # end calculations using parameters from thermo$obigt
+ } # end calculations using parameters from thermo$OBIGT
out[[k]] <- values
} # end loop over species
return(out)
Modified: pkg/CHNOSZ/R/equilibrate.R
===================================================================
--- pkg/CHNOSZ/R/equilibrate.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/equilibrate.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -349,7 +349,7 @@
# (default if balance is missing and all species are proteins)
# 1 - balanced on one mole of species
# numeric vector - user-defined n.balance
- # "volume" - standard-state volume listed in thermo$obigt
+ # "volume" - standard-state volume listed in thermo$OBIGT
# the index of the basis species that might be balanced
ibalance <- numeric()
# deal with proteins
Modified: pkg/CHNOSZ/R/examples.R
===================================================================
--- pkg/CHNOSZ/R/examples.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/examples.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -8,7 +8,7 @@
topics <- c("thermo", "examples",
"util.array", "util.blast", "util.data", "util.expression", "util.legend", "util.plot",
"util.fasta", "util.formula", "util.matrix", "util.misc", "util.seq", "util.units",
- "util.water", "taxonomy", "info", "retrieve", "add.obigt", "protein.info",
+ "util.water", "taxonomy", "info", "retrieve", "add.OBIGT", "protein.info",
"hkf", "water", "IAPWS95", "subcrt", "berman",
"makeup", "basis", "swap.basis", "species", "affinity", "solubility", "equilibrate",
"diagram", "buffer", "nonideal", "NaCl", "add.protein", "protein", "ionize.aa",
Modified: pkg/CHNOSZ/R/hkf.R
===================================================================
--- pkg/CHNOSZ/R/hkf.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/hkf.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -52,7 +52,7 @@
# loop over each species
PAR <- parameters[k, ]
# substitute Cp and V for missing EoS parameters
- # here we assume that the parameters are in the same position as in thermo$obigt
+ # here we assume that the parameters are in the same position as in thermo$OBIGT
# we don't need this if we're just looking at solvation properties (Cp_s_var, V_s_var)
if("n" %in% contrib) {
# put the heat capacity in for c1 if both c1 and c2 are missing
Modified: pkg/CHNOSZ/R/info.R
===================================================================
--- pkg/CHNOSZ/R/info.R 2020-07-04 04:28:50 UTC (rev 541)
+++ pkg/CHNOSZ/R/info.R 2020-07-04 04:53:42 UTC (rev 542)
@@ -10,7 +10,7 @@
#source("util.data.R")
info <- function(species=NULL, state=NULL, check.it=TRUE) {
- ## return information for one or more species in thermo$obigt
+ ## return information for one or more species in thermo$OBIGT
thermo <- get("thermo", CHNOSZ)
# that should give us the data, not the thermo() function 20190928
if(is.function(thermo)) stop("CHNOSZ package data is not available; use reset() or library(CHNOSZ) to load it")
@@ -17,8 +17,8 @@
## if no species are requested, summarize the available data 20101129
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,",
- nrow(thermo$obigt), "total species"))
+ message(paste("thermo$OBIGT has", nrow(thermo$OBIGT[thermo$OBIGT$state=="aq", ]), "aqueous,",
+ nrow(thermo$OBIGT), "total species"))
message(paste("number of literature sources: ", nrow(thermo$refs), ", elements: ",
nrow(thermo$element), ", buffers: ", length(unique(thermo$buffers$name)), sep=""))
message(paste("number of proteins in thermo$protein is", nrow(thermo$protein), "from",
@@ -29,10 +29,10 @@
if(is.numeric(species)) {
out <- lapply(species, info.numeric, check.it)
# if we have different states the column names could be different
- if(length(unique(unlist(lapply(out, names)))) > ncol(thermo$obigt)) {
- # make them the same as thermo$obigt
+ if(length(unique(unlist(lapply(out, names)))) > ncol(thermo$OBIGT)) {
+ # make them the same as thermo$OBIGT
out <- lapply(out, function(row) {
- colnames(row) <- colnames(thermo$obigt); return(row)
+ colnames(row) <- colnames(thermo$OBIGT); return(row)
})
}
# turn the list into a data frame
@@ -66,7 +66,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", CHNOSZ)$obigt[ispecies, ]
+ this <- get("thermo", CHNOSZ)$OBIGT[ispecies, ]
sourcetext <- this$ref1
ref2 <- this$ref2
if(!is.na(ref2)) sourcetext <- paste(sourcetext, ref2, sep=", ")
@@ -77,19 +77,19 @@
}
info.character <- function(species, state=NULL, check.protein=TRUE) {
- # returns the rownumbers of thermo$obigt having an exact match of 'species' to
- # thermo$obigt$[species|abbrv|formula] or NA otherwise
- # a match to thermo$obigt$state is also required if 'state' is not NULL
+ # returns the rownumbers of thermo$OBIGT having an exact match of 'species' to
+ # 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", 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
+ 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
matches.species[is.na(matches.species)] <- FALSE
# turn it in to no match if it's a protein in the wrong state
ip <- pinfo(species)
if(any(matches.species) & !is.na(ip) & !is.null(state)) {
- matches.state <- matches.species & grepl(state, thermo$obigt$state)
+ matches.state <- matches.species & grepl(state, thermo$OBIGT$state)
if(!any(matches.state)) matches.species <- FALSE
}
# no match, not available
@@ -96,14 +96,14 @@
if(!any(matches.species)) {
# unless it's a protein
if(check.protein) {
- # did we find a protein? add its properties to obigt
+ # did we find a protein? add its properties to OBIGT
if(!is.na(ip)) {
# here we use a default state from thermo$opt$state
if(is.null(state)) state <- thermo$opt$state
# add up protein properties
- eos <- protein.obigt(ip, state=state)
+ eos <- protein.OBIGT(ip, state=state)
# the real assignment work
- nrows <- suppressMessages(mod.obigt(eos))
+ nrows <- suppressMessages(mod.OBIGT(eos))
thermo <- get("thermo", CHNOSZ)
matches.species <- rep(FALSE, nrows)
matches.species[nrows] <- TRUE
@@ -115,10 +115,10 @@
# special treatment for H2O: aq retrieves the liq
if(species %in% c("H2O", "water") & state=="aq") state <- "liq"
# the matches for both species and state
- matches.state <- matches.species & state == thermo$obigt$state
+ matches.state <- matches.species & state == thermo$OBIGT$state
if(!any(matches.state)) {
# the requested state is not available for this species
- available.states <- thermo$obigt$state[matches.species]
+ available.states <- thermo$OBIGT$state[matches.species]
if(length(available.states)==1) a.s.verb <- "is" else a.s.verb <- "are"
a.s.text <- paste("'", available.states, "'", sep="", collapse=" ")
message("info.character: requested state '", state, "' for ", species,
@@ -132,19 +132,19 @@
# processing for more than one match
if(length(ispecies) > 1) {
# if a single name matches, use that one (useful for distinguishing pseudo-H4SiO4 and H4SiO4) 20171020
- matches.name <- matches.species & thermo$obigt$name==species
+ matches.name <- matches.species & thermo$OBIGT$name==species
if(sum(matches.name)==1) ispecies.out <- which(matches.name)
else ispecies.out <- ispecies[1] # otherwise, return only the first species that matches
# let user know if there is more than one state for this species
- mystate <- thermo$obigt$state[ispecies.out]
+ mystate <- thermo$OBIGT$state[ispecies.out]
ispecies.other <- ispecies[!ispecies %in% ispecies.out]
- otherstates <- thermo$obigt$state[ispecies.other]
+ otherstates <- thermo$OBIGT$state[ispecies.other]
# for minerals (cr), use the word "phase"; otherwise, use "state" 20190209
word <- "state"
# substitute the mineral name for "cr" 20190121
if(mystate == "cr" | sum(otherstates=="cr") > 1) {
word <- "phase"
- otherstates[otherstates=="cr"] <- thermo$obigt$name[ispecies.other[otherstates=="cr"]]
+ otherstates[otherstates=="cr"] <- thermo$OBIGT$name[ispecies.other[otherstates=="cr"]]
}
transtext <- othertext <- ""
# we count, but don't show the states for phase transitions (cr2, cr3, etc)
@@ -155,7 +155,7 @@
if(ntrans == 1) transtext <- paste(" with", ntrans, "phase transition")
else if(ntrans > 1) transtext <- paste(" with", ntrans, "phase transitions")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/chnosz -r 542
More information about the CHNOSZ-commits
mailing list