From noreply at r-forge.r-project.org  Sat Sep 15 14:38:46 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 15 Sep 2018 14:38:46 +0200 (CEST)
Subject: [CHNOSZ-commits] r323 - in pkg/CHNOSZ: . R
Message-ID: <20180915123846.2459518AF25@r-forge.r-project.org>

Author: jedick
Date: 2018-09-15 14:38:45 +0200 (Sat, 15 Sep 2018)
New Revision: 323

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/makeup.R
Log:
makeup(): do not passthrough a named character object


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-08-30 05:54:09 UTC (rev 322)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-15 12:38:45 UTC (rev 323)
@@ -1,6 +1,6 @@
-Date: 2018-08-30
+Date: 2018-09-15
 Package: CHNOSZ
-Version: 1.1.3-30
+Version: 1.1.3-31
 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/R/makeup.R
===================================================================
--- pkg/CHNOSZ/R/makeup.R	2018-08-30 05:54:09 UTC (rev 322)
+++ pkg/CHNOSZ/R/makeup.R	2018-09-15 12:38:45 UTC (rev 323)
@@ -8,8 +8,11 @@
   if(is.matrix(formula)) 
     return(lapply(seq_len(nrow(formula)), 
       function(i) makeup(formula[i, ])))
-  # a named object or list of named objects is returned untouched
-  if(!is.null(names(formula))) return(formula)
+  # a named numeric object is returned untouched
+  # (needed for recursive operation of the function?
+  #  - if this is not done it messes up the HOX example in protein.info.Rd)
+  if(!is.null(names(formula)) & is.numeric(formula)) return(formula)
+  # a list of named objects is also returned untouched
   if(is.list(formula) & !is.null(names(formula[[1]]))) return(formula)
   # prepare to multiply the formula by the multiplier, if given
   if(length(multiplier) > 1 & length(multiplier) != length(formula))


From noreply at r-forge.r-project.org  Fri Sep 21 06:05:41 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 21 Sep 2018 06:05:41 +0200 (CEST)
Subject: [CHNOSZ-commits] r324 - in pkg/CHNOSZ: . inst
Message-ID: <20180921040541.A555A18A187@r-forge.r-project.org>

Author: jedick
Date: 2018-09-21 06:05:39 +0200 (Fri, 21 Sep 2018)
New Revision: 324

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/inst/NEWS
Log:
change package title in DESCRIPTION


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-15 12:38:45 UTC (rev 323)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-21 04:05:39 UTC (rev 324)
@@ -1,7 +1,7 @@
-Date: 2018-09-15
+Date: 2018-09-20
 Package: CHNOSZ
-Version: 1.1.3-31
-Title: Thermodynamic Calculations and Diagrams for Geochemistry
+Version: 1.1.3-32
+Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),
       comment = c(ORCID = "0000-0002-0687-5890")),

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-15 12:38:45 UTC (rev 323)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-21 04:05:39 UTC (rev 324)
@@ -93,7 +93,7 @@
   Thanks to Grayson Boyer for the bug report.
 
 - Fix bug in nonideal() where "Zn" in formula was identified as charge.
-  Thanks to Feng Lai for reporting the incorrect behaviour caused by
+  Thanks to Feng Lai for reporting the incorrect behavior caused by
   this bug.
 
 CHANGES IN CHNOSZ 1.1.3 (2017-11-13)


From noreply at r-forge.r-project.org  Sat Sep 22 07:38:16 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 22 Sep 2018 07:38:16 +0200 (CEST)
Subject: [CHNOSZ-commits] r325 - in pkg/CHNOSZ: . R inst
Message-ID: <20180922053821.A7FE518A04F@r-forge.r-project.org>

Author: jedick
Date: 2018-09-22 07:38:00 +0200 (Sat, 22 Sep 2018)
New Revision: 325

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/subcrt.R
   pkg/CHNOSZ/inst/NEWS
Log:
subcrt(): rename internal variables for better readability


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-21 04:05:39 UTC (rev 324)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-22 05:38:00 UTC (rev 325)
@@ -1,6 +1,6 @@
-Date: 2018-09-20
+Date: 2018-09-22
 Package: CHNOSZ
-Version: 1.1.3-32
+Version: 1.1.3-33
 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),

Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R	2018-09-21 04:05:39 UTC (rev 324)
+++ pkg/CHNOSZ/R/subcrt.R	2018-09-22 05:38:00 UTC (rev 325)
@@ -114,11 +114,10 @@
     species <- as.character(thermo$obigt$name[ispecies])
     state <- as.character(thermo$obigt$state[ispecies])
     newstate <- as.character(thermo$obigt$state[ispecies])
-    sinfo <- ispecies
   } else {
     # from names, get species indices and states and possibly
     # keep track of phase species (cr,cr2 ...)
-    sinfo <- numeric()
+    ispecies <- numeric()
     newstate <- character()
     for(i in 1:length(species)) {
       # get the species index for a named species
@@ -134,53 +133,48 @@
       if(!is.null(state[i])) is.cr <- state[i]=='cr' else is.cr <- FALSE
       if(thermo$obigt$state[si[1]]=='cr' & (is.null(state[i]) | is.cr)) {
         newstate <- c(newstate,'cr')
-        sinfo <- c(sinfo,si[1])
+        ispecies <- c(ispecies,si[1])
       } else {
         newstate <- c(newstate,as.character(thermo$obigt$state[si[1]]))
-        sinfo <- c(sinfo,si[1])
+        ispecies <- c(ispecies,si[1])
       }
     }
   }
 
-  # to make the following more readable and maybe save
-  # run time, keep some parts of thermo$obigt handy
-  ton <- thermo$obigt$name
-  tos <- thermo$obigt$state
-
   # stop if species not found
-  noname <- is.na(sinfo)
+  noname <- is.na(ispecies)
   if(TRUE %in% noname)
     stop(paste('species',species[noname],'not found.\n'))
 
   # take care of mineral phases
-  state <- as.character(tos[sinfo])
-  name <- as.character(ton[sinfo])
+  state <- as.character(thermo$obigt$state[ispecies])
+  name <- as.character(thermo$obigt$name[ispecies])
   # a counter of all species considered
-  # inpho is longer than sinfo if cr,cr2 ... phases are present
-  # sinph shows which of sinfo correspond to inpho
+  # iphases is longer than ispecies if cr,cr2 ... phases are present
+  # phasespecies shows which of ispecies correspond to iphases
   # pre-20091114: the success of this depends on there not being duplicated aqueous or other
   # non-mineral-phase species (i.e., two entries in obigt for Cu+ screw this up
   # when running the skarn example).
   # after 20091114: we can deal with duplicated species (aqueous at least)
-  inpho <- sinph <- coeff.new <- numeric()
-  for(i in 1:length(sinfo)) {
+  iphases <- phasespecies <- coeff.new <- numeric()
+  for(i in 1:length(ispecies)) {
      if(newstate[i]=='cr') {
        searchstates <- c('cr','cr2','cr3','cr4','cr5','cr6','cr7','cr8','cr9') 
-       tghs <- thermo$obigt[(ton %in% name[i]) & tos %in% searchstates,]
+       tghs <- thermo$obigt[(thermo$obigt$name %in% name[i]) & thermo$obigt$state %in% searchstates,]
        # we only take one if they are in fact duplicated species and not phase species
-       if(all(tghs$state==tghs$state[1])) tghs <- thermo$obigt[sinfo[i],]
-     } else tghs <- thermo$obigt[sinfo[i],]
-     inpho <- c(inpho,as.numeric(rownames(tghs))) 
-     sinph <- c(sinph,rep(sinfo[i],nrow(tghs)))
+       if(all(tghs$state==tghs$state[1])) tghs <- thermo$obigt[ispecies[i],]
+     } else tghs <- thermo$obigt[ispecies[i],]
+     iphases <- c(iphases,as.numeric(rownames(tghs))) 
+     phasespecies <- c(phasespecies,rep(ispecies[i],nrow(tghs)))
      coeff.new <- c(coeff.new,rep(coeff[i],nrow(tghs)))
   }
 
   # where we keep info about the species involved
-  reaction <- data.frame(coeff = coeff.new, name = ton[inpho],
-    formula = thermo$obigt$formula[inpho], state = tos[inpho],
-    ispecies = inpho, stringsAsFactors = FALSE)
+  reaction <- data.frame(coeff = coeff.new, name = thermo$obigt$name[iphases],
+    formula = thermo$obigt$formula[iphases], state = thermo$obigt$state[iphases],
+    ispecies = iphases, stringsAsFactors = FALSE)
   # make the rownames readable ... but they have to be unique
-  if(length(unique(inpho))==length(inpho)) rownames(reaction) <- as.character(inpho)
+  if(length(unique(iphases))==length(iphases)) rownames(reaction) <- as.character(iphases)
 
   # wetness etc.
   isH2O <- reaction$name=='water' & reaction$state=='liq'
