[CHNOSZ-commits] r579 - in pkg/CHNOSZ: . R inst man tests/testthat vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 25 07:27:56 CEST 2020
Author: jedick
Date: 2020-07-25 07:27:55 +0200 (Sat, 25 Jul 2020)
New Revision: 579
Modified:
pkg/CHNOSZ/DESCRIPTION
pkg/CHNOSZ/R/util.list.R
pkg/CHNOSZ/inst/NEWS.Rd
pkg/CHNOSZ/man/eos.Rd
pkg/CHNOSZ/man/util.list.Rd
pkg/CHNOSZ/tests/testthat/test-util.list.R
pkg/CHNOSZ/vignettes/multi-metal.Rmd
Log:
Rewrite which.pmax()
Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/DESCRIPTION 2020-07-25 05:27:55 UTC (rev 579)
@@ -1,15 +1,12 @@
Date: 2020-07-25
Package: CHNOSZ
-Version: 1.3.6-52
+Version: 1.3.6-53
Title: Thermodynamic Calculations and Diagrams for Geochemistry
Authors at R: c(
person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),
- comment = c(ORCID = "0000-0002-0687-5890")),
- person("R Core Team", role = "ctb",
- comment = "code derived from R's pmax()")
+ comment = c(ORCID = "0000-0002-0687-5890"))
)
-Author: Jeffrey Dick [aut, cre] (0000-0002-0687-5890),
- R Core Team [ctb] (code derived from R's pmax())
+Author: Jeffrey Dick [aut, cre] (0000-0002-0687-5890)
Maintainer: Jeffrey Dick <j3ffdick at gmail.com>
Depends: R (>= 3.1.0)
Suggests: limSolve, testthat, knitr, rmarkdown, tufte
Modified: pkg/CHNOSZ/R/util.list.R
===================================================================
--- pkg/CHNOSZ/R/util.list.R 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/R/util.list.R 2020-07-25 05:27:55 UTC (rev 579)
@@ -1,48 +1,31 @@
# CHNOSZ/util.list.R
# functions to work with lists
-which.pmax <- function (elts, na.rm = FALSE, pmin=FALSE) {
- # adapted from R's pmax. elts is a list of numeric vectors
- keepattr <- attributes(elts[[1]])
- keepdim <- dim(elts[[1]])
- if(!is.numeric(elts[[1]])[1]) {
- if(is.data.frame(elts[[1]])) elts[[1]] <- as.matrix(elts[[1]])
- if(is.list(elts[[1]])) elts[[1]] <- elts[[1]][[1]]
- else elts[[1]] <- as.numeric(elts[[1]])
+# which list elements have the maximum (or minimum) values
+# revised for speed 20200725
+which.pmax <- function(x, maximum = TRUE) {
+ # start with NA indices, -Inf (or Inf) working values, and a record of NA values
+ iiNA <- tmp <- imax <- x[[1]]
+ imax[] <- NA
+ if(maximum) tmp[] <- -Inf else tmp[] <- Inf
+ iiNA[] <- 0
+ # loop over elements of x
+ for(i in seq_along(x)) {
+ # find values that are greater (or lesser) than working values
+ if(maximum) iimax <- x[[i]] > tmp
+ else iimax <- x[[i]] < tmp
+ # keep NAs out
+ iNA <- is.na(iimax)
+ iiNA[iNA] <- 1
+ iimax[iNA] <- FALSE
+ # save the indices and update working values
+ imax[iimax] <- i
+ tmp[iimax] <- x[[i]][iimax]
}
- mmm <- as.vector(elts[[1]])
- which.mmm <- rep(1,length(elts[[1]]))
- has.na <- FALSE
- if(length(elts) > 1) {
- for (i in 2:length(elts)) {
- if(!is.numeric(elts[[i]])[1]) {
- if(is.list(elts[[i]])) elts[[i]] <- elts[[i]][[1]]
- else elts[[i]] <- as.numeric(elts[[i]])
- }
- work <- cbind(mmm, as.vector(elts[[i]]))
- nas <- is.na(work)
- if (has.na || (has.na <- any(nas))) {
- work[, 1][nas[, 1]] <- work[, 2][nas[, 1]]
- work[, 2][nas[, 2]] <- work[, 1][nas[, 2]]
- }
- if(pmin) change <- work[, 1] > work[, 2]
- else change <- work[, 1] < work[, 2]
- change <- change & !is.na(change)
- work[, 1][change] <- work[, 2][change]
- which.mmm[change] <- i
- if (has.na && !na.rm) {
- work[, 1][nas[, 1] | nas[, 2]] <- NA
- which.mmm[nas[, 1] | nas[, 2]] <- NA
- }
- mmm <- work[, 1]
- }
- }
- if(identical(keepattr$class, "data.frame")) {
- dim(which.mmm) <- keepdim
- which.mmm <- as.data.frame(which.mmm)
- }
- mostattributes(which.mmm) <- keepattr
- which.mmm
+ imax[iiNA == 1] <- NA
+ # keep attributes from x
+ mostattributes(imax) <- attributes(x[[1]])
+ imax
}
### unexported functions ###
Modified: pkg/CHNOSZ/inst/NEWS.Rd
===================================================================
--- pkg/CHNOSZ/inst/NEWS.Rd 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/inst/NEWS.Rd 2020-07-25 05:27:55 UTC (rev 579)
@@ -175,8 +175,10 @@
\code{multi-metal.Rmd} vignette to compute the Pourbaix energy
(Δ\emph{G}\s{pbx}) for a metastable material.
- \item Remove the \samp{lty.aq} and \samp{lty.cr} arguments from
- \code{diagram()}.
+ \item \code{which.pmax()} was rewritten to speed up identification of
+ stable species, and \code{diagram()} was made more efficient in drawing
+ field boundaries. The latter change has prompted the removal of the
+ \samp{lty.aq} and \samp{lty.cr} arguments from \code{diagram()}.
}
}
Modified: pkg/CHNOSZ/man/eos.Rd
===================================================================
--- pkg/CHNOSZ/man/eos.Rd 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/man/eos.Rd 2020-07-25 05:27:55 UTC (rev 579)
@@ -88,7 +88,7 @@
C8H18par <- info(info(rep("octane", 3), c("cr", "liq", "gas")))
myT <- seq(200, 420, 10)
DG0f <- cgl(property = "G", parameters = C8H18par, T = myT, P = 1)
-cbind(T = myT, which.pmax(DG0f, pmin = TRUE)) # 1 = cr, 2 = liq, 3 = gas
+cbind(T = myT, which.pmax(DG0f, FALSE)) # 1 = cr, 2 = liq, 3 = gas
# compare that result with the tabulated transition temperatures
print(C8H18par)
}
Modified: pkg/CHNOSZ/man/util.list.Rd
===================================================================
--- pkg/CHNOSZ/man/util.list.Rd 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/man/util.list.Rd 2020-07-25 05:27:55 UTC (rev 579)
@@ -5,22 +5,21 @@
\title{Functions to Work with Lists}
\description{
- Combine lists or perform arithmetic operations on elements of lists.
+ Identify list elements that have the maximum (or minimum) values.
}
\usage{
- which.pmax(elts, na.rm = FALSE, pmin = FALSE)
+ which.pmax(x, maximum = TRUE)
}
\arguments{
- \item{elts}{list, numeric vectors for which to find maximum values (in parallel) (\code{which.pmax}).}
- \item{na.rm}{logical, remove missing values?}
- \item{pmin}{logical, find minimum values instead of maximum ones?}
+ \item{x}{list of numeric vectors}
+ \item{maximum}{logical, find maximum values or minimum values?}
}
\details{
-\code{which.pmax} takes a list of equal-length numeric vectors (or objects that can be coerced to numeric) in \code{elts} and returns the index of the vector holding the maximum value at each position.
-If \code{na.rm} is \code{TRUE}, values of \code{NA} are removed; if \code{pmin} is \code{TRUE} the function finds locations of the minimum values instead.
+\code{which.pmax} takes a list of equal-length numeric vectors or equal-dimension arrays in \code{x} and returns the index of the list element that has the maximum value at each point.
+Change \code{maximum} to \code{FALSE} to find the minimum values instead.
}
\concept{Utility functions}
Modified: pkg/CHNOSZ/tests/testthat/test-util.list.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-util.list.R 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/tests/testthat/test-util.list.R 2020-07-25 05:27:55 UTC (rev 579)
@@ -1,8 +1,13 @@
context("util.list")
test_that("which.pmax() properly applies attributes, and also works for lists of length 1", {
- testlist <- list(a=matrix(c(1,2,3,4)), b=matrix(c(4,3,2,1)))
- testattr <- attributes(testlist[[1]])
- expect_equal(attributes(which.pmax(testlist)), testattr)
- expect_equal(as.numeric(which.pmax(testlist[1])), c(1, 1, 1, 1))
+ x <- list(a = matrix(c(1, 2, 3, 4)), b = matrix(c(4, 3, 2, 1)))
+ xattr <- attributes(x[[1]])
+ expect_equal(attributes(which.pmax(x)), xattr)
+ expect_equal(as.numeric(which.pmax(x[1])), c(1, 1, 1, 1))
})
+
+test_that("which.pmax() can handle NA values", {
+ x <- list(a = matrix(c(1, 2, NA, 4)), b = matrix(c(4, 3, 2, 1)))
+ expect_equal(as.numeric(which.pmax(x)), c(2, 2, NA, 1))
+})
Modified: pkg/CHNOSZ/vignettes/multi-metal.Rmd
===================================================================
--- pkg/CHNOSZ/vignettes/multi-metal.Rmd 2020-07-25 03:07:30 UTC (rev 578)
+++ pkg/CHNOSZ/vignettes/multi-metal.Rmd 2020-07-25 05:27:55 UTC (rev 579)
@@ -581,7 +581,7 @@
names(iCu.aq)
```
-CuHS and Cu(HS)~2~^-^ can be excluded by removing S from the `retrieve()` call above (i.e. only `c("O", "H", "Cl")` as ligands); doing so precludes a high concentration of aqueous Cu in the highly reduced, sulfidic region.
+CuHS and Cu(HS)~2~^-^ can be excluded by removing S from the `retrieve()` call above (i.e. only `c("O", "H", "Cl")` as the elements in possible ligands); doing so precludes a high concentration of aqueous Cu in the highly reduced, sulfidic region.
The third plot for the concentation of SO~4~^-2^ is simply made by using `affinity()` to calculate the affinity of its formation reaction as a function of *f*~S<sub>2</sub>~ and *f*~O<sub>2</sub>~ at pH 6 and 125 °C, then using `solubility()` to calculate the solubility of S~2~(gas), expressed in terms of moles of SO~4~^-2^ in order to calculate parts per million (ppm) by weight.
More information about the CHNOSZ-commits
mailing list