[CHNOSZ-commits] r327 - in pkg/CHNOSZ: . R demo tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 23 08:06:41 CEST 2018
Author: jedick
Date: 2018-09-23 08:06:20 +0200 (Sun, 23 Sep 2018)
New Revision: 327
Modified:
pkg/CHNOSZ/DESCRIPTION
pkg/CHNOSZ/R/diagram.R
pkg/CHNOSZ/R/subcrt.R
pkg/CHNOSZ/demo/copper.R
pkg/CHNOSZ/demo/mosaic.R
pkg/CHNOSZ/tests/testthat/test-subcrt.R
Log:
diagram(): avoid error when plotting blank predominance diagram
Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/DESCRIPTION 2018-09-23 06:06:20 UTC (rev 327)
@@ -1,6 +1,6 @@
Date: 2018-09-23
Package: CHNOSZ
-Version: 1.1.3-34
+Version: 1.1.3-35
Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
Authors at R: c(
person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),
@@ -17,7 +17,7 @@
Description: An integrated set of tools for thermodynamic calculations in geochemistry and compositional
biology. The thermodynamic properties of liquid water are calculated using Fortran code from
SUPCRT92 (Johnson et al., 1992 <doi:10.1016/0098-3004(92)90029-Q>) or an implementation
- in R of the IAPWS-95 formulation (Wagner and Pruß, 2002 doi:10.1063/1.1461829).
+ in R of the IAPWS-95 formulation (Wagner and Pruß, 2002 <doi:10.1063/1.1461829>).
Thermodynamic properties of other species are taken from a database for minerals and inorganic
and organic aqueous species including biomolecules, or from amino acid group additivity for
proteins (Dick et al., 2006 <doi:10.5194/bg-3-311-2006>). High-temperature properties are
Modified: pkg/CHNOSZ/R/diagram.R
===================================================================
--- pkg/CHNOSZ/R/diagram.R 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/R/diagram.R 2018-09-23 06:06:20 UTC (rev 327)
@@ -197,7 +197,7 @@
}
}
- ## where we'll put extra output for predominance diagrams (lx, ly, is)
+ ## where we'll put extra output for predominance diagrams (namesx, namesy, inames)
out2D <- list()
### now on to the plotting ###
@@ -474,28 +474,28 @@
# calculate coordinates for field labels
plot.names <- function(out, xs, ys, names) {
ll <- ngroups
- lx <- numeric(ll); ly <- numeric(ll); n <- numeric(ll)
+ namesx <- numeric(ll); namesy <- numeric(ll); n <- numeric(ll)
for(j in nrow(out):1) {
# 20091116 for speed, loop over ngroups instead of k (columns)
for(i in 1:ll) {
k <- which(out[j,]==i)
if(length(k)==0) next
- lx[i] <- lx[i] + sum(xs[k])
- ly[i] <- ly[i] + length(k)*ys[nrow(out)+1-j]
+ namesx[i] <- namesx[i] + sum(xs[k])
+ namesy[i] <- namesy[i] + length(k)*ys[nrow(out)+1-j]
n[i] <- n[i] + length(k)
}
}
- lx <- lx[n!=0]
- ly <- ly[n!=0]
- is <- n!=0
+ namesx <- namesx[n!=0]
+ namesy <- namesy[n!=0]
+ inames <- n!=0
n <- n[n!=0]
- lx <- lx/n
- ly <- ly/n
+ namesx <- namesx/n
+ namesy <- namesy/n
# plot field labels
# the cex argument in this function specifies the character
# expansion of the labels relative to the current
- if(!is.null(names)) text(lx, ly, labels=names[is], cex=cex.names, col=col.names[is])
- return(list(lx=lx, ly=ly, is=which(is)))
+ if(!is.null(names) & any(inames)) text(namesx, namesy, labels=names[inames], cex=cex.names, col=col.names[inames])
+ return(list(namesx=namesx, namesy=namesy, inames=which(inames)))
}
### done with predominance diagram functions
@@ -551,23 +551,24 @@
} else {
# otherwise, make contours of properties using first species only
if(length(plotvals) > 1) warning("showing only first species in 2-D property diagram")
- print('hello')
- print(length(plotvals))
zs <- plotvals[[1]]
contour(xs, ys, zs, add=TRUE, col=col, lty=lty, lwd=lwd, labcex=cex, method=contour.method)
}
- pn <- list(lx=NULL, ly=NULL, is=NULL)
+ pn <- list(namesx=NULL, namesy=NULL, inames=NULL)
} else {
# put predominance matrix in the right order for image() etc
zs <- t(predominant[, ncol(predominant):1])
if(!is.null(fill)) fill.color(xs, ys, zs, fill, ngroups)
pn <- plot.names(zs, xs, ys, names)
- if(!is.null(dotted)) plot.line(zs, xlim, ylim, dotted, col, lwd, xrange=xrange)
- else contour.lines(predominant, xlim, ylim, lty=lty, col=col, lwd=lwd)
+ # only draw the lines if there is more than one field (avoid warnings from contour)
+ if(length(unique(as.vector(zs))) > 1) {
+ if(!is.null(dotted)) plot.line(zs, xlim, ylim, dotted, col, lwd, xrange=xrange)
+ else contour.lines(predominant, xlim, ylim, lty=lty, col=col, lwd=lwd)
+ }
# re-draw the tick marks and axis lines in case the fill obscured them
if(tplot & !identical(fill, "transparent")) thermo.axis()
} # done with the 2D plot!
- out2D <- list(lx=pn$lx, ly=pn$ly, is=pn$is)
+ out2D <- list(namesx=pn$namesx, namesy=pn$namesy, inames=pn$inames)
} # end if(nd==2)
} # end if(plot.it)
Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/R/subcrt.R 2018-09-23 06:06:20 UTC (rev 327)
@@ -68,7 +68,11 @@
# warn for too high temperatures for Psat 20171110
warnings <- character()
- if(identical(P, "Psat") & any(T > 647.067)) warnings <- c(warnings, "P = 'Psat' undefined for T > Tcritical")
+ if(identical(P, "Psat") & any(T > 647.067)) {
+ nover <- sum(T > 647.067)
+ if(nover==1) vtext <- "value" else vtext <- "values"
+ warnings <- c(warnings, paste0("P = 'Psat' undefined for T > Tcritical (", nover, " T ", vtext, ")"))
+ }
# gridding?
do.grid <- FALSE
@@ -282,13 +286,13 @@
hkfstuff <- hkf(eosprop, parameters = param, T = T, P = P, H2O.props=H2O.props)
p.aq <- hkfstuff$aq
H2O.PT <- hkfstuff$H2O
- # set properties to NA for density below 0.35 g/cm3 (near-critical isochore; threshold used in SUPCRT92) 20180922
+ # set properties to NA for density below 0.35 g/cm3 (a little above the critical isochore, threshold used in SUPCRT92) 20180922
ilowrho <- H2O.PT$rho < 350
ilowrho[is.na(ilowrho)] <- FALSE
if(any(ilowrho)) {
for(i in 1:length(p.aq)) p.aq[[i]][ilowrho, ] <- NA
- if(sum(ilowrho)==1) ctext <- "condition" else ctext <- "conditions"
- warnings <- c(warnings, paste0("below density threshold for applicability of revised HKF equations (", sum(ilowrho), " T,P ", ctext, ")"))
+ if(sum(ilowrho)==1) ptext <- "pair" else ptext <- "pairs"
+ warnings <- c(warnings, paste0("below minimum density for applicability of revised HKF equations (", sum(ilowrho), " T,P ", ptext, ")"))
}
# calculate activity coefficients if ionic strength is not zero
if(any(IS != 0)) {
Modified: pkg/CHNOSZ/demo/copper.R
===================================================================
--- pkg/CHNOSZ/demo/copper.R 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/demo/copper.R 2018-09-23 06:06:20 UTC (rev 327)
@@ -50,12 +50,12 @@
if(names[i]=="HCu(Gly)+2") srt <- 90
if(names[i]=="HCu(Gly)+2") dx <- -0.2
if(names[i]=="Cu(Gly)+") srt <- 90
- text(d$lx[i]+dx, d$ly[i]+dy, lab, srt=srt)
+ text(d$namesx[i]+dx, d$namesy[i]+dy, lab, srt=srt)
}
# add glycine ionization lines
d <- diagram(m$A.bases, add=TRUE, col="darkblue", lty=3, names=NULL, limit.water=FALSE)
-text(d$lx, -0.5, Gly, col="darkblue")
+text(d$namesx, -0.5, Gly, col="darkblue")
# add water lines and title
water.lines(d)
Modified: pkg/CHNOSZ/demo/mosaic.R
===================================================================
--- pkg/CHNOSZ/demo/mosaic.R 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/demo/mosaic.R 2018-09-23 06:06:20 UTC (rev 327)
@@ -34,6 +34,6 @@
"log(total C)=0, after Garrels and Christ, 1965", sep="\n"))
# overlay the carbonate basis species predominance fields
d <- diagram(m1$A.bases2, add=TRUE, col="blue", names=NULL, lty=3, limit.water=FALSE)
-text(d$lx, -0.8, as.expression(sapply(m1$A.bases2$species$name, expr.species)), col="blue")
+text(d$namesx, -0.8, as.expression(sapply(m1$A.bases2$species$name, expr.species)), col="blue")
# reset the database, as it was changed in this example
data(thermo)
Modified: pkg/CHNOSZ/tests/testthat/test-subcrt.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-subcrt.R 2018-09-23 03:55:29 UTC (rev 326)
+++ pkg/CHNOSZ/tests/testthat/test-subcrt.R 2018-09-23 06:06:20 UTC (rev 327)
@@ -185,7 +185,7 @@
})
test_that("properties of HKF species below 0.35 g/cm3 are NA and give a warning", {
- wtext <- "below density threshold for applicability of revised HKF equations \\(2 T,P conditions\\)"
+ wtext <- "below minimum density for applicability of revised HKF equations \\(2 T,P pairs\\)"
expect_warning(s1 <- subcrt(c("Na+", "quartz"), T=450, P=c(400, 450, 500)), wtext)
expect_equal(sum(is.na(s1$out$`Na+`$logK)), 2)
expect_equal(sum(is.na(s1$out$quartz$logK)), 0)
More information about the CHNOSZ-commits
mailing list