@@ -206,7 +200,7 @@
   # inform about unbalanced reaction
   if(do.reaction) {
     # the mass balance ... is zero for a balanced reaction
-    mss <- makeup(sinfo, coeff, sum=TRUE)
+    mss <- makeup(ispecies, coeff, sum=TRUE)
     # take out very small numbers
     mss[abs(mss) < 1e-7] <- 0
     # report and try to fix any non-zero mass balance
@@ -268,31 +262,29 @@
   # if logK but not G was requested, we need to calculate G
   eosprop <- calcprop
   if('logK' %in% calcprop & ! 'G' %in% calcprop) eosprop <- c(eosprop, 'G')
-  # also get g if we are dealing with mineral phases
-  if(!'G' %in% eosprop & length(inpho) > length(sinfo)) eosprop <- c(eosprop, 'G')
+  # also get G if we are dealing with mineral phases
+  if(!'G' %in% eosprop & length(iphases) > length(ispecies)) eosprop <- c(eosprop, 'G')
   # don't request logK or rho from the eos ...
   eosprop <- eosprop[!eosprop %in% c('logK','rho')]
   # the reaction result will go here
   out <- list()
   # aqueous species and H2O properties
   if(TRUE %in% isaq) {
-    # 20110808 if inpho are the species indices let's avoid
-    # the overhead of info() and use new obigt2eos() instead
-    #si <- info(inpho[isaq],quiet=TRUE)
-    si <- obigt2eos(thermo$obigt[inpho[isaq],], "aq", fixGHS = TRUE)
+    # 20110808 get species parameters using obigt2eos() (faster than using info())
+    param <- obigt2eos(thermo$obigt[iphases[isaq],], "aq", fixGHS = TRUE)
     # always get density
     H2O.props <- "rho"
     # calculate A_DH and B_DH if we're using the B-dot (Helgeson) equation
     if(any(IS != 0) & grepl("Helgeson", thermo$opt$nonideal)) H2O.props <- c(H2O.props, "A_DH", "B_DH")
     # get other properties for H2O only if it's in the reaction
     if(any(isH2O)) H2O.props <- c(H2O.props, eosprop)
-    hkfstuff <- hkf(eosprop, parameters = si, T = T, P = P, H2O.props=H2O.props)
+    hkfstuff <- hkf(eosprop, parameters = param, T = T, P = P, H2O.props=H2O.props)
     p.aq <- hkfstuff$aq
     H2O.PT <- hkfstuff$H2O
     # calculate activity coefficients if ionic strength is not zero
     if(any(IS != 0)) {
-      if(grepl("Helgeson", thermo$opt$nonideal)) p.aq <- nonideal(inpho[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH)
-      else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(inpho[isaq], p.aq, newIS, T)
+      if(grepl("Helgeson", thermo$opt$nonideal)) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH)
+      else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T)
     }
     out <- c(out, p.aq)
   } else if(any(isH2O)) {
@@ -305,8 +297,8 @@
   iscgl <- reaction$state %in% cglstates & reaction$name != "water"
 
   if(TRUE %in% iscgl) {
-    si <- obigt2eos(thermo$obigt[inpho[iscgl],], "cgl", fixGHS = TRUE)
-    p.cgl <- cgl(eosprop, parameters = si, T = T, P = P)
+    param <- obigt2eos(thermo$obigt[iphases[iscgl],], "cgl", fixGHS = TRUE)
+    p.cgl <- cgl(eosprop, parameters = param, T = T, P = P)
     # replace Gibbs energies with NA where the
     # phases are beyond their temperature range
     if('G' %in% eosprop) {
@@ -314,7 +306,7 @@
       # 20120219 cleaned up somewhat; using exceed.Ttr and NA instead of do.phases and 999999
       # the numbers of the cgl species (becomes 0 for any that aren't cgl)
       ncgl <- iscgl
-      ncgl[iscgl] <- 1:nrow(si)
+      ncgl[iscgl] <- 1:nrow(param)
       for(i in 1:length(iscgl)) {
         # not if we're not cgl
         if(!iscgl[i]) next
@@ -325,7 +317,7 @@
 #        if(mystate=="cr_Berman") next
         # if this phase is cr2 or higher, check if we're below the transition temperature
         if(!(reaction$state[i] %in% c('liq','cr','gas'))) {
-          Ttr <- Ttr(inpho[i]-1,P=P,dPdT=dPdTtr(inpho[i]-1))
+          Ttr <- Ttr(iphases[i]-1,P=P,dPdT=dPdTtr(iphases[i]-1))
           if(all(is.na(Ttr))) next
           if(any(T < Ttr)) {
             status.Ttr <- "(extrapolating G)"
@@ -340,12 +332,12 @@
         # check if we're above the temperature limit or transition temperature
         # T limit (or Ttr) from the database
         warn.above <- TRUE
-        Ttr <- thermo$obigt$z.T[inpho[i]]
+        Ttr <- thermo$obigt$z.T[iphases[i]]
         # calculate Ttr at higher P if a phase transition is present
         if(i < nrow(reaction)) {
           # if the next one is cr2, cr3, etc we have a transition
           if(reaction$state[i+1] %in% c("cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", "cr8", "cr9"))
-            Ttr <- Ttr(inpho[i],P=P,dPdT=dPdTtr(inpho[i]))
+            Ttr <- Ttr(iphases[i],P=P,dPdT=dPdTtr(iphases[i]))
           # we don't warn here about the transition
           warn.above <- FALSE
         }
@@ -401,22 +393,22 @@
   isaq.new <- logical()
   iscgl.new <- logical()
   isH2O.new <- logical()
-  for(i in 1:length(sinfo)) {
-    iphases <- which(sinfo[i]==sinph)
+  for(i in 1:length(ispecies)) {
+    arephases <- which(ispecies[i]==phasespecies)
     # deal with repeated species here
-    if(TRUE %in% duplicated(inpho[iphases])) {
+    if(TRUE %in% duplicated(iphases[arephases])) {
       # only take the first, not the duplicates
-      ndups <- length(which(sinfo==sinfo[i]))
-      nphases <- length(iphases) / ndups
-      iphases <- iphases[1:nphases]
+      ndups <- length(which(ispecies==ispecies[i]))
+      nphases <- length(arephases) / ndups
+      arephases <- arephases[1:nphases]
     }
-    if(length(iphases)>1) {
-      message(paste('subcrt:',length(iphases),'phases for',thermo$obigt$name[sinfo[i]],'... '), appendLF=FALSE)
+    if(length(arephases)>1) {
+      message(paste('subcrt:',length(arephases),'phases for',thermo$obigt$name[ispecies[i]],'... '), appendLF=FALSE)
       # assemble the Gibbs energies for each species
-      for(j in 1:length(iphases)) {
-        G.this <- out[[iphases[j]]]$G
+      for(j in 1:length(arephases)) {
+        G.this <- out[[arephases[j]]]$G
         if(length(which(is.na(G.this))) > 0 & exceed.Ttr) warning(paste('subcrt: NAs found for G of ',
-          reaction$name[iphases[j]],' ',reaction$state[iphases[j]],' at T-P point(s) ',
+          reaction$name[arephases[j]],' ',reaction$state[arephases[j]],' at T-P point(s) ',
           c2s(which(is.na(G.this)),sep=' '),sep=''),call.=FALSE)
         if(j==1) G <- as.data.frame(G.this)
         else G <- cbind(G,as.data.frame(G.this))
@@ -432,21 +424,21 @@
           #ps <- 1
           # - above temperature limit for the highest-T phase (subcrt.Rd skarn example) --> use highest-T phase 20171110
           ps <- ncol(G)
-          if(exceed.Ttr) warning('subcrt: stable phase for ',reaction$name[iphases[ps]],' at T-P point ',j,
-          ' undetermined (using ',reaction$state[iphases[ps]],')',call.=FALSE)
+          if(exceed.Ttr) warning('subcrt: stable phase for ',reaction$name[arephases[ps]],' at T-P point ',j,
+          ' undetermined (using ',reaction$state[arephases[ps]],')',call.=FALSE)
         } 
         phasestate <- c(phasestate,ps)
-        out.new.entry[j,] <- out[[ iphases[ps] ]][j,]
+        out.new.entry[j,] <- out[[ arephases[ps] ]][j,]
       }
 
       # update our objects
       out.new[[i]] <- cbind(out.new.entry,data.frame(polymorph=phasestate))
-      reaction.new[i,] <- reaction[iphases[phasestate[1]],]
+      reaction.new[i,] <- reaction[arephases[phasestate[1]],]
       # mark the minerals with multiple phases
       reaction.new$state[i] <- "cr*"
-      isaq.new <- c(isaq.new,isaq[iphases[phasestate[1]]])
-      iscgl.new <- c(iscgl.new,iscgl[iphases[phasestate[1]]])
-      isH2O.new <- c(isH2O.new,isH2O[iphases[phasestate[1]]])
+      isaq.new <- c(isaq.new,isaq[arephases[phasestate[1]]])
+      iscgl.new <- c(iscgl.new,iscgl[arephases[phasestate[1]]])
+      isH2O.new <- c(isH2O.new,isH2O[arephases[phasestate[1]]])
       # info for the user
       up <- unique(phasestate)
       if(length(up)>1) { word <- 'are'; p.word <- 'phases' }
@@ -454,17 +446,17 @@
       message(paste(p.word,c2s(unique(phasestate)),word,'stable'))
     } else {
       # multiple phases aren't involved ... things stay the same
-      out.new[[i]] <- out[[iphases]]
-      reaction.new[i, ] <- reaction[iphases, ]
-      reaction.new$state[i] <- reaction$state[iphases]
-      isaq.new <- c(isaq.new,isaq[iphases])
-      iscgl.new <- c(iscgl.new,iscgl[iphases])
-      isH2O.new <- c(isH2O.new,isH2O[iphases])
+      out.new[[i]] <- out[[arephases]]
+      reaction.new[i, ] <- reaction[arephases, ]
+      reaction.new$state[i] <- reaction$state[arephases]
+      isaq.new <- c(isaq.new,isaq[arephases])
+      iscgl.new <- c(iscgl.new,iscgl[arephases])
+      isH2O.new <- c(isH2O.new,isH2O[arephases])
     }
   }
   out <- out.new
   # remove the rows that were added to keep track of phase transitions
-  reaction <- reaction.new[1:length(sinfo),]
+  reaction <- reaction.new[1:length(ispecies),]
   # the manipulations above should get the correct species indices and state labels,
   # but if species are (intentionally) repeated, include only the first
   # (and possibly incorrect) reaction coefficients, so use the originals here 20180822

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-21 04:05:39 UTC (rev 324)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-22 05:38:00 UTC (rev 325)
@@ -1,4 +1,4 @@
-CHANGES IN CHNOSZ 1.1.3-29 (2018-08-22)
+CHANGES IN CHNOSZ 1.1.3-33 (2018-09-22)
 ---------------------------------------
 
 THERMODYNAMIC DATA
@@ -85,6 +85,9 @@
 - Keywords in basis(): Change 'CHNOPS+' to use O2 instead of e-, and add
   'CHNOPSe' and 'MgCHNOPSe' for sets of basis species that have e-.
 
+- Change internal variable names in subcrt() for better readability
+  (sinfo -> ispecies, inpho -> iphases, sinph -> phasespecies).
+
 BUG FIXES
 
 - Fix a bug where subcrt()$reaction$coeffs was incorrect for reactions


From noreply at r-forge.r-project.org  Sun Sep 23 05:55:31 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 23 Sep 2018 05:55:31 +0200 (CEST)
Subject: [CHNOSZ-commits] r326 - in pkg/CHNOSZ: . R inst man tests/testthat
Message-ID: <20180923035531.5DCBD18AE56@r-forge.r-project.org>

Author: jedick
Date: 2018-09-23 05:55:29 +0200 (Sun, 23 Sep 2018)
New Revision: 326

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/diagram.R
   pkg/CHNOSZ/R/subcrt.R
   pkg/CHNOSZ/R/water.R
   pkg/CHNOSZ/inst/NEWS
   pkg/CHNOSZ/man/subcrt.Rd
   pkg/CHNOSZ/tests/testthat/test-subcrt.R
   pkg/CHNOSZ/tests/testthat/test-swap.basis.R
Log:
subcrt(): add water density threshold for properties for HKF species


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-23 03:55:29 UTC (rev 326)
@@ -1,6 +1,6 @@
-Date: 2018-09-22
+Date: 2018-09-23
 Package: CHNOSZ
-Version: 1.1.3-33
+Version: 1.1.3-34
 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),

Modified: pkg/CHNOSZ/R/diagram.R
===================================================================
--- pkg/CHNOSZ/R/diagram.R	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/R/diagram.R	2018-09-23 03:55:29 UTC (rev 326)
@@ -166,10 +166,6 @@
     # some additional steps for affinity values, but not for equilibrated activities
     if(eout.is.aout) {
       for(i in 1:length(pv)) {
-        # change any NAs in the plotvals to -Inf, so that 
-        # they don't get on the plot, but permit others to
-        # (useful for making mineral stability diagrams beyond transition temperatures of one or more minerals)
-        pv[[i]][is.na(pv[[i]])] <- -Inf
         # TODO: see vignette for an explanation for how this is normalizing
         # the formulas in a predominance calculation
         if(normalize) pv[[i]] <- (pv[[i]] + eout$species$logact[i] / n.balance[i]) - log10(n.balance[i])

Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/R/subcrt.R	2018-09-23 03:55:29 UTC (rev 326)
@@ -67,7 +67,8 @@
   }
 
   # warn for too high temperatures for Psat 20171110
-  if(identical(P, "Psat") & any(T > 647.067)) warning("attempting calculation at P = 'Psat' for some T > Tcritical; set P = 1 (or higher)")
+  warnings <- character()
+  if(identical(P, "Psat") & any(T > 647.067)) warnings <- c(warnings, "P = 'Psat' undefined for T > Tcritical")
 
   # gridding?
   do.grid <- FALSE
@@ -248,10 +249,10 @@
           return(subcrt(species=newspecies, coeff=newcoeff, state=newstate,
             property=property, T=outvert(T, "K"), P=P, grid=grid, convert=convert, logact=logact, exceed.Ttr=FALSE))
         } else if(identical(action.unbalanced,'warn')) 
-            warning(paste('reaction was unbalanced, missing', as.chemical.formula(miss)),call.=FALSE)
+            warnings <- c(warnings, paste('reaction was unbalanced, missing', as.chemical.formula(miss)))
       } else {
         if(identical(action.unbalanced,'warn')) 
-          warning(paste('reaction was unbalanced, missing', as.chemical.formula(miss)),call.=FALSE)
+          warnings <- c(warnings, paste('reaction was unbalanced, missing', as.chemical.formula(miss)))
       }
     }
   }
@@ -281,6 +282,14 @@
     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
+    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, ")"))
+    }
     # calculate activity coefficients if ionic strength is not zero
     if(any(IS != 0)) {
       if(grepl("Helgeson", thermo$opt$nonideal)) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH)
@@ -556,6 +565,11 @@
     # add names to the output
     names(out$out) <- as.character(reaction$name)
   }
+  # add warnings to output 20180922
+  if(length(warnings) > 0) {
+    out <- c(out, list(warnings=warnings))
+    for(warn in warnings) warning(warn)
+  }
   return(out)
 }
 

