From noreply at r-forge.r-project.org Tue Jun 9 12:21:09 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jun 2015 12:21:09 +0200 (CEST) Subject: [CHNOSZ-commits] r88 - in pkg/CHNOSZ: . R data demo inst inst/tests man tests Message-ID: <20150609102109.BDC21184F58@r-forge.r-project.org> Author: jedick Date: 2015-06-09 12:21:09 +0200 (Tue, 09 Jun 2015) New Revision: 88 Added: pkg/CHNOSZ/R/util.water.R pkg/CHNOSZ/demo/density.R pkg/CHNOSZ/inst/tests/test-util.program.R pkg/CHNOSZ/man/util.water.Rd Removed: pkg/CHNOSZ/demo/cordierite.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/IAPWS95.R pkg/CHNOSZ/R/affinity.R pkg/CHNOSZ/R/equilibrate.R pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/objective.R pkg/CHNOSZ/R/util.fasta.R pkg/CHNOSZ/R/util.program.R pkg/CHNOSZ/R/water.R pkg/CHNOSZ/data/opt.csv pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/CHNOSZ-package.Rd pkg/CHNOSZ/man/IAPWS95.Rd pkg/CHNOSZ/man/data.Rd pkg/CHNOSZ/man/examples.Rd pkg/CHNOSZ/man/util.fasta.Rd pkg/CHNOSZ/man/util.program.Rd pkg/CHNOSZ/man/water.Rd pkg/CHNOSZ/tests/test-all.R Log: improve density calculations for IAPWS-95 Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/DESCRIPTION 2015-06-09 10:21:09 UTC (rev 88) @@ -1,11 +1,11 @@ -Date: 2015-05-19 +Date: 2015-06-09 Package: CHNOSZ -Version: 1.0.5 +Version: 1.0.5-1 Title: Chemical Thermodynamics and Activity Diagrams Author: Jeffrey Dick Maintainer: Jeffrey Dick -Depends: R (>= 3.0.0) -Suggests: limSolve, parallel, testthat, knitr +Depends: R (>= 3.1.0) +Suggests: limSolve, testthat, knitr Description: Functions and data sets to support chemical thermodynamic modeling in biochemistry and low-temperature geochemistry. The features include calculation of the standard molal thermodynamic properties and chemical affinities of reactions involving minerals and/or Modified: pkg/CHNOSZ/R/IAPWS95.R =================================================================== --- pkg/CHNOSZ/R/IAPWS95.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/IAPWS95.R 2015-06-09 10:21:09 UTC (rev 88) @@ -246,54 +246,3 @@ return(ww) } -WP02.auxiliary <- function(property='rho.liquid',T=298.15) { - # auxiliary equations for liquid-vapor phase boundary - # from Wagner and Pruss, 2002 - # critical point - T.critical <- 647.096 # K - P.critical <- 22.064 # MPa - rho.critical <- 322 # kg m-3 - - if(property %in% c("P.sigma","dP.sigma.dT")) { - # vapor pressure - V <- 1 - T / T.critical # theta (dimensionless) - a1 <- -7.85951783 - a2 <- 1.84408259 - a3 <- -11.7866497 - a4 <- 22.6807411 - a5 <- -15.9618719 - a6 <- 1.80122502 - ln.P.sigma.P.critical <- T.critical / T * - ( a1*V + a2*V^1.5 + a3*V^3 + a4*V^3.5 + a5*V^4 + a6*V^7.5 ) - P.sigma <- P.critical * exp(ln.P.sigma.P.critical) - if(property=="dP.sigma.dT") out <- - P.sigma / T * ( ln.P.sigma.P.critical + - a1 + 1.5*a2*V^0.5 + 3*a3*V^2 + 3.5*a4*V^2.5 + 4*a5*V^3 + 7.5*a6*V^6.5 ) - else out <- P.sigma - } else if(property=="rho.liquid") { - # saturated liquid density - V <- 1 - T / T.critical - b1 <- 1.99274064 - b2 <- 1.09965342 - b3 <- -0.510839303 - b4 <- -1.75493479 - b5 <- -45.5170352 - b6 <- -6.74694450E5 - rho.liquid <- rho.critical * ( - 1 + b1*V^(1/3) + b2*V^(2/3) + b3*V^(5/3) + b4*V^(16/3) + b5*V^(43/3) + b6*V^(110/3) ) - out <- rho.liquid - } else if(property=="rho.vapor") { - # saturated vapor density - V <- 1 - T / T.critical - c1 <- -2.03150240 - c2 <- -2.68302940 - c3 <- -5.38626492 - c4 <- -17.2991605 - c5 <- -44.7586581 - c6 <- -63.9201063 - rho.vapor <- rho.critical * exp ( - c1*V^(2/6) + c2*V^(4/6) + c3*V^(8/6) + c4*V^(18/6) + c5*V^(37/6) + c6*V^(71/6) ) - out <- rho.vapor - } else stop(paste('i can not calculate',property)) - return(out) -} - Modified: pkg/CHNOSZ/R/affinity.R =================================================================== --- pkg/CHNOSZ/R/affinity.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/affinity.R 2015-06-09 10:21:09 UTC (rev 88) @@ -152,15 +152,13 @@ # from those of residues loga.protein <- rep(loga.protein,length.out=length(iprotein)) protein.fun <- function(ip) { - if(ip %% 50 == 0) msgout(paste(ip,"..",sep="")) tpext <- as.numeric(thermo$protein[iprotein[ip],5:25]) - return(Reduce("+", pprod(a[ires],tpext)) - loga.protein[ip]) + return(Reduce("+", CHNOSZ::pprod(a[ires],tpext)) - loga.protein[ip]) } # use another level of indexing to let the function # report on its progress jprotein <- 1:length(iprotein) - protein.affinity <- palply(jprotein,protein.fun) - if(length(iprotein) > 49) msgout("\n") + protein.affinity <- palply("", jprotein, protein.fun) ## update the species list # we use negative values for ispecies to denote that # they index thermo$protein and not thermo$species Modified: pkg/CHNOSZ/R/equilibrate.R =================================================================== --- pkg/CHNOSZ/R/equilibrate.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/equilibrate.R 2015-06-09 10:21:09 UTC (rev 88) @@ -89,18 +89,18 @@ Astardim <- dim(Astar[[1]]) Anames <- names(Astar) # first loop: make vectors - A <- palply(1:length(A), function(i) as.vector(A[[i]])) + A <- palply("", 1:length(A), function(i) as.vector(A[[i]])) # second loop: get the exponentiated Astars (numerators) # need to convert /2.303RT to /RT #A[[i]] <- exp(log(10)*Astar[[i]]/n.balance[i])/n.balance[i] - A <- palply(1:length(A), function(i) exp(log(10)*Astar[[i]]/n.balance[i])) + A <- palply("", 1:length(A), function(i) exp(log(10)*Astar[[i]]/n.balance[i])) # third loop: accumulate the denominator # initialize variable to hold the sum At <- A[[1]] At[] <- 0 for(i in 1:length(A)) At <- At + A[[i]]*n.balance[i] # fourth loop: calculate log abundances and replace the dimensions - A <- palply(1:length(A), function(i) loga.balance + log10(A[[i]]/At)) + A <- palply("", 1:length(A), function(i) loga.balance + log10(A[[i]]/At)) # fifth loop: replace dimensions for(i in 1:length(A)) dim(A[[i]]) <- Astardim # add names and we're done! @@ -206,7 +206,7 @@ return(Abar) } # calculate the logact(thing) for each condition - logact <- palply(1:nrow(Astar), function(i) { + logact <- palply("", 1:nrow(Astar), function(i) { # get the equilibrium Abar for each condition Abar <- Abarfun(i) return(logactfun(Abar, i)) Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/examples.R 2015-06-09 10:21:09 UTC (rev 88) @@ -15,10 +15,10 @@ "objective", "revisit", "transfer", "anim", "EOSregress", "wjd") plot.it <- FALSE if(is.character(do.png)) - png(paste(do.png,"%d.png",sep=""),width=700,height=700,pointsize=18) + png(paste(do.png,"%d.png",sep=""),width=500,height=500,pointsize=12) else if(do.png) plot.it <- TRUE for(i in 1:length(topics)) { - if(plot.it) png(paste(topics[i],"%d.png",sep=""),width=700,height=700,pointsize=18) + if(plot.it) png(paste(topics[i],"%d.png",sep=""),width=500,height=500,pointsize=12) myargs <- list(topic=topics[i],ask=FALSE) do.call(example,myargs) if(plot.it) dev.off() @@ -29,16 +29,18 @@ cat("Time elapsed: ", proc.time() - .ptime, "\n") } -demos <- function(which=c("sources", "NaCl", "cordierite", +demos <- function(which=c("sources", "NaCl", "density", "phosphate", "nucleobase", "orp", "diagram", "revisit", "findit", "CO2Ac", "nonideal", "ionize", "buffer", "yeastgfp", "mosaic", - "solubility", "wjd")) { + "solubility", "wjd"), do.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one for(i in 1:length(which)) { # say something so the user sees where we are msgout("------------\n") msgout(paste("demos: running '", which[i], "'\n", sep="")) + if(do.png) png(paste(which[i],"%d.png",sep=""),width=500,height=500,pointsize=12) out <- demo(which[i], package="CHNOSZ", character.only=TRUE, echo=FALSE, ask=FALSE) + if(do.png) dev.off() } return(invisible(out)) } Modified: pkg/CHNOSZ/R/objective.R =================================================================== --- pkg/CHNOSZ/R/objective.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/objective.R 2015-06-09 10:21:09 UTC (rev 88) @@ -186,7 +186,7 @@ return(sum(DG)) } # we need to index both loga1 and Astar - DGtr <- unlist(palply(seq(nrow(loga1)), function(i) { + DGtr <- unlist(lapply(seq(nrow(loga1)), function(i) { dgtr(loga1[i, ], loga2, Astar[i, ]) })) return(DGtr) Modified: pkg/CHNOSZ/R/util.fasta.R =================================================================== --- pkg/CHNOSZ/R/util.fasta.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/util.fasta.R 2015-06-09 10:21:09 UTC (rev 88) @@ -33,11 +33,11 @@ # use the system grep if(is.null(startswith)) startswith <- "" else startswith <- paste("^",startswith,".*",sep="") if(ignore.case) ic <- "-i" else ic <- "" - out <- palply(1:length(pattern),sysgrep) + out <- lapply(1:length(pattern), sysgrep) } else { # use R grep if(is.null(lines)) lines <- readLines(file) - out <- palply(1:length(pattern),Rgrep) + out <- lapply(1:length(pattern), Rgrep) } # make numeric (NA for ones that aren't matched) out <- as.numeric(sapply(out,as.numeric)) @@ -108,7 +108,7 @@ organism <- bnf # protein/gene name is from header line for entry # (strip the ">" and go to the first space) - if(is.null(id)) id <- as.character(palply(1:length(i), function(j) { + if(is.null(id)) id <- as.character(palply("", 1:length(i), function(j) { # get the text of the line f1 <- linefun(i[j],i[j]) # stop if the first character is not ">" @@ -206,7 +206,7 @@ return(count) } # counts for each sequence - a <- palply(seq, countfun, start, stop) + a <- palply("", seq, countfun, start, stop) a <- t(as.data.frame(a, optional=TRUE)) # clean up row/column names colnames(a) <- letts Modified: pkg/CHNOSZ/R/util.program.R =================================================================== --- pkg/CHNOSZ/R/util.program.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/util.program.R 2015-06-09 10:21:09 UTC (rev 88) @@ -17,17 +17,20 @@ return(name) } -palply <- function(X, FUN, ...) { - # a wrapper function to run parLapply if length(X) > 10000 +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) > 10000 & "parallel" %in% (.packages())) { - # the calculations - modified from ?parLapply - ## Use option mc.cores to choose an appropriate cluster size. - # or detectCores if that is NULL, and set max at 2 for now - # (to be nice to CRAN etc.) - nCores <- max(getOption("mc.cores", parallel::detectCores()), 2) + if(length(X) >= get("thermo")$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"), 2) # don't load methods package, to save startup time - ?makeCluster cl <- parallel::makeCluster(nCores, methods=FALSE) + # export the variables and notify the user + if(! "" %in% varlist) parallel::clusterExport(cl, varlist) + msgout(paste("palply:", caller.name(4), "running", length(X), "calculations on", + nCores, "cores with variable(s)", paste(varlist, collapse=", "), "\n")) + # run the calculations out <- parallel::parLapply(cl, X, FUN, ...) parallel::stopCluster(cl) } else out <- lapply(X, FUN, ...) Added: pkg/CHNOSZ/R/util.water.R =================================================================== --- pkg/CHNOSZ/R/util.water.R (rev 0) +++ pkg/CHNOSZ/R/util.water.R 2015-06-09 10:21:09 UTC (rev 88) @@ -0,0 +1,181 @@ +# CHNOSZ/util.water.R + +WP02.auxiliary <- function(property='rho.liquid',T=298.15) { + # auxiliary equations for liquid-vapor phase boundary + # from Wagner and Pruss, 2002 + # critical point + T.critical <- 647.096 # K + P.critical <- 22.064 # MPa + rho.critical <- 322 # kg m-3 + + if(property %in% c("P.sigma","dP.sigma.dT")) { + # vapor pressure + V <- 1 - T / T.critical # theta (dimensionless) + a1 <- -7.85951783 + a2 <- 1.84408259 + a3 <- -11.7866497 + a4 <- 22.6807411 + a5 <- -15.9618719 + a6 <- 1.80122502 + ln.P.sigma.P.critical <- T.critical / T * + ( a1*V + a2*V^1.5 + a3*V^3 + a4*V^3.5 + a5*V^4 + a6*V^7.5 ) + P.sigma <- P.critical * exp(ln.P.sigma.P.critical) + if(property=="dP.sigma.dT") out <- - P.sigma / T * ( ln.P.sigma.P.critical + + a1 + 1.5*a2*V^0.5 + 3*a3*V^2 + 3.5*a4*V^2.5 + 4*a5*V^3 + 7.5*a6*V^6.5 ) + else out <- P.sigma + } else if(property=="rho.liquid") { + # saturated liquid density + V <- 1 - T / T.critical + b1 <- 1.99274064 + b2 <- 1.09965342 + b3 <- -0.510839303 + b4 <- -1.75493479 + b5 <- -45.5170352 + b6 <- -6.74694450E5 + rho.liquid <- rho.critical * ( + 1 + b1*V^(1/3) + b2*V^(2/3) + b3*V^(5/3) + b4*V^(16/3) + b5*V^(43/3) + b6*V^(110/3) ) + out <- rho.liquid + } else if(property=="rho.vapor") { + # saturated vapor density + V <- 1 - T / T.critical + c1 <- -2.03150240 + c2 <- -2.68302940 + c3 <- -5.38626492 + c4 <- -17.2991605 + c5 <- -44.7586581 + c6 <- -63.9201063 + rho.vapor <- rho.critical * exp ( + c1*V^(2/6) + c2*V^(4/6) + c3*V^(8/6) + c4*V^(18/6) + c5*V^(37/6) + c6*V^(71/6) ) + out <- rho.vapor + } else stop(paste('i can not calculate',property)) + return(out) +} + +# return a density in kg m-3 +# corresponding to the given pressure (bar) and temperature (K) +rho.IAPWS95 <- function(T=298.15, P=1, state="", trace=0) { + # function for which to find a zero + dP <- function(rho, T, P.MPa) IAPWS95("P", rho=rho, T=T)[, 1] - P.MPa + # convert bar to MPa + P.MPa <- convert(P, "MPa") + rho <- numeric() + T.critical <- 647.096 # K + P.critical <- 22.064 # MPa + for(i in 1:length(T)) { + Psat <- WP02.auxiliary("P.sigma", T[i]) + if(T[i] > T.critical) { + # above critical temperature + interval <- c(0.1, 1) + extendInt <- "upX" + if(trace > 0) msgout("supercritical (T) ") + } else if(P.MPa[i] > P.critical) { + # above critical pressure + rho.sat <- WP02.auxiliary("rho.liquid", T=T[i]) + interval <- c(rho.sat, rho.sat + 1) + extendInt <- "upX" + if(trace > 0) msgout("supercritical (P) ") + } else if(P.MPa[i] <= 0.9999*Psat) { + # steam + rho.sat <- WP02.auxiliary("rho.vapor", T=T[i]) + interval <- c(rho.sat*0.1, rho.sat) + extendInt <- "upX" + if(trace > 0) msgout("steam ") + } else if(P.MPa[i] >= 1.00005*Psat) { + # water + rho.sat <- WP02.auxiliary("rho.liquid", T=T[i]) + interval <- c(rho.sat, rho.sat + 1) + extendInt <- "upX" + if(trace > 0) msgout("water ") + } else if(!state %in% c("liquid", "vapor")) { + # we're close to the saturation curve; + # calculate rho and G for liquid and vapor and return rho for stable phase + if(trace > 0) msgout("close to saturation; trying liquid and vapor\n") + rho.liquid <- rho.IAPWS95(T[i], P[i], state="liquid", trace=trace) + rho.vapor <- rho.IAPWS95(T[i], P[i], state="vapor", trace=trace) + G.liquid <- IAPWS95("G", rho=rho.liquid, T=T[i]) + G.vapor <- IAPWS95("G", rho=rho.vapor, T=T[i]) + if(G.liquid < G.vapor) { + this.rho <- rho.liquid + if(trace > 0) msgout(paste0("G.liquid(", G.liquid, ") < G.vapor(", G.vapor, ")\n")) + } else { + this.rho <- rho.vapor + if(trace > 0) msgout(paste0("G.vapor(", G.vapor, ") < G.liquid (", G.liquid, ")\n")) + } + rho <- c(rho, this.rho) + next + } else { + # we are looking at a specific state + if(trace > 0) msgout(paste("specified state:", state, " ")) + if(state=="vapor") rho0 <- WP02.auxiliary("rho.vapor", T[i]) + else if(state=="liquid") rho0 <- WP02.auxiliary("rho.liquid", T[i]) + # a too-big range may cause problems e.g. + # interval <- c(rho0*0.9, rho0*1.1) fails for T=253.15, P=1 + interval <- c(rho0*0.95, rho0*1.05) + # if P on the initial interval are both higher or lower than target P, + # set the direction of interval extension + P.init <- IAPWS95("P", rho=interval, T=c(T[i], T[i]))[, 1] + if(all(P.init < P.MPa[i])) extendInt <- "downX" + else if(all(P.init > P.MPa[i])) extendInt <- "upX" + else extendInt <- "yes" + } + if(trace > 0) msgout(paste0("T=", T[i], " P=", P[i], " rho=[", interval[1], ",", interval[2], "]\n")) + this.rho <- try(uniroot(dP, interval, extendInt=extendInt, trace=trace, T=T[i], P.MPa=P.MPa[i])$root, TRUE) + if(!is.numeric(this.rho)) { + warning("rho.IAPWS95: problems finding density at ", T[i], " K and ", P[i], " bar", call.=FALSE) + this.rho <- NA + } + rho <- c(rho, this.rho) + } + return(rho) +} + +water.AW90 <- function(T=298.15,rho=1000,P=0.1) { + # Equations for the dielectric constant of water + # from Archer and Wang, 1990 + # T in K + # rho in kg m-3 + # p in MPa + + # Table 2 + b <- c(-4.044525E-2, 103.6180 , 75.32165 , + -23.23778 ,-3.548184 ,-1246.311 , + 263307.7 ,-6.928953E-1,-204.4473) + alpha <- 18.1458392E-30 # m^3 + #alpha <- 14.7E-30 + mu <- 6.1375776E-30 # C m + N.A <- 6.0221367E23 # mol-1 + k <- 1.380658E-23 # Boltzmann constant, J K-1 + M <- 0.0180153 # kg mol-1 + rho.0 <- 1000 # kg m-3 + # Equation 1 + epsilon.0 <- 8.8541878E-12 # permittivity of vacuum, C^2 J-1 m-1 + #epsfun.lhs <- function(e) (e-1)*(2*e+1)/(9*e) + epsfun.rhs <- function(T,V.m) N.A*(alpha+mufun()/(3*epsilon.0*k*T))/(3*V.m) + #epsfun <- function(e,T,V.m) epsfun.lhs(e) - epsfun.rhs(T,V.m) + mufun <- function() gfun()*mu^2 + gfun <- function() rhofun()*rho/rho.0 + 1 + # Equation 3 + rhofun <- function() b[1]*P*T^-1 + b[2]*T^-0.5 + b[3]*(T-215)^-1 + + b[4]*(T-215)^-0.5 + b[5]*(T-215)^-0.25 + + exp(b[6]*T^-1 + b[7]*T^-2 + b[8]*P*T^-1 + b[9]*P*T^-2) + epsilon <- function(T,rho) { + #tu <- try(uniroot(epsfun,c(1E-1,1E3),T=T,V.m=M/rho)$root,TRUE) + epspoly <- function() epsfun.rhs(T,V.m=M/rho) + tu <- (9*epspoly() + 1 + ((9*epspoly()+1)*(9*epspoly()+1) + 8)^0.5) / 4 #Marc Neveu added 4/24/2013 + if(!is.numeric(tu)) { + warning('water.AW90: no root for density at ',T,' K and ',rho,' kg m-3.',call.=FALSE,immediate.=TRUE) + tu <- NA + } + return(tu) + } + # get things the right length + our.T <- T; our.rho <- rho; our.P <- P + t <- numeric() + for(i in 1:length(our.T)) { + T <- our.T[i] + rho <- our.rho[i] + P <- our.P[i] + t <- c(t,epsilon(T,rho)) + } + return(t) +} Modified: pkg/CHNOSZ/R/water.R =================================================================== --- pkg/CHNOSZ/R/water.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/R/water.R 2015-06-09 10:21:09 UTC (rev 88) @@ -2,57 +2,6 @@ # calculate thermodynamic and electrostatic properties of H2O # 20061016 jmd -water.AW90 <- function(T=298.15,rho=1000,P=0.1) { - # Equations for the dielectric constant of water - # from Archer and Wang, 1990 - # T in K - # rho in kg m-3 - # p in MPa - - # Table 2 - b <- c(-4.044525E-2, 103.6180 , 75.32165 , - -23.23778 ,-3.548184 ,-1246.311 , - 263307.7 ,-6.928953E-1,-204.4473) - alpha <- 18.1458392E-30 # m^3 - #alpha <- 14.7E-30 - mu <- 6.1375776E-30 # C m - N.A <- 6.0221367E23 # mol-1 - k <- 1.380658E-23 # Boltzmann constant, J K-1 - M <- 0.0180153 # kg mol-1 - rho.0 <- 1000 # kg m-3 - # Equation 1 - epsilon.0 <- 8.8541878E-12 # permittivity of vacuum, C^2 J-1 m-1 - #epsfun.lhs <- function(e) (e-1)*(2*e+1)/(9*e) - epsfun.rhs <- function(T,V.m) N.A*(alpha+mufun()/(3*epsilon.0*k*T))/(3*V.m) - #epsfun <- function(e,T,V.m) epsfun.lhs(e) - epsfun.rhs(T,V.m) - mufun <- function() gfun()*mu^2 - gfun <- function() rhofun()*rho/rho.0 + 1 - # Equation 3 - rhofun <- function() b[1]*P*T^-1 + b[2]*T^-0.5 + b[3]*(T-215)^-1 + - b[4]*(T-215)^-0.5 + b[5]*(T-215)^-0.25 + - exp(b[6]*T^-1 + b[7]*T^-2 + b[8]*P*T^-1 + b[9]*P*T^-2) - epsilon <- function(T,rho) { - #tu <- try(uniroot(epsfun,c(1E-1,1E3),T=T,V.m=M/rho)$root,TRUE) - epspoly <- function() epsfun.rhs(T,V.m=M/rho) - tu <- (9*epspoly() + 1 + ((9*epspoly()+1)*(9*epspoly()+1) + 8)^0.5) / 4 #Marc Neveu added 4/24/2013 - if(!is.numeric(tu)) { - warning('water.AW90: no root for density at ',T,' K and ',rho,' kg m-3.',call.=FALSE,immediate.=TRUE) - tu <- NA - } - return(tu) - } - # get things the right length - our.T <- T; our.rho <- rho; our.P <- P - t <- numeric() - for(i in 1:length(our.T)) { - T <- our.T[i] - rho <- our.rho[i] - P <- our.P[i] - t <- c(t,epsilon(T,rho)) - } - return(t) -} - water <- function(property = NULL, T = get("thermo")$opt$Tr, P = "Psat") { # calculate the properties of liquid H2O as a function of T and P # T in Kelvin, P in bar @@ -192,43 +141,6 @@ return(w.out[, iprop, drop=FALSE]) } -rho.IAPWS95 <- function(T=298.15, P=1) { - # return a density in kg m-3 - # corresponding to the given pressure (bar) and temperature (K) - if(identical(P, "Psat")) stop("this function doesn't take P='Psat'") - dP <- function(rho, T, P) { - dP <- IAPWS95("P", rho=rho, T=T)[, 1] - convert(P, "MPa") - return(dP) - } - rho <- numeric() - for(i in 1:length(T)) { - if(T[i] < 647.096) { - rho.lower <- WP02.auxiliary('rho.liquid',T=T[i])-2 - rho.upper <- rho.lower + 400 - if(P[i] < 5000) rho.upper <- rho.lower + 300 - if(P[i] < 1000) rho.upper <- rho.lower + 200 - if(P[i] < 300) { - rho.upper <- rho.lower + 30 - if(T[i] < 250) { #Marc Neveu added 4/23/2013 - rho.lower <- rho.lower - 10 - rho.upper <- rho.lower + 40 - } - } - } else { - rho.lower <- 0.01 - rho.upper <- 1200 - } - this.rho <- try(uniroot(dP, c(rho.lower, rho.upper), T=T[i], P=P[i])$root, TRUE) - if(!is.numeric(this.rho)) { - warning("rho.IAPWS95: no root for density between ", round(rho.lower, 1), - " and ", round(rho.upper, 1), " kg m-3 at ", T[i], " K and ", P[i], " bar", call.=FALSE) - this.rho <- NA - } - rho <- c(rho, this.rho) - } - return(rho) -} - water.IAPWS95 <- function(property, T=298.15, P=1) { # to get the properties of water via IAPWS-95 msgout(paste("water.IAPWS95: calculating", length(T), "values for")) @@ -373,7 +285,7 @@ # calculate values of P for Psat if(identical(P, "Psat")) P <- psat() msgout(" rho") - my.rho <- rho.IAPWS95(T, P) + my.rho <- rho.IAPWS95(T, P, get("thermo")$opt$IAPWS95.Psat.state) rho <- function() my.rho } for(i in 1:length(property)) { Modified: pkg/CHNOSZ/data/opt.csv =================================================================== --- pkg/CHNOSZ/data/opt.csv 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/data/opt.csv 2015-06-09 10:21:09 UTC (rev 88) @@ -1,2 +1,2 @@ -Tr,Pr,Theta,Psi,R,cutoff,E.units,T.units,P.units,state,water,G.tol,Cp.tol,V.tol,varP -298.15,1,228,2600,1.9872,1e-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE +Tr,Pr,Theta,Psi,R,cutoff,E.units,T.units,P.units,state,water,G.tol,Cp.tol,V.tol,varP,IAPWS95.Psat.state,paramin +298.15,1,228,2600,1.9872,1e-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE,liquid,1000 Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/demo/00Index 2015-06-09 10:21:09 UTC (rev 88) @@ -1,6 +1,6 @@ sources cross-check the reference list with the thermodynamic database NaCl equilibrium constant for aqueous NaCl dissociation -cordierite equilibrium constant of hydrous cordierite dehydration +density density of H2O, inverted from IAPWS-95 equations phosphate phosphate speciation with pH, temperature and ionic strength nucleobase relative stabilities of nucleobases and some amino acids orp oxidation-reduction potential of redox standards as a function of temperature Deleted: pkg/CHNOSZ/demo/cordierite.R =================================================================== --- pkg/CHNOSZ/demo/cordierite.R 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/demo/cordierite.R 2015-06-09 10:21:09 UTC (rev 88) @@ -1,19 +0,0 @@ -### 1-D property plot -## for hydrous cordierite = cordierite + H2O -## after Helgeson et al., 1978 -## (Summary and critique of the thermodynamic properties of -## rock-forming minerals. Am. J. Sci., 278-A, 1-229) -basis(c("cordierite,hydrous","Mg+2","SiO2","H2O","O2","H+")) -species("cordierite") -# water.SUPCRT92 can only get us up to 5000 bar -# (lines for 7000 and 10000 bar are in the original diagram) -P <- c(1,2,3,5)*1000 -col <- rainbow(length(P)) -for(i in 1:length(P)) { - a <- affinity(property="logK",T=c(20,800),P=P[i]) - diagram(a,add=(i!=1),ylim=c(-4,2),legend.x=NULL, - col=col[i],main="") -} -legend("topright",lty=1,col=col,legend=paste(P,"bar")) -title(main=paste("hydrous cordierite = cordierite + H2O", - "After Helgeson et al., 1978",sep="\n"),cex.main=0.9) Added: pkg/CHNOSZ/demo/density.R =================================================================== --- pkg/CHNOSZ/demo/density.R (rev 0) +++ pkg/CHNOSZ/demo/density.R 2015-06-09 10:21:09 UTC (rev 88) @@ -0,0 +1,90 @@ +# make T-P diagram for H2O, colored according to density + +# IAPWS95 or SUPCRT92 +method <- "IAPWS95" +# low or high T,P range +TPrange <- "low" + +blue <- "blue" +if(TPrange=="low") { + T <- seq(300, 700, 5) + P <- seq(1, 351, 5) + bias <- 1.68 +} else { + # upper T,P limit for SUPCRT92: 2250 degC, 30000 bar + T <- seq(273, 2523, 50) + P <- seq(1, 30000, length.out=50) + # to attempt to match the colors using the different methods + # (ranges are different because IAPWS95 reports higher density in + # the high-P, low-T region, where SUPCRT92 doesn't give output) + if(method=="IAPWS95") bias <- 2.2 + else if(method=="SUPCRT92") { + bias <- 2.1 + blue <- "#0d0dff" + } +} +TP <- expand.grid(T=T, P=P) +if(method=="IAPWS95") { + # the following should trigger parallel calculations + # if nrow(TP) (5751 for TPrange="low") is >= thermo$opt$paramin (default 1000) + rho <- palply("TP", 1:nrow(TP), function(i){CHNOSZ::rho.IAPWS95(TP$T[i], TP$P[i])}) +} else if(method=="SUPCRT92") { + rho <- water.SUPCRT92("rho", TP$T, TP$P) + # water.SUPCRT92 returns 0 when the density can't be calculated + rho[rho==0] <- NA +} +rho.num <- unlist(rho) +rho.mat <- matrix(rho.num, nrow=length(T), ncol=length(P)) +# blueest for most dense, reddest for least dense +# bias is adjusted to white for the critical density +ncol <- 100 +col <- colorRampPalette(c("red", "white", blue), bias=bias)(ncol) +# first make a background image (for debugging - +# will be visible only if some density calculations fail) +fill.mat <- matrix(0, nrow=length(T), ncol=length(P)) +image(T, P, fill.mat, col="black", xlab=axis.label("T", "K"), ylab=axis.label("P")) +# now plot densities +image(T, P, rho.mat, col=col, add=TRUE) +# add a title and calculate saturation line +if(method=="IAPWS95") { + title(main=expression("Density of"~H[2]*O~"inverted from IAPWS-95 equations")) + title(main=expression("Line calculated using auxiliary equations for saturation"), line=0.8) + Psat <- convert(WP02.auxiliary("P.sigma", T), "bar") +} else if(method=="SUPCRT92") { + title(main=expression("Density of"~H[2]*O~"calculated using SUPCRT92")) + Psat <- water.SUPCRT92("Psat", T, "Psat")[,1] +} +# plot saturation line +lines(T, Psat, lwd=6) +lines(T, Psat, lwd=3, col="gold") +# add a color key +if(TPrange=="low") { + x <- c(333, 366, 370) + y <- c(100, 300) +} else if(TPrange=="high") { + x <- c(600, 780, 800) + y <- c(10000, 25000) +} +ykey <- seq(y[1], y[2], length.out=ncol+1) +for(i in 1:ncol) rect(x[1], ykey[i], x[2], ykey[i+1], col=col[i], border=NA) +rect(x[1], ykey[1], x[2], rev(ykey)[1]) +# label the extrema +rrange <- range(rho.num, na.rm=TRUE) +text(x[3], ykey[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[1], 4)))), adj=0) +text(x[3], rev(ykey)[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[2], 4)))), adj=0) +# label the critical density +rlevels <- seq(rrange[1], rrange[2], length.out=ncol+1) +rho.critical <- 322 +icrit <- which.min(abs(rlevels-rho.critical)) +text(x[3], ykey[icrit], as.expression(substitute(x~kg/m^3~group("(", rho[c], ")"), list(x=rho.critical))), adj=0) + +#if(method=="IAPWS95") { +# # the saturation line is very accurate but not quite perfect; +# # we can show whether it is on the liquid or vapor side +# ina <- is.na(P.sigma) +# rho.sigma <- rho.IAPWS95(T[!ina], P.sigma[!ina]) +# col <- rep("blue", length(rho.sigma)) +# col[rho.sigma < 322] <- "red" +# points(T[!ina], P.sigma[!ina], col=col, pch=20) +#} + Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/inst/NEWS 2015-06-09 10:21:09 UTC (rev 88) @@ -1,3 +1,28 @@ +CHANGES IN CHNOSZ 1.0.5-1 (2015-06-09) +-------------------------------------- + +- Rewrite rho.IAPWS95() to be able to invert density from IAPWS-95 + equations for a more extensive range of T,P values. + +- Update R dependency to R-3.1.0, needed for 'extendInt' argument + of uniroot() (used by rho.IAPWS95()). + +- Add demo/density.R to show density of H2O calculated using + rho.IAPWS95() (optionally using water.SUPCRT92()). + +- Remove the relatively trivial demo/cordierite.R. + +- Update wrapper function for parallel calculations palply() (export of + variables, used in demo/density.R) and add tests in + test-util.program.R. + +- Tests that initiate calls to palply() (and therefore makeCluster()) + failed with 'cannot open file 'startup.Rs': No such file or directory' + Fixed by adding Sys.setenv("R_TESTS" = "") to test-all.R. + Issue discussed here: + https://github.com/hadley/testthat/issues/129 + https://github.com/hadley/testthat/issues/144 + CHANGES IN CHNOSZ 1.0.5 (2015-05-19) ------------------------------------ Added: pkg/CHNOSZ/inst/tests/test-util.program.R =================================================================== --- pkg/CHNOSZ/inst/tests/test-util.program.R (rev 0) +++ pkg/CHNOSZ/inst/tests/test-util.program.R 2015-06-09 10:21:09 UTC (rev 88) @@ -0,0 +1,28 @@ +context("util.program") + +# these tests are inefficient uses of parallelization +# (overhead is greater than the savings from multiple cores) +# just here to test that the functions are working + +test_that("palply() launches calculations on multiple cores", { + if(min(getOption("mc.cores"), 2) > 1 & parallel::detectCores() > 1) { + x <- 1:1001 + # for this we don't have to export any variables so varlist="" + expect_message(palply("", 1:length(x), function(i) i^2), "running 1001 calculations") + } +}) + +test_that("other functions are calling palply() properly", { + if(min(getOption("mc.cores"), 2) > 1 & parallel::detectCores() > 1) { + ff <- system.file("extdata/fasta/HTCC1062.faa.xz", package="CHNOSZ") + expect_message(aa <- read.fasta(ff), "read.fasta running 1354 calculations") + # ^^^ also messaged: count.aa running 1354 calculations + ip <- add.protein(aa) + basis("CHNOS") + expect_message(a <- affinity(O2=c(-90, -60, 1000), iprotein=ip), "affinity running 1354 calculations") + expect_message(e <- equilibrate(a), "equil.reaction running 1000 calculations") + expect_message(e <- equilibrate(a, normalize=TRUE), "equil.boltzmann running 1354 calculations") + # ^^^ above message repeated 2x + } +}) + Modified: pkg/CHNOSZ/man/CHNOSZ-package.Rd =================================================================== --- pkg/CHNOSZ/man/CHNOSZ-package.Rd 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/man/CHNOSZ-package.Rd 2015-06-09 10:21:09 UTC (rev 88) @@ -82,7 +82,8 @@ \section{Compatibility}{ - As of version 1.0.4, the package depends on \R version 3.0.0 or greater (previous versions use \code{\link{Stangle}} to extract R code from vignettes when installing the source package, leading to failure processing hotspring.Rnw, which now uses knitr instead of Sweave). + Starting with version 1.0.5-1, the package depends on \R version 3.1.0 or greater (for \code{extendInt} argument of \code{\link{uniroot}}, used in code{\link{rho.IAPWS95}}). + As of version 1.0.4 (release 1.0.5 on CRAN), the package depends on \R version 3.0.0 or greater (previous versions use \code{\link{Stangle}} to extract R code from vignettes when installing the source package, leading to failure processing hotspring.Rnw, which now uses knitr instead of Sweave). Before version 1.0.4, the recommended version of \R was 2.14.0 or greater (to find vignettes in the \code{vignettes} directory, and for availability of \pkg{parallel} in the standard library). As of version 0.9-9, the package depends on \R version 2.12.0 or greater (so useDynLib in the NAMESPACE can find the shared library on Windows). Starting with version 0.9-6 of the package, the dependency was given as \R version 2.10.0 or greater (to read compressed data files). Modified: pkg/CHNOSZ/man/IAPWS95.Rd =================================================================== --- pkg/CHNOSZ/man/IAPWS95.Rd 2015-05-19 14:38:46 UTC (rev 87) +++ pkg/CHNOSZ/man/IAPWS95.Rd 2015-06-09 10:21:09 UTC (rev 88) @@ -3,7 +3,6 @@ \alias{IAPWS95} \alias{IAPWS95.idealgas} \alias{IAPWS95.residual} -\alias{WP02.auxiliary} \title{Properties of Water from IAPWS-95} \description{ Calculate thermodynamic properties of water following the IAPWS-95 formulation. @@ -13,7 +12,6 @@ IAPWS95(property, T = 298.15, rho = 1000) IAPWS95.idealgas(p, delta, tau) IAPWS95.residual(p, delta, tau) - WP02.auxiliary(property, T = 298.15) } \arguments{ @@ -32,8 +30,6 @@ The \code{IAPWS95} function returns values of thermodynamic properties in specific units (per gram). [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/chnosz -r 88 From noreply at r-forge.r-project.org Sat Jun 13 19:27:57 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jun 2015 19:27:57 +0200 (CEST) Subject: [CHNOSZ-commits] r89 - in pkg/CHNOSZ: . R demo inst inst/tests man Message-ID: <20150613172757.4C37B185157@r-forge.r-project.org> Author: jedick Date: 2015-06-13 19:27:56 +0200 (Sat, 13 Jun 2015) New Revision: 89 Added: pkg/CHNOSZ/demo/ORP.R pkg/CHNOSZ/inst/tests/test-mosaic.R pkg/CHNOSZ/inst/tests/test-util.list.R Removed: pkg/CHNOSZ/demo/orp.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/diagram.R pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/iprotein.R pkg/CHNOSZ/R/mosaic.R pkg/CHNOSZ/R/util.list.R pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/demo/density.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/inst/tests/test-iprotein.R pkg/CHNOSZ/man/examples.Rd Log: fix mosaic() to scale affinities by relative abundances of basis species Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/DESCRIPTION 2015-06-13 17:27:56 UTC (rev 89) @@ -1,6 +1,6 @@ -Date: 2015-06-09 +Date: 2015-06-13 Package: CHNOSZ -Version: 1.0.5-1 +Version: 1.0.5-2 Title: Chemical Thermodynamics and Activity Diagrams Author: Jeffrey Dick Maintainer: Jeffrey Dick Modified: pkg/CHNOSZ/R/diagram.R =================================================================== --- pkg/CHNOSZ/R/diagram.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/R/diagram.R 2015-06-13 17:27:56 UTC (rev 89) @@ -150,7 +150,6 @@ else if(as.residue & eout.is.aout) pv[[i]] <- pv[[i]] + eout$species$logact[i] / n.balance[i] } predominant <- which.pmax(pv) - dim(predominant) <- dim(pv[[1]]) } # a warning about that we can only show properties of the first species on a 2-D diagram Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/R/examples.R 2015-06-13 17:27:56 UTC (rev 89) @@ -30,7 +30,7 @@ } demos <- function(which=c("sources", "NaCl", "density", - "phosphate", "nucleobase", "orp", "diagram", "revisit", "findit", + "phosphate", "nucleobase", "ORP", "diagram", "revisit", "findit", "CO2Ac", "nonideal", "ionize", "buffer", "yeastgfp", "mosaic", "solubility", "wjd"), do.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one Modified: pkg/CHNOSZ/R/iprotein.R =================================================================== --- pkg/CHNOSZ/R/iprotein.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/R/iprotein.R 2015-06-13 17:27:56 UTC (rev 89) @@ -171,7 +171,12 @@ # now we're ready to go tp.new <- thermo$protein if(!all(ipdup)) tp.new <- rbind(tp.new, aa[!ipdup, ]) - if(any(ipdup)) tp.new[ip[ipdup], ] <- aa[ipdup, ] + if(any(ipdup)) { + if(any(sapply(1:4, function(i){is.factor(aa[, i])}))) + stop(paste("converting factors causes problems replacing protein data", + " data file should be read using e.g. aa <- read.csv(file, stringsAsFactors=FALSE)", sep="\n")) + tp.new[ip[ipdup], ] <- aa[ipdup, ] + } rownames(tp.new) <- NULL thermo$protein <- tp.new assign("thermo", thermo, "CHNOSZ") Modified: pkg/CHNOSZ/R/mosaic.R =================================================================== --- pkg/CHNOSZ/R/mosaic.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/R/mosaic.R 2015-06-13 17:27:56 UTC (rev 89) @@ -58,12 +58,14 @@ if(blend) { # calculate affinities using relative abundances of basis species e <- equilibrate(A.bases) + # what is the total activity of the basis species? + loga.tot <- sum(10^unlist(e$loga.equil)) for(j in seq_along(affs)) { for(i in seq_along(A.species$values)) { # start with zero affinity if(j==1) A.species$values[[i]][] <- 0 - # add affinity scaled by relative abundance of this basis species - A.species$values[[i]] <- A.species$values[[i]] + affs[[j]]$values[[i]] * 10^e$loga.equil[[j]] + # add affinity scaled by __relative__ abundance of this basis species + A.species$values[[i]] <- A.species$values[[i]] + affs[[j]]$values[[i]] * 10^e$loga.equil[[j]]/loga.tot } } } else { Modified: pkg/CHNOSZ/R/util.list.R =================================================================== --- pkg/CHNOSZ/R/util.list.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/R/util.list.R 2015-06-13 17:27:56 UTC (rev 89) @@ -3,6 +3,7 @@ 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]]) 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]] @@ -11,29 +12,31 @@ mmm <- as.vector(elts[[1]]) which.mmm <- rep(1,length(elts[[1]])) has.na <- FALSE - 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]]) + 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] } - 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] } - mostattributes(mmm) <- attributes(elts[[1]]) + mostattributes(which.mmm) <- keepattr which.mmm } Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/demo/00Index 2015-06-13 17:27:56 UTC (rev 89) @@ -3,7 +3,7 @@ density density of H2O, inverted from IAPWS-95 equations phosphate phosphate speciation with pH, temperature and ionic strength nucleobase relative stabilities of nucleobases and some amino acids -orp oxidation-reduction potential of redox standards as a function of temperature +ORP oxidation-reduction potential of redox standards as a function of temperature diagram comparison of methods for calculating stability fields revisit detailed example of usage of revisit() findit detailed example of usage of findit() Copied: pkg/CHNOSZ/demo/ORP.R (from rev 60, pkg/CHNOSZ/demo/orp.R) =================================================================== --- pkg/CHNOSZ/demo/ORP.R (rev 0) +++ pkg/CHNOSZ/demo/ORP.R 2015-06-13 17:27:56 UTC (rev 89) @@ -0,0 +1,160 @@ +# yell2010/orp.R 20100715 jmd +# calculate the temperature dependence of +# potentials vs. standard hydrogen electrode (SHE) of various electrodes (Ag/AgCl) +# and ORP standards (ZoBell, Light's, (tri)iodide) +# CHNOSZ provides functions subcrt() and convert() +# used in this example +#require(CHNOSZ) +# Bard et al.'s fit to the potential +# (Bard, Parson, Jordan, Standard Potentials In Aqueous Solution, 1985) +AgAgCl.Bard <- function(T,high.T=TRUE) { + # we use the corrected high-T formula from wikipedia + if(high.T) return(0.23737 - 5.3783e-4 * T - 2.3728e-6 * T^2 - 2.2671e-9 * (T+273)) + else return(0.23695 - 4.8564e-4 * T - 3.4205e-6 * T^2 - 5.869e-9 * (T+273)) +} +# function to calculate the potential of Ag/AgCl vs. SHE +# Ag(s) + Cl- = AgCl(s) + e- +# logK = -pe - logaCl +# pe = -logK - logmCl - loggamCl +# ORP = RT/F * (logK - logmCl - loggamCl) +AgAgCl <- function(T,mKCl=4) { + # mKCl is the molality of KCl in the electrolyte + # we take it as a first approximation to be equal to + # the molality of Cl- (and to the ionic strength) + logmCl <- log10(mKCl) + # get the logK for the reaction + logK <- subcrt(c("Ag","Cl-","AgCl","e-"),c(-1,-1,1,1),c("cr","aq","cr","aq"),T=T)$out$logK + # get the activity coefficient for Cl- + loggamCl <- subcrt("Cl-",T=T,IS=mKCl)$out[[1]]$loggam + # get the pe for the solution + pe <- -logK - logmCl - loggamCl + # convert that to Eh + Eh <- convert(pe,"Eh",T=convert(T,"K")) + return(Eh) +} +ZoBell <- function(T) { + # doesn't work very well because we ignore the + # ferricyanide and ferrocyanide complexes + # Fe+2 = Fe+3 + e- + # logK = logaFe3 - logaFe2 - pe + # get the logK for the reaction + logK <- subcrt(c("Fe+2","Fe+3","e-"),c(-1,1,1),T=T)$out$logK + # we use the recipe from standard methods (table 2580:II) + # 1.4080 g K4Fe(CN)6.3H2O -> 0.0033333 mol Fe+2 + # 1.0975 g K3Fe(CN)6 -> 0.0033333 mol Fe+3 + # 7.4555 g KCl -> 0.1 mol Cl- + logmFe2 <- logmFe3 <- log10(0.0033333) + # get the loggam for the iron species + loggamFe2 <- subcrt("Fe+2",T=T,IS=1)$out[[1]]$loggam + loggamFe3 <- subcrt("Fe+3",T=T,IS=1)$out[[1]]$loggam + # get the pe for the solution + pe <- -logK + logmFe3 + loggamFe3 - logmFe2 - loggamFe2 + # convert to Eh + Eh <- convert(pe,"Eh",T=convert(T,"K")) + return(Eh) +} +ZoBell.table <- function(T=NULL,which=NULL) { + # oxidation-reduction potential of ZoBell's solution + # from Standard Methods for Water and Wastewater or YSI + # (interpolated and/or extrapolated as necessary) + # standard methods (1997) table 2580:I + Eh.T.SMW <- 1:30 + Eh.SMW <- c(0.481,0.479,0.476,0.474,0.472,0.47,0.468,0.465,0.463,0.461, + 0.459,0.457,0.454,0.452,0.45,0.448,0.446,0.443,0.441,0.439,0.437, + 0.435,0.432,0.43,0.428,0.426,0.424,0.421,0.419,0.417) + # from YSI (2005): + # Measuring ORP on YSI 6-Series Sondes: Tips, Cautions and Limitations + # NOTE: these values are vs. Ag/AgCl (4 M KCl) + Eh.T.YSI <- seq(-5,50,by=5) + Eh.YSI <- c(267.0,260.5,254.0,247.5,241.0,234.5,228.0,221.5,215.0,208.5,202.0,195.5)/1000 + # spline function for each of the tables + SMW <- splinefun(Eh.T.SMW,Eh.SMW) + YSI <- splinefun(Eh.T.YSI,Eh.YSI) + # just one of the tables + Eh.fun <- get(which) + Eh.T <- get(paste("Eh.T",which,sep=".")) + if(is.null(T)) T <- Eh.T + return(data.frame(T=T,Eh=Eh.fun(T))) +} +Light <- function(T) { + # this is going to look something like + # Fe+2 = Fe+3 + e- + # logK = logaFe3 - logaFe2 - pe + # get the logK for the reaction + logK <- subcrt(c("Fe+2","Fe+3","e-"),c(-1,1,1),T=T)$out$logK + # we use the recipe from standard methods (table 2580:II) + # 39.21 g Fe(NH4)2(SO4)2(H2O)6 -> 0.1 mol Fe+2 + # 48.22 g Fe(NH4)(SO4)2(H2O)12 -> 0.1 mol Fe+3 + logmFe2 <- logmFe3 <- log10(0.1) + # get the loggam for the iron species + loggamFe2 <- subcrt("Fe+2",T=T,IS=0.2)$out[[1]]$loggam + loggamFe3 <- subcrt("Fe+3",T=T,IS=0.2)$out[[1]]$loggam + # get the pe for the solution + pe <- -logK + logmFe3 + loggamFe3 - logmFe2 - loggamFe2 + # convert to Eh + Eh <- convert(pe,"Eh",T=convert(T,"K")) + return(Eh) +} +Iodide.table <- function(T=NULL) { + # oxidation-reduction potential of Thermo's iodide solution + # from thermo instruction sheet 255218-001 (articlesFile_18739) + T.Iodide <- seq(0,50,5) + Eh.Iodide <- c(438,435,431,428,424,420,415,411,406,401,396)/1000 + Iodide <- splinefun(T.Iodide,Eh.Iodide) + if(is.null(T)) T <- T.Iodide + return(data.frame(T=T,Eh=Iodide(T))) +} +Iodide <- function(T) { + # this is going to look something like + # 3I- = I3- + 2e- + # logK = -2pe + logaI3 - 3logaI + # get the logK for the reaction + logK <- subcrt(c("I-","I3-","e-"),c(-3,1,2),T=T)$out$logK + # could the activities be 0.1 M ... or something else? + logmI <- log10(2) + logmI3 <- log10(0.01) + # get the loggam for the iodine species + loggamI <- subcrt("I-",T=T,IS=0.2)$out[[1]]$loggam + loggamI3 <- subcrt("I3-",T=T,IS=0.2)$out[[1]]$loggam + # get the pe for the solution + pe <- ( -logK + logmI3 + loggamI3 - 3 * (logmI - loggamI) ) / 2 + # convert to Eh + Eh <- convert(pe,"Eh",T=convert(T,"K")) + return(Eh) +} +figure <- function() { + # make some figures + # the temperatures we're interested in + # in degrees C + T <- seq(0,100,5) + # temperature-Eh diagram for various electrodes + thermo.plot.new(ylim=c(0,0.8),xlim=c(0,100), + ylab=axis.label("Eh"),xlab=axis.label("T")) + # the Ag/AgCl electrode (Bard et al. fit) + points(T,AgAgCl.Bard(T),pch=0) + # the Ag/AgCl electrode (equilibrium calculations) + lines(T,AgAgCl(T)) + # ZoBell's solution (SMW table 2580) + SMW <- ZoBell.table(which="SMW") + points(SMW$T,SMW$Eh,pch=1) + # ZoBell's solution (YSI tech report table) + YSI <- ZoBell.table(which="YSI") + # make these values referenced to SHE instead of Ag/AgCl + Eh.YSI <- YSI$Eh + AgAgCl(YSI$T) + points(YSI$T,Eh.YSI,pch=2) + # Light's solution (equilibrium values) + lines(T,Light(T)) + # Light's solution (at 25 degrees only) + points(25,0.475 + 0.200,pch=3) + # Thermo's I-/I3- solution + Thermo <- Iodide.table() + points(Thermo$T,Thermo$Eh,pch=4) + # calculated I-/I3- values + lines(T,Iodide(T)) + # add some labels + text(c(30,30,30,50),c(0.72,0.5,0.35,0.25), + c("Light","ZoBell","(Tri)Iodide","Ag/AgCl")) + title(main="Potentials vs standard hydrogen electrode (SHE)") +} +# finally, make the plot +figure() Modified: pkg/CHNOSZ/demo/density.R =================================================================== --- pkg/CHNOSZ/demo/density.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/demo/density.R 2015-06-13 17:27:56 UTC (rev 89) @@ -7,8 +7,9 @@ blue <- "blue" if(TPrange=="low") { - T <- seq(300, 700, 5) - P <- seq(1, 351, 5) + T <- seq(300, 800, 10) + #P <- seq(1, 600, 11.98) + P <- seq(0, 600, 12) bias <- 1.68 } else { # upper T,P limit for SUPCRT92: 2250 degC, 30000 bar @@ -37,30 +38,31 @@ rho.mat <- matrix(rho.num, nrow=length(T), ncol=length(P)) # blueest for most dense, reddest for least dense # bias is adjusted to white for the critical density -ncol <- 100 +ncol <- 500 col <- colorRampPalette(c("red", "white", blue), bias=bias)(ncol) # first make a background image (for debugging - # will be visible only if some density calculations fail) fill.mat <- matrix(0, nrow=length(T), ncol=length(P)) -image(T, P, fill.mat, col="black", xlab=axis.label("T", "K"), ylab=axis.label("P")) +image(T, P, fill.mat, col="black", xlab=axis.label("T", "K"), ylab=axis.label("P"), useRaster=TRUE, yaxt="n") +axis(2, at=c(1, seq(100, 600, 100))) # now plot densities -image(T, P, rho.mat, col=col, add=TRUE) +image(T, P, rho.mat, col=col, add=TRUE, useRaster=TRUE) # add a title and calculate saturation line if(method=="IAPWS95") { title(main=expression("Density of"~H[2]*O~"inverted from IAPWS-95 equations")) - title(main=expression("Line calculated using auxiliary equations for saturation"), line=0.8) +## title(main=expression("Line calculated using auxiliary equations for saturation"), line=0.8) Psat <- convert(WP02.auxiliary("P.sigma", T), "bar") } else if(method=="SUPCRT92") { title(main=expression("Density of"~H[2]*O~"calculated using SUPCRT92")) Psat <- water.SUPCRT92("Psat", T, "Psat")[,1] } -# plot saturation line -lines(T, Psat, lwd=6) -lines(T, Psat, lwd=3, col="gold") +### plot saturation line +##lines(T, Psat, lwd=6) +##lines(T, Psat, lwd=3, col="gold") # add a color key if(TPrange=="low") { - x <- c(333, 366, 370) - y <- c(100, 300) + x <- c(355, 395, 402) + y <- c(170, 520) } else if(TPrange=="high") { x <- c(600, 780, 800) y <- c(10000, 25000) @@ -70,13 +72,13 @@ rect(x[1], ykey[1], x[2], rev(ykey)[1]) # label the extrema rrange <- range(rho.num, na.rm=TRUE) -text(x[3], ykey[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[1], 4)))), adj=0) -text(x[3], rev(ykey)[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[2], 4)))), adj=0) +text(x[3], ykey[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[1], 4)))), adj=0, col="white") +text(x[3], rev(ykey)[1], as.expression(substitute(x~kg/m^3, list(x=round(rrange[2], 4)))), adj=0, col="white") # label the critical density rlevels <- seq(rrange[1], rrange[2], length.out=ncol+1) rho.critical <- 322 icrit <- which.min(abs(rlevels-rho.critical)) -text(x[3], ykey[icrit], as.expression(substitute(x~kg/m^3~group("(", rho[c], ")"), list(x=rho.critical))), adj=0) +text(x[3], ykey[icrit], as.expression(substitute(x~kg/m^3~group("(", rho[c], ")"), list(x=rho.critical))), adj=0, col="white") #if(method=="IAPWS95") { # # the saturation line is very accurate but not quite perfect; Deleted: pkg/CHNOSZ/demo/orp.R =================================================================== --- pkg/CHNOSZ/demo/orp.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/demo/orp.R 2015-06-13 17:27:56 UTC (rev 89) @@ -1,160 +0,0 @@ -# yell2010/orp.R 20100715 jmd -# calculate the temperature dependence of -# potentials vs. SHE of various electrodes (Ag/AgCl) -# and ORP standards (ZoBell, Light's, (tri)iodide) -# CHNOSZ provides functions subcrt() and convert() -# used in this example -#require(CHNOSZ) -# Bard et al.'s fit to the potential -# (Bard, Parson, Jordan, Standard Potentials In Aqueous Solution, 1985) -AgAgCl.Bard <- function(T,high.T=TRUE) { - # we use the corrected high-T formula from wikipedia - if(high.T) return(0.23737 - 5.3783e-4 * T - 2.3728e-6 * T^2 - 2.2671e-9 * (T+273)) - else return(0.23695 - 4.8564e-4 * T - 3.4205e-6 * T^2 - 5.869e-9 * (T+273)) -} -# function to calculate the potential of Ag/AgCl vs. SHE -# Ag(s) + Cl- = AgCl(s) + e- -# logK = -pe - logaCl -# pe = -logK - logmCl - loggamCl -# ORP = RT/F * (logK - logmCl - loggamCl) -AgAgCl <- function(T,mKCl=4) { - # mKCl is the molality of KCl in the electrolyte - # we take it as a first approximation to be equal to - # the molality of Cl- (and to the ionic strength) - logmCl <- log10(mKCl) - # get the logK for the reaction - logK <- subcrt(c("Ag","Cl-","AgCl","e-"),c(-1,-1,1,1),c("cr","aq","cr","aq"),T=T)$out$logK - # get the activity coefficient for Cl- - loggamCl <- subcrt("Cl-",T=T,IS=mKCl)$out[[1]]$loggam - # get the pe for the solution - pe <- -logK - logmCl - loggamCl - # convert that to Eh - Eh <- convert(pe,"Eh",T=convert(T,"K")) - return(Eh) -} -ZoBell <- function(T) { - # doesn't work very well because we ignore the - # ferricyanide and ferrocyanide complexes - # Fe+2 = Fe+3 + e- - # logK = logaFe3 - logaFe2 - pe - # get the logK for the reaction - logK <- subcrt(c("Fe+2","Fe+3","e-"),c(-1,1,1),T=T)$out$logK - # we use the recipe from standard methods (table 2580:II) - # 1.4080 g K4Fe(CN)6.3H2O -> 0.0033333 mol Fe+2 - # 1.0975 g K3Fe(CN)6 -> 0.0033333 mol Fe+3 - # 7.4555 g KCl -> 0.1 mol Cl- - logmFe2 <- logmFe3 <- log10(0.0033333) - # get the loggam for the iron species - loggamFe2 <- subcrt("Fe+2",T=T,IS=1)$out[[1]]$loggam - loggamFe3 <- subcrt("Fe+3",T=T,IS=1)$out[[1]]$loggam - # get the pe for the solution - pe <- -logK + logmFe3 + loggamFe3 - logmFe2 - loggamFe2 - # convert to Eh - Eh <- convert(pe,"Eh",T=convert(T,"K")) - return(Eh) -} -ZoBell.table <- function(T=NULL,which=NULL) { - # oxidation-reduction potential of ZoBell's solution - # from Standard Methods for Water and Wastewater or YSI - # (interpolated and/or extrapolated as necessary) - # standard methods (1997) table 2580:I - Eh.T.SMW <- 1:30 - Eh.SMW <- c(0.481,0.479,0.476,0.474,0.472,0.47,0.468,0.465,0.463,0.461, - 0.459,0.457,0.454,0.452,0.45,0.448,0.446,0.443,0.441,0.439,0.437, - 0.435,0.432,0.43,0.428,0.426,0.424,0.421,0.419,0.417) - # from YSI (2005): - # Measuring ORP on YSI 6-Series Sondes: Tips, Cautions and Limitations - # NOTE: these values are vs. Ag/AgCl (4 M KCl) - Eh.T.YSI <- seq(-5,50,by=5) - Eh.YSI <- c(267.0,260.5,254.0,247.5,241.0,234.5,228.0,221.5,215.0,208.5,202.0,195.5)/1000 - # spline function for each of the tables - SMW <- splinefun(Eh.T.SMW,Eh.SMW) - YSI <- splinefun(Eh.T.YSI,Eh.YSI) - # just one of the tables - Eh.fun <- get(which) - Eh.T <- get(paste("Eh.T",which,sep=".")) - if(is.null(T)) T <- Eh.T - return(data.frame(T=T,Eh=Eh.fun(T))) -} -Light <- function(T) { - # this is going to look something like - # Fe+2 = Fe+3 + e- - # logK = logaFe3 - logaFe2 - pe - # get the logK for the reaction - logK <- subcrt(c("Fe+2","Fe+3","e-"),c(-1,1,1),T=T)$out$logK - # we use the recipe from standard methods (table 2580:II) - # 39.21 g Fe(NH4)2(SO4)2(H2O)6 -> 0.1 mol Fe+2 - # 48.22 g Fe(NH4)(SO4)2(H2O)12 -> 0.1 mol Fe+3 - logmFe2 <- logmFe3 <- log10(0.1) - # get the loggam for the iron species - loggamFe2 <- subcrt("Fe+2",T=T,IS=0.2)$out[[1]]$loggam - loggamFe3 <- subcrt("Fe+3",T=T,IS=0.2)$out[[1]]$loggam - # get the pe for the solution - pe <- -logK + logmFe3 + loggamFe3 - logmFe2 - loggamFe2 - # convert to Eh - Eh <- convert(pe,"Eh",T=convert(T,"K")) - return(Eh) -} -Iodide.table <- function(T=NULL) { - # oxidation-reduction potential of Thermo's iodide solution - # from thermo instruction sheet 255218-001 (articlesFile_18739) - T.Iodide <- seq(0,50,5) - Eh.Iodide <- c(438,435,431,428,424,420,415,411,406,401,396)/1000 - Iodide <- splinefun(T.Iodide,Eh.Iodide) - if(is.null(T)) T <- T.Iodide - return(data.frame(T=T,Eh=Iodide(T))) -} -Iodide <- function(T) { - # this is going to look something like - # 3I- = I3- + 2e- - # logK = -2pe + logaI3 - 3logaI - # get the logK for the reaction - logK <- subcrt(c("I-","I3-","e-"),c(-3,1,2),T=T)$out$logK - # could the activities be 0.1 M ... or something else? - logmI <- log10(2) - logmI3 <- log10(0.01) - # get the loggam for the iodine species - loggamI <- subcrt("I-",T=T,IS=0.2)$out[[1]]$loggam - loggamI3 <- subcrt("I3-",T=T,IS=0.2)$out[[1]]$loggam - # get the pe for the solution - pe <- ( -logK + logmI3 + loggamI3 - 3 * (logmI - loggamI) ) / 2 - # convert to Eh - Eh <- convert(pe,"Eh",T=convert(T,"K")) - return(Eh) -} -figure <- function() { - # make some figures - # the temperatures we're interested in - # in degrees C - T <- seq(0,100,5) - # temperature-Eh diagram for various electrodes - thermo.plot.new(ylim=c(0,0.8),xlim=c(0,100), - ylab=axis.label("Eh"),xlab=axis.label("T")) - # the Ag/AgCl electrode (Bard et al. fit) - points(T,AgAgCl.Bard(T),pch=0) - # the Ag/AgCl electrode (equilibrium calculations) - lines(T,AgAgCl(T)) - # ZoBell's solution (SMW table 2580) - SMW <- ZoBell.table(which="SMW") - points(SMW$T,SMW$Eh,pch=1) - # ZoBell's solution (YSI tech report table) - YSI <- ZoBell.table(which="YSI") - # make these values referenced to SHE instead of Ag/AgCl - Eh.YSI <- YSI$Eh + AgAgCl(YSI$T) - points(YSI$T,Eh.YSI,pch=2) - # Light's solution (equilibrium values) - lines(T,Light(T)) - # Light's solution (at 25 degrees only) - points(25,0.475 + 0.200,pch=3) - # Thermo's I-/I3- solution - Thermo <- Iodide.table() - points(Thermo$T,Thermo$Eh,pch=4) - # calculated I-/I3- values - lines(T,Iodide(T)) - # add some labels - text(c(30,30,30,50),c(0.72,0.5,0.35,0.25), - c("Light","ZoBell","(Tri)Iodide","Ag/AgCl")) - title(main="Potentials vs SHE") -} -# finally, make the plot -figure() Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/inst/NEWS 2015-06-13 17:27:56 UTC (rev 89) @@ -1,4 +1,4 @@ -CHANGES IN CHNOSZ 1.0.5-1 (2015-06-09) +CHANGES IN CHNOSZ 1.0.5-2 (2015-06-13) -------------------------------------- - Rewrite rho.IAPWS95() to be able to invert density from IAPWS-95 @@ -23,6 +23,13 @@ https://github.com/hadley/testthat/issues/129 https://github.com/hadley/testthat/issues/144 +- Fix bugs in which.pmax() that prevented proper assignment of + attributes in output, and functionality for lists of length 1. + +- mosaic() now correctly multiplies affinities by _relative_ abundances + of basis species when blend=TRUE. Thanks to Grayson Boyer for the bug + report that led to this fix. + CHANGES IN CHNOSZ 1.0.5 (2015-05-19) ------------------------------------ Modified: pkg/CHNOSZ/inst/tests/test-iprotein.R =================================================================== --- pkg/CHNOSZ/inst/tests/test-iprotein.R 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/inst/tests/test-iprotein.R 2015-06-13 17:27:56 UTC (rev 89) @@ -5,7 +5,14 @@ test_that("basic searches and conversions work as expected", { expect_equal(iprotein(c("LYSC_CHICK", "MYGPHYCA")), c(6, NA)) - + # factors causing problems again ... + f <- system.file("extdata/protein/DS11.csv", package="CHNOSZ") + aa <- read.csv(f) + # this adds the proteins + ip <- add.protein(aa) + # the replaces the proteins (with the same ones) + expect_error(ip <- add.protein(aa), "converting factors causes problems replacing protein data") + # ... should use read.csv(file, stringsAsFactors=FALSE) }) test_that("errors and messages occur in some circumstances", { Added: pkg/CHNOSZ/inst/tests/test-mosaic.R =================================================================== --- pkg/CHNOSZ/inst/tests/test-mosaic.R (rev 0) +++ pkg/CHNOSZ/inst/tests/test-mosaic.R 2015-06-13 17:27:56 UTC (rev 89) @@ -0,0 +1,17 @@ +context("mosaic") + +test_that("results are consistent with affinity()", { + basis(c("CO2", "H2O", "NH3", "O2"), c(0, 0, 0, 0)) + species(c("alanine", "glycine")) + a <- affinity() + # this is a degenerate case because we only allow NH3 to swap for NH3, and CO2 for CO2; + # however it still exercises the affinity scaling and summing code + m1 <- mosaic("NH3", "CO2", blend=TRUE) + # this failed before we divided by loga.tot to get _relative_ abundances of basis species in mosaic.R + expect_equal(a$values, m1$A.species$values) + # the next call failed when which.pmax(), called by diagram(), choked on a list of length one + m2 <- mosaic("NH3", "CO2") + expect_equal(a$values, m2$A.species$values) +}) + +# TODO: test that basis specifications can be exchanged between bases and bases2 without altering output Added: pkg/CHNOSZ/inst/tests/test-util.list.R =================================================================== --- pkg/CHNOSZ/inst/tests/test-util.list.R (rev 0) +++ pkg/CHNOSZ/inst/tests/test-util.list.R 2015-06-13 17:27:56 UTC (rev 89) @@ -0,0 +1,8 @@ +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)) +}) Modified: pkg/CHNOSZ/man/examples.Rd =================================================================== --- pkg/CHNOSZ/man/examples.Rd 2015-06-09 10:21:09 UTC (rev 88) +++ pkg/CHNOSZ/man/examples.Rd 2015-06-13 17:27:56 UTC (rev 89) @@ -14,7 +14,7 @@ \usage{ examples(do.png = FALSE) demos(which = c("sources", "NaCl", "density", - "phosphate", "nucleobase", "orp", "diagram", "revisit", "findit", + "phosphate", "nucleobase", "ORP", "diagram", "revisit", "findit", "CO2Ac", "nonideal", "ionize", "buffer", "yeastgfp", "mosaic", "solubility", "wjd"), do.png=FALSE) } @@ -36,7 +36,7 @@ \code{density} \tab density of H2O, inverted from IAPWS-95 equations (\code{\link{rho.IAPWS95}}) \cr \code{phosphate} \tab phosphate speciation with pH, temperature and ionic strength \cr \code{nucleobase} \tab relative stabilities of nucleobases and some amino acids \cr - \code{orp} \tab oxidation-reduction potential of redox standards as a function of temperature \cr + \code{ORP} \tab oxidation-reduction potential of redox standards as a function of temperature \cr \code{diagram} \tab comparison of methods for calculating stability fields \cr \code{revisit} \tab detailed example of usage of \code{\link{revisit}} \cr \code{findit} \tab detailed example of usage of \code{\link{findit}} \cr @@ -69,7 +69,7 @@ \examples{ \dontshow{data(thermo)} -demos(c("orp", "NaCl")) +demos(c("ORP", "NaCl")) \dontshow{par(thermo$opar)} \dontrun{ # use the following to run examples in all help topics