Modified: pkg/CHNOSZ/R/water.R
===================================================================
--- pkg/CHNOSZ/R/water.R	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/R/water.R	2018-09-23 03:55:29 UTC (rev 326)
@@ -117,9 +117,11 @@
   # assemble additional properties: V, rho, Psat, E, kT
   if(any(iprop > 23)) {
     mwH2O <- 18.0152 # SUP92.f
-    V=mwH2O/rho.out
-    rho=rho.out*1000
-    Psat=P.out
+    V <- mwH2O/rho.out
+    rho <- rho.out*1000
+    # rho==0 should be NA 20180923
+    rho[rho==0] <- NA
+    Psat <- P.out
     E <- V*w.out$alpha
     kT <- V*w.out$beta
     # A and B parameters in Debye-Huckel equation:

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-23 03:55:29 UTC (rev 326)
@@ -1,4 +1,4 @@
-CHANGES IN CHNOSZ 1.1.3-33 (2018-09-22)
+CHANGES IN CHNOSZ 1.1.3-34 (2018-09-23)
 ---------------------------------------
 
 THERMODYNAMIC DATA
@@ -45,37 +45,39 @@
 
 - Change abbreviation of grossular to Grs.
 
-OTHER CHANGES
+DIAGRAMS
 
 - Lines in 1-D diagram()s can optionally be drawn as splines using the
   method for splinefun() given in the 'spline.method' argument (the
   default of NULL means no splines).
 
+- Add 'srt' argument to diagram() (rotation of line labels).
+
+- Export thermo.axis(), as it is useful for adding major and minor tick
+  marks after (above) other plot elements such as legends.
+
+- diagram(): rename 'what' argument to 'type'.
+
+- digram(): add new type of diagram, 'saturation', which is used to
+  plot saturation lines for minerals (where their affinity equals
+  zero).
+
+OTHER CHANGES
+
 - Add dumpdata() for returning/writing all packaged thermodynamic data
   (including default database and optional data files).
 
-- Add 'srt' argument to diagram() (rotation of line labels).
-
 - TODO: fix overly long message for info("SiO2").
 
 - In equilibrate(), accept a length > 1 'normalize' argument to
   normalize the chemical formulas of only the selected species.
 
-- Export thermo.axis(), as it is useful for adding major and minor tick
-  marks after (above) other plot elements such as legends.
-
 - Add C implementation of counting occurrences of all letters in a
   string (src/count_letters.c) to speed up operation of count.aa().
 
 - read.fasta(): add support for file connections created using
   archive::archive_read (https://github.com/jimhester/archive).
 
-- diagram(): rename 'what' argument to 'type'.
-
-- digram(): add new type of diagram, 'saturation', which is used to
-  plot saturation lines for minerals (where their affinity equals
-  zero).
-
 - Add demo/bison.R (average oxidation state of carbon of metagenome-
   derived proteins in different microbial phyla at Bison Pool)
 
@@ -99,6 +101,10 @@
   Thanks to Feng Lai for reporting the incorrect behavior caused by
   this bug.
 
+- For species in the revised HKF model, subcrt() now sets properties to
+  NA where the density of H2O is less than 0.35 g/cm3, avoiding the
+  output of bogus values in this region. Thanks to Evgeniy Bastrakov.
+
 CHANGES IN CHNOSZ 1.1.3 (2017-11-13)
 ------------------------------------
 

Modified: pkg/CHNOSZ/man/subcrt.Rd
===================================================================
--- pkg/CHNOSZ/man/subcrt.Rd	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/man/subcrt.Rd	2018-09-23 03:55:29 UTC (rev 326)
@@ -83,9 +83,6 @@
 
 \code{subcrt} is modeled after the functionality of the \acronym{SUPCRT92} package (Johnson et al., 1992).
 Certain features of \acronym{SUPCRT92} are not available here, for example, calculations as a function of density of \H2O instead of pressure, or calculations of temperatures of univariant curves (i.e. for which \code{logK} is zero).
-The informative messages produced by \code{SUPCRT92} when temperature or pressure limits of the equations of state are exceeded generally are not reproduced here.
-However, \code{NA}s may be produced in the output of \code{subcrt} if the requisite thermodynamic or electrostatic properties of water can not be calculated at given conditions.
-Specifically, \code{NA}s are produced for calculations at \samp{Psat} when the temperature exceeds the critical temperature of \H2O.
 
 For calculations below 273.16 K, the pressure should be set to 1, as \Psat is not defined in these conditions.
 
@@ -94,9 +91,15 @@
 }
 
 \section{Warning}{
-Although \acronym{SUPCRT92} prohibits calculations above 350 \degC at \Psat (\dQuote{beyond range of applicability of aqueous species equations}), there is no corresponding limit in place in \code{subcrt} (or \code{\link{hkf}}).
-Therefore, CHNOSZ can perform calculations up to the critical temperature (373.917 \degC) at \Psat, but these settings represent untested extrapolations.
-Unexpected results are evident in the discontinuity in the value of \logK at \Psat shown in \code{\link{demos}("NaCl")}.
+Although \acronym{SUPCRT92} prohibits calculations above 350 \degC at \Psat (\dQuote{beyond range of applicability of aqueous species equations}), CHNOSZ does not impose this limitation, and allows calculations up to the critical temperature (373.917 \degC) at \Psat.
+Interpret calculations between 350 \degC and the critical temperature at \Psat at your own risk.
+The discontinuity in the value of \logK at \Psat that is apparent in \code{\link{demos}("NaCl")} demonstrates one unexpected result.
+
+\code{NA}s are produced for calculations at \samp{Psat} when the temperature exceeds the critical temperature of \H2O.
+In addition, properties of species using the revised HKF equations are set to \code{NA} wherever the density of \H2O < 0.35 g/cm\S{3} (threshold just above the critical isochore; Johnson et al., 1992).
+Both of these situations produce warnings, which are stored in the \samp{warnings} element of the return value.
+
+\code{NA}s are also output if the T, P conditions are otherwise beyond the capabilities of the water equations of state derived from SUPCRT92 (H2O92D.f), but the messages about this are produced by \code{\link{water.SUPCRT92}} rather than \code{subcrt}.
 }
 
 \value{

Modified: pkg/CHNOSZ/tests/testthat/test-subcrt.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-subcrt.R	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/tests/testthat/test-subcrt.R	2018-09-23 03:55:29 UTC (rev 326)
@@ -184,6 +184,13 @@
   expect_equal(unique(s4$out$logK), 0)
 })
 
+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\\)"
+  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)
+})
+
 # references
 
 # Amend, J. P. and Shock, E. L. (2001) 

Modified: pkg/CHNOSZ/tests/testthat/test-swap.basis.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-swap.basis.R	2018-09-22 05:38:00 UTC (rev 325)
+++ pkg/CHNOSZ/tests/testthat/test-swap.basis.R	2018-09-23 03:55:29 UTC (rev 326)
@@ -26,7 +26,7 @@
   expect_error(basis.logact(ep), "element\\(s\\) O not found in basis")
 })
 
-test_that("equil.potentials - basis.logact - element.mu makes a roundtrip at 25 and 100 degrees C", {
+test_that("equil.potentials - basis.logact - element.mu makes a roundtrip at 25 and 99 degrees C", {
   basis(c("graphite", "H2", "O2"), c("cr", "gas", "gas"))
   ispecies <- info(c("ethane", "propane", "acetic acid", "propanoic acid"))  
   # at 25 degrees C
@@ -37,10 +37,10 @@
   basis(names(bl25), bl25)
   # element.mu() calculates the chemical potentials of the elements from the current setting of basis species
   expect_equal(element.mu(), ep25)
-  # at 100 degrees C
-  w100 <- run.wjd(ispecies, as.chemical.formula(colMeans(i2A(ispecies))), T=100)
-  ep100 <- equil.potentials(w100)
-  bl100 <- basis.logact(ep100, T=100)
-  basis(names(bl100), bl100)
-  expect_equal(element.mu(T=100), ep100)
+  # at 99 degrees C
+  w99 <- run.wjd(ispecies, as.chemical.formula(colMeans(i2A(ispecies))), T=99)
+  ep99 <- equil.potentials(w99)
+  bl99 <- basis.logact(ep99, T=99)
+  basis(names(bl99), bl99)
+  expect_equal(element.mu(T=99), ep99)
 })


From noreply at r-forge.r-project.org  Sun Sep 23 08:06:41 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 23 Sep 2018 08:06:41 +0200 (CEST)
Subject: [CHNOSZ-commits] r327 - in pkg/CHNOSZ: . R demo tests/testthat
Message-ID: <20180923060641.742D81808BA@r-forge.r-project.org>

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)


From noreply at r-forge.r-project.org  Sun Sep 23 10:17:46 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 23 Sep 2018 10:17:46 +0200 (CEST)
Subject: [CHNOSZ-commits] r328 - in pkg/CHNOSZ: . R inst
Message-ID: <20180923081746.6610418A944@r-forge.r-project.org>

Author: jedick
Date: 2018-09-23 10:17:42 +0200 (Sun, 23 Sep 2018)
New Revision: 328

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/subcrt.R
   pkg/CHNOSZ/R/util.affinity.R
   pkg/CHNOSZ/inst/NEWS
Log:
affinity(): include warning messages from subcrt() in output


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-23 06:06:20 UTC (rev 327)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-23 08:17:42 UTC (rev 328)
@@ -1,6 +1,6 @@
 Date: 2018-09-23
 Package: CHNOSZ
-Version: 1.1.3-35
+Version: 1.1.3-36
 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),

Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R	2018-09-23 06:06:20 UTC (rev 327)
+++ pkg/CHNOSZ/R/subcrt.R	2018-09-23 08:17:42 UTC (rev 328)
@@ -272,7 +272,7 @@
   # don't request logK or rho from the eos ...
   eosprop <- eosprop[!eosprop %in% c('logK','rho')]
   # the reaction result will go here
-  out <- list()
+  outprops <- list()
   # aqueous species and H2O properties
   if(TRUE %in% isaq) {
     # 20110808 get species parameters using obigt2eos() (faster than using info())
@@ -299,7 +299,7 @@
       if(grepl("Helgeson", thermo$opt$nonideal)) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH)
       else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T)
     }
-    out <- c(out, p.aq)
+    outprops <- c(outprops, p.aq)
   } else if(any(isH2O)) {
     # we're not using the HKF, but still want water
     H2O.PT <- water(c("rho", eosprop), T = T, P = P)
@@ -365,41 +365,41 @@
         }
       }
     }
-    out <- c(out,p.cgl)
+    outprops <- c(outprops,p.cgl)
   }
 
   # water
   if(any(isH2O)) {
     p.H2O <- H2O.PT[, match(eosprop, colnames(H2O.PT)), drop=FALSE]
     p.H2O <- list(p.H2O)
-    out <- c(out, rep(p.H2O, sum(isH2O == TRUE)))
+    outprops <- c(outprops, rep(p.H2O, sum(isH2O == TRUE)))
   }
 
   # use variable-pressure standard Gibbs energy for gases
   isgas <- reaction$state %in% "gas" 
   if(any(isgas) & "G" %in% eosprop & thermo$opt$varP) {
-    for(i in which(isgas)) out[[i]]$G <- out[[i]]$G - convert(log10(P), "G", T=T)
+    for(i in which(isgas)) outprops[[i]]$G <- outprops[[i]]$G - convert(log10(P), "G", T=T)
   }
 
   # logK
   if('logK' %in% calcprop) {
-    for(i in 1:length(out)) {
-      out[[i]] <- cbind(out[[i]],data.frame(logK=convert(out[[i]]$G,'logK',T=T)))
-      colnames(out[[i]][ncol(out[[i]])]) <- 'logK'
+    for(i in 1:length(outprops)) {
+      outprops[[i]] <- cbind(outprops[[i]],data.frame(logK=convert(outprops[[i]]$G,'logK',T=T)))
+      colnames(outprops[[i]][ncol(outprops[[i]])]) <- 'logK'
     }
   }
 
   # ordering the output
-  # the indices of the species in out thus far
+  # the indices of the species in outprops thus far
   ns <- 1:nrow(reaction)
   is <- c(ns[isaq],ns[iscgl],ns[isH2O])
   if(length(ns)!=length(is)) stop('subcrt: not all species are accounted for.')
   v <- list()
-  for(i in 1:length(is))  v[[i]] <- out[[match(ns[i],is)]]
-  out <- v
+  for(i in 1:length(is))  v[[i]] <- outprops[[match(ns[i],is)]]
+  outprops <- v
 
   # deal with phases (cr,cr2) here
-  # we have to eliminate rows from out, 
+  # we have to eliminate rows from outprops, 
   # reaction and values from isaq, iscgl, isH2O
   out.new <- list()
   reaction.new <- reaction
@@ -419,7 +419,7 @@
       message(paste('subcrt:',length(arephases),'phases for',thermo$obigt$name[ispecies[i]],'... '), appendLF=FALSE)
       # assemble the Gibbs energies for each species
       for(j in 1:length(arephases)) {
-        G.this <- out[[arephases[j]]]$G
+        G.this <- outprops[[arephases[j]]]$G
         if(length(which(is.na(G.this))) > 0 & exceed.Ttr) warning(paste('subcrt: NAs found for G of ',
           reaction$name[arephases[j]],' ',reaction$state[arephases[j]],' at T-P point(s) ',
           c2s(which(is.na(G.this)),sep=' '),sep=''),call.=FALSE)
@@ -428,7 +428,7 @@
       }
       # find the minimum-energy phase at each T-P point
       phasestate <- numeric()
-      out.new.entry <- out[[1]]
+      out.new.entry <- outprops[[1]]
       for(j in 1:nrow(G)) {
         ps <- which.min(as.numeric(G[j,]))
         if(length(ps)==0) {
@@ -441,7 +441,7 @@
           ' undetermined (using ',reaction$state[arephases[ps]],')',call.=FALSE)
         } 
         phasestate <- c(phasestate,ps)
-        out.new.entry[j,] <- out[[ arephases[ps] ]][j,]
+        out.new.entry[j,] <- outprops[[ arephases[ps] ]][j,]
       }
 
       # update our objects
@@ -459,7 +459,7 @@
       message(paste(p.word,c2s(unique(phasestate)),word,'stable'))
     } else {
       # multiple phases aren't involved ... things stay the same
-      out.new[[i]] <- out[[arephases]]
+      out.new[[i]] <- outprops[[arephases]]
       reaction.new[i, ] <- reaction[arephases, ]
       reaction.new$state[i] <- reaction$state[arephases]
       isaq.new <- c(isaq.new,isaq[arephases])
@@ -467,7 +467,7 @@
       isH2O.new <- c(isH2O.new,isH2O[arephases])
     }
   }
-  out <- out.new
+  outprops <- out.new
   # remove the rows that were added to keep track of phase transitions
   reaction <- reaction.new[1:length(ispecies),]
   # the manipulations above should get the correct species indices and state labels,
@@ -479,13 +479,13 @@
   isH2O <- isH2O.new
 
   # adjust the output order of the properties
-  for(i in 1:length(out)) {
+  for(i in 1:length(outprops)) {
     # the calculated properties are first
-    ipp <- match(calcprop, colnames(out[[i]]))
+    ipp <- match(calcprop, colnames(outprops[[i]]))
     # move polymorph/loggam columns to end
-    if('polymorph' %in% colnames(out[[i]])) ipp <- c(ipp,match('polymorph',colnames(out[[i]]))) 
-    if('loggam' %in% colnames(out[[i]])) ipp <- c(ipp,match('loggam',colnames(out[[i]]))) 
-    out[[i]] <- out[[i]][,ipp,drop=FALSE]
+    if('polymorph' %in% colnames(outprops[[i]])) ipp <- c(ipp,match('polymorph',colnames(outprops[[i]]))) 
+    if('loggam' %in% colnames(outprops[[i]])) ipp <- c(ipp,match('loggam',colnames(outprops[[i]]))) 
+    outprops[[i]] <- outprops[[i]][,ipp,drop=FALSE]
   }
 
   # add up reaction properties
@@ -496,7 +496,7 @@
     if(!is.null(logact)) {
       logQ <- logK <- rep(0,length(T))
       for(i in 1:length(coeff)) {
-        logK <- logK + out[[i]]$logK * coeff[i]
+        logK <- logK + outprops[[i]]$logK * coeff[i]
         logQ <- logQ + logact[i] * coeff[i]
       }
       reaction <- cbind(reaction,logact)
@@ -508,15 +508,15 @@
     # loop over reaction coefficients
     for(i in 1:length(coeff)) {
       # assemble polymorph columns separately
-      if('polymorph' %in% colnames(out[[i]])) {
-         sc <- as.data.frame(out[[i]]$polymorph)
-         out[[i]] <- out[[i]][,-match('polymorph',colnames(out[[i]]))]
+      if('polymorph' %in% colnames(outprops[[i]])) {
+         sc <- as.data.frame(outprops[[i]]$polymorph)
+         outprops[[i]] <- outprops[[i]][,-match('polymorph',colnames(outprops[[i]]))]
          colnames(sc) <- as.character(reaction$name[i])
          if(is.null(morphcols)) morphcols <- sc
          else morphcols <- cbind(morphcols,sc)
       }
       # include a zero loggam column if needed (for those species that are ideal)
-      o.i <- out[[i]]
+      o.i <- outprops[[i]]
       if('loggam' %in% colnames(o.i)) if(!'loggam' %in% colnames(o))
         o <- cbind(o,loggam=0)
       if('loggam' %in% colnames(o)) if(!'loggam' %in% colnames(o.i))
@@ -525,18 +525,18 @@
       o <- o + o.i * coeff[i]
     }
     # output for reaction (stack on polymorph columns if exist)
-    if(!is.null(morphcols)) out <- list(reaction=reaction,out=o,polymorphs=morphcols)
-    else out <- list(reaction=reaction,out=o)
+    if(!is.null(morphcols)) OUT <- list(reaction=reaction,out=o,polymorphs=morphcols)
+    else OUT <- list(reaction=reaction,out=o)
   } else {
     # output for species: strip the coeff column from reaction
     reaction <- reaction[,-match('coeff',colnames(reaction))]
-    out <- c(list(species=reaction),out)
+    OUT <- c(list(species=reaction),outprops)
   }
   # append T,P,rho, A, logQ columns and convert units
-  for(i in 2:length(out)) {
+  for(i in 2:length(OUT)) {
     # affinity and logQ
     if(i==2) if(do.reaction & !is.null(logact)) {
-      out[[i]] <- cbind(out[[i]],data.frame(logQ=logQ,A=A))
+      OUT[[i]] <- cbind(OUT[[i]],data.frame(logQ=logQ,A=A))
     }
     # 20120114 only prepend T, P, rho columns if we have more than one T
     # 20171020 or if the 'property' argument is missing (it's nice to see everything using e.g. subcrt("H2O", T=150))
@@ -548,32 +548,32 @@
       # try to stuff in a column of rho if we have aqueous species
       # watch out! supcrt-ish densities are in g/cc not kg/m3
       if('rho' %in% calcprop | ( (missing(property) | identical(property, c("logK", "G", "H", "S", "V", "Cp"))) &
-                                any(c(isaq,isH2O))) & (names(out)[i])!='polymorph') 
-        out[[i]] <- cbind(data.frame(T=T.out,P=P.out,rho=H2O.PT$rho/1000),out[[i]])
+                                any(c(isaq,isH2O))) & (names(OUT)[i])!='polymorph') 
+        OUT[[i]] <- cbind(data.frame(T=T.out,P=P.out,rho=H2O.PT$rho/1000),OUT[[i]])
       else
-        out[[i]] <- cbind(data.frame(T=T.out,P=P.out,out[[i]]))
+        OUT[[i]] <- cbind(data.frame(T=T.out,P=P.out,OUT[[i]]))
     }
     if(convert) {
-      for(j in 1:ncol(out[[i]])) {
-        if(colnames(out[[i]])[j] %in% c('G','H','S','Cp')) out[[i]][,j] <- outvert(out[[i]][,j],'cal')
+      for(j in 1:ncol(OUT[[i]])) {
+        if(colnames(OUT[[i]])[j] %in% c('G','H','S','Cp')) OUT[[i]][,j] <- outvert(OUT[[i]][,j],'cal')
       }
     }
   }
   # put ionic strength next to any loggam columns
-  for(i in 2:length(out)) {
-    if('loggam' %in% colnames(out[[i]])) out[[i]] <- cbind(out[[i]],IS=newIS)
+  for(i in 2:length(OUT)) {
+    if('loggam' %in% colnames(OUT[[i]])) OUT[[i]] <- cbind(OUT[[i]],IS=newIS)
   }
   # more fanagling for species
   if(!do.reaction) {
-    out <- list(species=out$species,out=out[2:length(out)])
+    OUT <- list(species=OUT$species, out=OUT[2:length(OUT)])
     # add names to the output
-    names(out$out) <- as.character(reaction$name)
+    names(OUT$out) <- as.character(reaction$name)
   }
   # add warnings to output 20180922
   if(length(warnings) > 0) {
-    out <- c(out, list(warnings=warnings))
+    OUT <- c(OUT, list(warnings=warnings))
     for(warn in warnings) warning(warn)
   }
-  return(out)
+  return(OUT)
 }
 

Modified: pkg/CHNOSZ/R/util.affinity.R
===================================================================
--- pkg/CHNOSZ/R/util.affinity.R	2018-09-23 06:06:20 UTC (rev 327)
+++ pkg/CHNOSZ/R/util.affinity.R	2018-09-23 08:17:42 UTC (rev 328)
@@ -137,13 +137,13 @@
       if("P" %in% vars) P <- vals[[which(vars=="P")]]
       if("IS" %in% vars) IS <- vals[[which(vars=="IS")]]
       s.args <- list(species=species,property=property,T=T,P=P,IS=IS,grid=grid,convert=FALSE,exceed.Ttr=exceed.Ttr)
-      return(do.call("subcrt",s.args)$out)
+      return(do.call("subcrt",s.args))
     }
   }
 
   ### functions for logK/subcrt props
   # the logK contribution by any species or basis species
-  X.species <- function(ispecies,coeff,X) coeff * sout[[ispecies]][,names(sout[[ispecies]])==X]
+  X.species <- function(ispecies,coeff,X) coeff * sout$out[[ispecies]][,names(sout$out[[ispecies]])==X]
   # the logK contribution by all basis species in a reaction
   X.basis <- function(ispecies,X) Reduce("+", mapply(X.species,ibasis,-myspecies[ispecies,ibasis],X,SIMPLIFY=FALSE))
   # the logK of any reaction
@@ -198,7 +198,7 @@
     # (used by energy.args() for calculating pe=f(Eh,T) )
     # TODO: document that sout here denotes the dimension
     # we're expanding into
-    return(dim.fun(what,ivars(sout)))
+    return(dim.fun(what,ivars(sout$out)))
   } else if(what %in% c('G','H','S','Cp','V','E','kT','logK')) {
     # get subcrt properties for reactions
     sout <- sout.fun(what)
@@ -345,7 +345,7 @@
     # what variable is Eh
     Eh.var <- which(args$vars=="Eh")
     Eh.args$what <- args$vals[[Eh.var]]
-    Eh.args$sout <- Eh.var
+    Eh.args$sout$out <- Eh.var
     Eh <- do.call("energy",Eh.args)
     # get temperature into our dimensions
     T.args <- args  
@@ -356,7 +356,7 @@
       T.var <- 1
       T.args$what <- T
     }
-    T.args$sout <- T.var
+    T.args$sout$out <- T.var
     T <- do.call("energy",T.args)
     # do the conversion on vectors
     mydim <- dim(Eh)

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-23 06:06:20 UTC (rev 327)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-23 08:17:42 UTC (rev 328)
@@ -1,4 +1,4 @@
-CHANGES IN CHNOSZ 1.1.3-34 (2018-09-23)
+CHANGES IN CHNOSZ 1.1.3-36 (2018-09-23)
 ---------------------------------------
 
 THERMODYNAMIC DATA
@@ -90,6 +90,10 @@
 - Change internal variable names in subcrt() for better readability
   (sinfo -> ispecies, inpho -> iphases, sinph -> phasespecies).
 
+- To provide betters diagnostics for potential web apps, warning
+  messages produced by subcrt() are now available in the output of
+  affinity(), under 'sout$warnings'.
+
 BUG FIXES
 
 - Fix a bug where subcrt()$reaction$coeffs was incorrect for reactions


From noreply at r-forge.r-project.org  Wed Sep 26 02:57:25 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 26 Sep 2018 02:57:25 +0200 (CEST)
Subject: [CHNOSZ-commits] r329 - in pkg/CHNOSZ: . R demo inst man
	tests/testthat
Message-ID: <20180926005725.93CA618AFF9@r-forge.r-project.org>

Author: jedick
Date: 2018-09-26 02:57:25 +0200 (Wed, 26 Sep 2018)
New Revision: 329

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/affinity.R
   pkg/CHNOSZ/R/berman.R
   pkg/CHNOSZ/R/diagram.R
   pkg/CHNOSZ/R/mosaic.R
   pkg/CHNOSZ/R/subcrt.R
   pkg/CHNOSZ/R/util.affinity.R
   pkg/CHNOSZ/demo/mosaic.R
   pkg/CHNOSZ/inst/NEWS
   pkg/CHNOSZ/man/CHNOSZ-package.Rd
   pkg/CHNOSZ/man/affinity.Rd
   pkg/CHNOSZ/man/subcrt.Rd
   pkg/CHNOSZ/tests/testthat/test-berman.R
   pkg/CHNOSZ/tests/testthat/test-mosaic.R
   pkg/CHNOSZ/tests/testthat/test-subcrt.R
Log:
subcrty(), affinity(): add 'exceed.rhomin' argument


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-26 00:57:25 UTC (rev 329)
@@ -1,6 +1,6 @@
-Date: 2018-09-23
+Date: 2018-09-26
 Package: CHNOSZ
-Version: 1.1.3-36
+Version: 1.1.3-37
 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),

Modified: pkg/CHNOSZ/R/affinity.R
===================================================================
--- pkg/CHNOSZ/R/affinity.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/affinity.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -12,8 +12,8 @@
 #source("util.data.R")
 #source("species.R")
 
-affinity <- function(...,property=NULL,sout=NULL,exceed.Ttr=FALSE,
-  return.buffer=FALSE,balance="PBB",iprotein=NULL,loga.protein=-3) {
+affinity <- function(..., property=NULL, sout=NULL, exceed.Ttr=FALSE, exceed.rhomin=FALSE,
+  return.buffer=FALSE, balance="PBB", iprotein=NULL, loga.protein=-3) {
   # ...: variables over which to calculate
   # property: what type of energy
   #   (G.basis,G.species,logact.basis,logK,logQ,A)
@@ -30,7 +30,7 @@
 
   # the argument list
   args <- energy.args(list(...))
-  args <- c(args,list(sout=sout,exceed.Ttr=exceed.Ttr))
+  args <- c(args, list(sout=sout, exceed.Ttr=exceed.Ttr, exceed.rhomin=exceed.rhomin))
 
   # the species we're given
   thermo <- get("thermo")

Modified: pkg/CHNOSZ/R/berman.R
===================================================================
--- pkg/CHNOSZ/R/berman.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/berman.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -110,6 +110,8 @@
     Tprime <- T + Td
     # with the condition that Tref < Tprime < Tlambda(1bar)
     iTprime <- Tref < Tprime & Tprime < Tlambda
+    # handle NA values (arising from NA in input P values e.g. Psat above Tcritical) 20180925
+    iTprime[is.na(iTprime)] <- FALSE
     Tprime <- Tprime[iTprime]
     Cptr[iTprime] <- Tprime * (l1 + l2 * Tprime)^2
     # we got Cp, now calculate the integrations for H and S
@@ -118,6 +120,8 @@
     Ttr <- T[iTtr]
     Tlambda_P <- Tlambda_P[iTtr]
     Td <- Td[iTtr]
+    # handle NA values 20180925
+    Tlambda_P[is.na(Tlambda_P)] <- Inf
     # the upper integration limit is Tlambda_P
     Ttr[Ttr >= Tlambda_P] <- Tlambda_P[Ttr >= Tlambda_P]
     # derived variables

Modified: pkg/CHNOSZ/R/diagram.R
===================================================================
--- pkg/CHNOSZ/R/diagram.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/diagram.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -560,8 +560,10 @@
         zs <- t(predominant[, ncol(predominant):1])
         if(!is.null(fill)) fill.color(xs, ys, zs, fill, ngroups)
         pn <- plot.names(zs, xs, ys, names)
-        # only draw the lines if there is more than one field (avoid warnings from contour)
-        if(length(unique(as.vector(zs))) > 1) {
+        # only draw the lines if there is more than one field  20180923
+        # (to avoid warnings from contour, which seem to be associated with weird
+        # font metric state and subsequent errors adding e.g. subscripted text to plot)
+        if(length(na.omit(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)
         }

Modified: pkg/CHNOSZ/R/mosaic.R
===================================================================
--- pkg/CHNOSZ/R/mosaic.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/mosaic.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -60,15 +60,18 @@
   A.species <- affs[[1]]
   if(blend) {
     # calculate affinities using relative abundances of basis species
-    e <- equilibrate(A.bases)
-    # what is the total activity of the basis species?
-    a.tot <- Reduce("+", lapply(e$loga.equil, function(x) 10^x))
-    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]]/a.tot
+    # this isn't needed (and doesn't work) if all the affinities are NA 20180925
+    if(any(!sapply(A.species$values, is.na))) {
+      e <- equilibrate(A.bases)
+      # what is the total activity of the basis species?
+      a.tot <- Reduce("+", lapply(e$loga.equil, function(x) 10^x))
+      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]]/a.tot
+        }
       }
     }
   } else {

Modified: pkg/CHNOSZ/R/subcrt.R
===================================================================
--- pkg/CHNOSZ/R/subcrt.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/subcrt.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -12,7 +12,7 @@
 
 subcrt <- function(species, coeff = 1, state = NULL, property = c("logK", "G", "H", "S", "V", "Cp"),
   T = seq(273.15, 623.15, 25), P = "Psat", grid = NULL, convert = TRUE, exceed.Ttr = FALSE,
-  logact = NULL, action.unbalanced = "warn", IS = 0) {
+  exceed.rhomin = FALSE, logact = NULL, action.unbalanced = "warn", IS = 0) {
 
   # revise the call if the states have 
   # come as the second argument 
@@ -287,12 +287,14 @@
     p.aq <- hkfstuff$aq
     H2O.PT <- hkfstuff$H2O
     # 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) ptext <- "pair" else ptext <- "pairs"
-      warnings <- c(warnings, paste0("below minimum density for applicability of revised HKF equations (", sum(ilowrho), " T,P ", ptext, ")"))
+    if(!exceed.rhomin) {
+      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) 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/R/util.affinity.R
===================================================================
--- pkg/CHNOSZ/R/util.affinity.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/R/util.affinity.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -17,7 +17,7 @@
 
 ### unexported functions ###
 
-energy <- function(what,vars,vals,lims,T=298.15,P="Psat",IS=0,sout=NULL,exceed.Ttr=FALSE,transect=FALSE) {
+energy <- function(what,vars,vals,lims,T=298.15,P="Psat",IS=0,sout=NULL,exceed.Ttr=FALSE,exceed.rhomin=FALSE,transect=FALSE) {
   # 20090329 extracted from affinity() and made to
   # deal with >2 dimensions (variables)
 
@@ -136,7 +136,7 @@
       if("T" %in% vars) T <- vals[[which(vars=="T")]]
       if("P" %in% vars) P <- vals[[which(vars=="P")]]
       if("IS" %in% vars) IS <- vals[[which(vars=="IS")]]
-      s.args <- list(species=species,property=property,T=T,P=P,IS=IS,grid=grid,convert=FALSE,exceed.Ttr=exceed.Ttr)
+      s.args <- list(species=species,property=property,T=T,P=P,IS=IS,grid=grid,convert=FALSE,exceed.Ttr=exceed.Ttr,exceed.rhomin=exceed.rhomin)
       return(do.call("subcrt",s.args))
     }
   }

Modified: pkg/CHNOSZ/demo/mosaic.R
===================================================================
--- pkg/CHNOSZ/demo/mosaic.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/demo/mosaic.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -22,13 +22,13 @@
 # calculate affinities using the predominant basis species
 # using blend=TRUE we get curvy lines, particularly at the boundaries with siderite
 # compare with the plot in Garrels and Christ, 1965
-m1 <- mosaic(bases, bases2, TRUE, pH=pH, Eh=Eh, T=T)
+m1 <- mosaic(bases, bases2, blend=TRUE, pH=pH, Eh=Eh, T=T)
 # make a diagram and add water stability lines
 diagram(m1$A.species, lwd=2)
 water.lines(m1$A.species, col="seagreen", lwd=1.5)
 # show lines for Fe(aq) = 10^-4 M
 species(c("Fe+2", "Fe+3"), -4)
-m2 <- mosaic(bases, bases2, TRUE, pH=pH, Eh=Eh, T=T)
+m2 <- mosaic(bases, bases2, blend=TRUE, pH=pH, Eh=Eh, T=T)
 diagram(m2$A.species, add=TRUE, names=NULL)
 title(main=paste("Iron oxides, sulfides and carbonate in water, log(total S) = -6,",
   "log(total C)=0, after Garrels and Christ, 1965", sep="\n"))

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-26 00:57:25 UTC (rev 329)
@@ -1,4 +1,4 @@
-CHANGES IN CHNOSZ 1.1.3-36 (2018-09-23)
+CHANGES IN CHNOSZ 1.1.3-37 (2018-09-26)
 ---------------------------------------
 
 THERMODYNAMIC DATA
@@ -62,8 +62,34 @@
   plot saturation lines for minerals (where their affinity equals
   zero).
 
+BUG FIXES
+
+- Fix a bug where subcrt()$reaction$coeffs was incorrect for reactions
+  involving minerals with phase transitions. Also ensure that the output
+  reaction stoichiometry is correct for duplicated species in reactions.
+  Thanks to Grayson Boyer for the bug report.
+
+- Fix bug in nonideal() where "Zn" in formula was identified as charge.
+  Thanks to Feng Lai for reporting the incorrect behavior caused by
+  this bug.
+
+- For species in the revised HKF model, subcrt() now sets properties to
+  NA where the density of H2O is less than 0.35 g/cm3, avoiding the
+  output of bogus values in this region. Thanks to Evgeniy Bastrakov.
+
 OTHER CHANGES
 
+- Add 'exceed.rhomin' argument to subcrt() and affinity() to enable
+  output of properties for species in the revised HKF model below 0.35
+  g/cm3.
+
+- To provide betters diagnostics for potential web apps, warning
+  messages produced by subcrt() are now available in the output of
+  affinity(), under 'sout$warnings'.
+
+- Change internal variable names in subcrt() for better readability
+  (sinfo -> ispecies, inpho -> iphases, sinph -> phasespecies).
+
 - Add dumpdata() for returning/writing all packaged thermodynamic data
   (including default database and optional data files).
 
@@ -87,28 +113,6 @@
 - Keywords in basis(): Change 'CHNOPS+' to use O2 instead of e-, and add
   'CHNOPSe' and 'MgCHNOPSe' for sets of basis species that have e-.
 
-- Change internal variable names in subcrt() for better readability
-  (sinfo -> ispecies, inpho -> iphases, sinph -> phasespecies).
-
-- To provide betters diagnostics for potential web apps, warning
-  messages produced by subcrt() are now available in the output of
-  affinity(), under 'sout$warnings'.
-
-BUG FIXES
-
-- Fix a bug where subcrt()$reaction$coeffs was incorrect for reactions
-  involving minerals with phase transitions. Also ensure that the output
-  reaction stoichiometry is correct for duplicated species in reactions.
-  Thanks to Grayson Boyer for the bug report.
-
-- Fix bug in nonideal() where "Zn" in formula was identified as charge.
-  Thanks to Feng Lai for reporting the incorrect behavior caused by
-  this bug.
-
-- For species in the revised HKF model, subcrt() now sets properties to
-  NA where the density of H2O is less than 0.35 g/cm3, avoiding the
-  output of bogus values in this region. Thanks to Evgeniy Bastrakov.
-
 CHANGES IN CHNOSZ 1.1.3 (2017-11-13)
 ------------------------------------
 

Modified: pkg/CHNOSZ/man/CHNOSZ-package.Rd
===================================================================
--- pkg/CHNOSZ/man/CHNOSZ-package.Rd	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/man/CHNOSZ-package.Rd	2018-09-26 00:57:25 UTC (rev 329)
@@ -2,7 +2,7 @@
 \name{CHNOSZ-package}
 \alias{CHNOSZ-package}
 \docType{package}
-\title{Thermodynamic Calculations for Geobiochemistry}
+\title{Thermodynamic Calculations and Diagrams for Geo(bio)chemistry}
 \description{
 CHNOSZ is a package for thermodynamic calculations, primarily with applications in geochemistry and compositional biology.
 It can be used to calculate the standard molal thermodynamic properties and chemical affinities of reactions relevant to geobiochemical processes, and to visualize the equilibrium activities of species on chemical speciation and predominance diagrams.

Modified: pkg/CHNOSZ/man/affinity.Rd
===================================================================
--- pkg/CHNOSZ/man/affinity.Rd	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/man/affinity.Rd	2018-09-26 00:57:25 UTC (rev 329)
@@ -7,7 +7,7 @@
 }
 
 \usage{
-  affinity(..., property=NULL, sout=NULL, exceed.Ttr=FALSE,
+  affinity(..., property=NULL, sout=NULL, exceed.Ttr=FALSE, exceed.rhomin = FALSE,
     return.buffer=FALSE, balance="PBB", iprotein=NULL, loga.protein=-3)
 }
 
@@ -16,6 +16,7 @@
   \item{property}{character, the property to be calculated. Default is \samp{A}, for chemical affinity of formation reactions of species of interest}
   \item{sout}{list, output from \code{\link{subcrt}}}
   \item{exceed.Ttr}{logical, allow \code{\link{subcrt}} to compute properties for phases beyond their transition temperature?}
+  \item{exceed.rhomin}{logical, allow \code{\link{subcrt}} to compute properties of species in the HKF model below 0.35 g cm\S{-3}?}
   \item{return.buffer}{logical. If \code{TRUE}, and a \code{\link{buffer}} has been associated with one or more basis species in the system, return the values of the activities of the basis species calculated using the buffer. Default is \code{FALSE}.}
   \item{balance}{character. This argument is used to identify a conserved basis species (or \samp{PBB}) in a chemical activity buffer. Default is \samp{PBB}.}
   \item{iprotein}{numeric, indices of proteins in \code{\link{thermo}$protein} for which to calculate properties}

Modified: pkg/CHNOSZ/man/subcrt.Rd
===================================================================
--- pkg/CHNOSZ/man/subcrt.Rd	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/man/subcrt.Rd	2018-09-26 00:57:25 UTC (rev 329)
@@ -10,8 +10,8 @@
   subcrt(species, coeff = 1, state = NULL,
     property = c("logK","G","H","S","V","Cp"),
     T = seq(273.15,623.15,25), P = "Psat", grid = NULL, 
-    convert = TRUE, exceed.Ttr = FALSE, logact = NULL,
-    action.unbalanced = "warn", IS = 0)
+    convert = TRUE, exceed.Ttr = FALSE, exceed.rhomin = FALSE,
+    logact = NULL, action.unbalanced = "warn", IS = 0)
 }
 
 \arguments{
@@ -23,6 +23,7 @@
   \item{P}{numeric, pressure(s) of the calculation, or character, \samp{Psat}}
   \item{grid}{character, type of \code{P}\eqn{\times}{x}\code{T} grid to produce (NULL, the default, means no gridding)}
   \item{exceed.Ttr}{logical, calculate Gibbs energies of mineral phases and other species beyond their transition temperatures?}
+  \item{exceed.rhomin}{logical, return properties of species in the HKF model below 0.35 g cm\S{-3}?}
   \item{logact}{numeric, logarithms of activities of species in reaction}
   \item{convert}{logical, are input and output units of T and P those of the user (\code{TRUE}) (see \code{\link{T.units}}), or are they Kelvin and bar (\code{FALSE})?}
   \item{action.unbalanced}{character \samp{warn} or NULL, what action to take if unbalanced reaction is provided}

Modified: pkg/CHNOSZ/tests/testthat/test-berman.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-berman.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/tests/testthat/test-berman.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -88,3 +88,14 @@
   thermo$opt$Berman <<- NA
   expect_error(berman("xxx"), "Data for xxx not available. Please add it to your_data_file.csv")
 })
+
+test_that("NA values of P are handled", {
+  sresult <- subcrt("H2O", T = seq(0, 500, 100))
+  T <- sresult$out$water$T
+  P <- sresult$out$water$P
+  # this stopped with a error prior to version 1.1.3-37
+  bresult <- berman("quartz", T = convert(T, "K"), P = P)
+  expect_equal(sum(is.na(bresult$G)), 2)
+  # this also now works (producing the same NA values)
+  #subcrt("quartz", T = seq(0, 500, 100))
+})

Modified: pkg/CHNOSZ/tests/testthat/test-mosaic.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-mosaic.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/tests/testthat/test-mosaic.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -3,15 +3,22 @@
 test_that("results are consistent with affinity()", {
   basis(c("CO2", "H2O", "NH3", "O2"), c(0, 0, 0, 0))
   species(c("alanine", "glycine"))
-  a <- affinity()
+  a25 <- 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)
+  m1_25 <- 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)
+  expect_equal(a25$values, m1_25$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)
+  m2_25 <- mosaic("NH3", "CO2")
+  expect_equal(a25$values, m2_25$A.species$values)
+  # make sure the function works when all affinities are NA
+  a500 <- affinity(T=500)
+  # using blend=TRUE was failing prior to version 1.1.3-37
+  m1_500 <- mosaic("NH3", "CO2", blend=TRUE, T=500)
+  expect_equal(a500$values, m1_500$A.species$values)
+  m2_500 <- mosaic("NH3", "CO2", T=500)
+  expect_equal(a500$values, m2_500$A.species$values)
 })
 
 test_that("blend=TRUE produces reasonable values", {

Modified: pkg/CHNOSZ/tests/testthat/test-subcrt.R
===================================================================
--- pkg/CHNOSZ/tests/testthat/test-subcrt.R	2018-09-23 08:17:42 UTC (rev 328)
+++ pkg/CHNOSZ/tests/testthat/test-subcrt.R	2018-09-26 00:57:25 UTC (rev 329)
@@ -186,9 +186,12 @@
 
 test_that("properties of HKF species below 0.35 g/cm3 are NA and give a warning", {
   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_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)
+  # use exceed.rhomin to go below the minimum density
+  s2 <- subcrt(c("Na+", "quartz"), T=450, P=c(400, 450, 500), exceed.rhomin=TRUE)
+  expect_equal(sum(is.na(s2$out$`Na+`$logK)), 0)
 })
 
 # references


From noreply at r-forge.r-project.org  Thu Sep 27 15:46:01 2018
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 27 Sep 2018 15:46:01 +0200 (CEST)
Subject: [CHNOSZ-commits] r330 - in pkg/CHNOSZ: . R inst man
Message-ID: <20180927134601.730C418A381@r-forge.r-project.org>

Author: jedick
Date: 2018-09-27 15:46:01 +0200 (Thu, 27 Sep 2018)
New Revision: 330

Modified:
   pkg/CHNOSZ/DESCRIPTION
   pkg/CHNOSZ/R/util.data.R
   pkg/CHNOSZ/inst/NEWS
   pkg/CHNOSZ/man/util.data.Rd
Log:
thermo.refs(): add 'keep.duplicates' argument


Modified: pkg/CHNOSZ/DESCRIPTION
===================================================================
--- pkg/CHNOSZ/DESCRIPTION	2018-09-26 00:57:25 UTC (rev 329)
+++ pkg/CHNOSZ/DESCRIPTION	2018-09-27 13:46:01 UTC (rev 330)
@@ -1,6 +1,6 @@
-Date: 2018-09-26
+Date: 2018-09-27
 Package: CHNOSZ
-Version: 1.1.3-37
+Version: 1.1.3-38
 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry
 Authors at R: c(
     person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"),

Modified: pkg/CHNOSZ/R/util.data.R
===================================================================
--- pkg/CHNOSZ/R/util.data.R	2018-09-26 00:57:25 UTC (rev 329)
+++ pkg/CHNOSZ/R/util.data.R	2018-09-27 13:46:01 UTC (rev 330)
@@ -1,7 +1,7 @@
 # CHNOSZ/util.data.R
 # check entries in the thermodynamic database
 
-thermo.refs <- function(key=NULL) {
+thermo.refs <- function(key=NULL, keep.duplicates=FALSE) {
   ## return references for thermodynamic data.
   ## 20110615 browse.refs() first version
   ## 20170212 thermo.refs() remove browsing (except for table of all sources)
@@ -135,8 +135,14 @@
   } else if(is.numeric(key)) {
     # get the source keys for the indicated species
     sinfo <- suppressMessages(info(key))
-    mysources <- unique(c(sinfo$ref1, sinfo$ref2))
-    mysources <- mysources[!is.na(mysources)]
+    if(keep.duplicates) {
+      # output a single reference for each species 20180927
+      # (including duplicated references, and not including ref2)
+      mysources <- sinfo$ref1
+    } else {
+      mysources <- unique(c(sinfo$ref1, sinfo$ref2))
+      mysources <- mysources[!is.na(mysources)]
+    }
     return(thermo.refs(mysources))
   } else if(is.list(key)) {
     if("species" %in% names(key)) ispecies <- key$species$ispecies

Modified: pkg/CHNOSZ/inst/NEWS
===================================================================
--- pkg/CHNOSZ/inst/NEWS	2018-09-26 00:57:25 UTC (rev 329)
+++ pkg/CHNOSZ/inst/NEWS	2018-09-27 13:46:01 UTC (rev 330)
@@ -1,4 +1,4 @@
-CHANGES IN CHNOSZ 1.1.3-37 (2018-09-26)
+CHANGES IN CHNOSZ 1.1.3-38 (2018-09-27)
 ---------------------------------------
 
 THERMODYNAMIC DATA
@@ -113,6 +113,11 @@
 - Keywords in basis(): Change 'CHNOPS+' to use O2 instead of e-, and add
   'CHNOPSe' and 'MgCHNOPSe' for sets of basis species that have e-.
 
+- Add 'keep.duplicates' argument to thermo.refs(). Set it to TRUE to
+  output a single primary reference for each species, keeping any
+  duplicated references (but not including any secondary references in
+  thermo$obigt$ref2). Thanks to Evgeniy Bastrakov for the suggestion.
+
 CHANGES IN CHNOSZ 1.1.3 (2017-11-13)
 ------------------------------------
 

Modified: pkg/CHNOSZ/man/util.data.Rd
===================================================================
--- pkg/CHNOSZ/man/util.data.Rd	2018-09-26 00:57:25 UTC (rev 329)
+++ pkg/CHNOSZ/man/util.data.Rd	2018-09-27 13:46:01 UTC (rev 330)
@@ -14,7 +14,7 @@
 }
 
 \usage{
-  thermo.refs(key=NULL)
+  thermo.refs(key=NULL, keep.duplicates=FALSE)
   checkEOS(eos, state, prop, ret.diff = FALSE)
   checkGHS(ghs, ret.diff = FALSE)
   check.obigt()
@@ -25,6 +25,7 @@
 
 \arguments{
   \item{key}{character, numeric, or list; bibliographic reference key(s)}
+  \item{keep.duplicates}{logical, keep duplicated references?}
   \item{eos}{dataframe, equations-of-state parameters in the format of \code{thermo$obigt}}
   \item{state}{character, physical state of species}
   \item{prop}{character, property of interest (\samp{Cp} or \samp{V})}
@@ -40,6 +41,8 @@
 Otherwise, if \code{key} is character, the citation information for those reference \code{key}s (including URLs) are returned.
 If \code{key} is numeric, the values refer to the species in those rows of \code{thermo$obigt}, and the citation information for each listed reference (\code{thermo$obigt$ref1}, \code{thermo$obigt$ref2}) is returned.
 If \code{key} is a list, it is interpreted as the result of a call to \code{subcrt}, and the citation information for each species involved in the calculation is returned.
+Only unique references are returned, unless \code{keep.duplicates} is TRUE.
+In that case, a single reference for each species is returned, ignoring anything in \code{thermo$obigt$ref2}.
 
 \code{checkEOS} compares heat capacity and volume calculated from equation-of-state parameters with reference (tabulated) values at 25 \degC and 1 bar and prints a message and returns the calculated value if tolerance is exceeded.
 The Helgeson-Kirkham-Flowers equations of state parameters are in \code{eos}, which is a data frame with columns (and column names) in the same format as \code{\link{thermo}$obigt}.