Commit 3bf62f22 by Marco De Lucia

### Bumped to 0.3.4

parent 968002bb
 Package: RedModRphree Title: Utilities Leveraging the R Interface to the PHREEQC Geochemical Solver Version: 0.3.3 Version: 0.3.4 Authors@R: c(person(given = "Marco", family = "De Lucia", email = "delucia@gfz-potsdam.de", ... ...
 ## Functions for dealing with simulations with kinetics ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2021 ### Time-stamp: "Last modified 2021-04-28 17:23:36 delucia" ### Time-stamp: "Last modified 2021-04-29 20:18:12 delucia" ##' This function runs the generated input buffer (or a list thereof) ##' through \code{phreeqc}, which has been already loaded as ... ... @@ -249,16 +249,14 @@ DistributeMatrix <- function(input, prop, values, minerals, SI=FALSE) if (n!=ncol(values)) { stopmsg("prop names and values matrix of different dimension.") } if (is.character(minerals)) { if (is.character(minerals)) { qmin <- gsub("\\(","\\\\(",minerals) qmin <- gsub("\\)","\\\\)",qmin) mins <- match(qmin, qprop) } else } else mins <- as.numeric(minerals) indAq <- seq(1:n)[-mins] indAq <- seq(1,n)[-mins] newinp <- input for (i in indAq) { ... ... @@ -290,7 +288,7 @@ DistributeMatrix <- function(input, prop, values, minerals, SI=FALSE) DistributeKinMatrix <- function(input, prop, values, minerals, kin, dt, ann) { if (!is.matrix(values)&&!is.data.frame(values)) stop("I need a matrix to distribute") stopmsg("I need a matrix to distribute") ## correct quoting qprop <- gsub("\\(","\\\\(",prop) qprop <- gsub("\\)","\\\\)",qprop) ... ... @@ -373,12 +371,13 @@ splitMultiFix <- function(data, procs, base, first, prop, minerals, nmax=200, ve ntot <- nrow(datamat) } if ( ntot ==1) ## try and call normal Distribute (i.e., ##!is.matrix(data) || if ( ntot==1 ) { ## try and call normal Distribute (i.e., ##!is.matrix(data) || ## just 1 simulation!) { if (verbose) msg("just 1 simulation, reverting back to normal Distribute") BigInp <- RepSol(base, 1, first=first) BigInp <- RepSol(base, 1) namdis <- colnames(data) indminer <- minerals nammin <- namdis[indminer] ... ... @@ -401,8 +400,8 @@ splitMultiFix <- function(data, procs, base, first, prop, minerals, nmax=200, ve totl <- c(nlong,rep(nsim,procs-1)) breaks <- c(0,cumsum(totl)) BigInplong <- RepSol(base, nlong, first=first) BigInp <- RepSol(base, nsim, first=first) BigInplong <- RepSol(base, nlong) BigInp <- RepSol(base, nsim) newlist <- vector(mode="list", length=procs) for (i in seq_along(newlist)) { ... ... @@ -412,14 +411,15 @@ splitMultiFix <- function(data, procs, base, first, prop, minerals, nmax=200, ve input <- vector(mode="list", length=procs) attr(input,"sims") <- breaks input[[1]] <- DistributeMatrix(BigInplong, prop, newlist[[1]], minerals=minerals) input[[1]] <- c(first, DistributeMatrix(BigInplong, prop, newlist[[1]], minerals=minerals)) input[c(2:procs)] <- lapply(newlist[c(2:procs)], function(x) return(DistributeMatrix(BigInp, prop, x, minerals=minerals)) return(c(first, DistributeMatrix(BigInp, prop, x, minerals=minerals))) ) } else { BigInp <- RepSol(base, ntot, first=first) BigInp <- RepSol(base, ntot) input <- DistributeMatrix(input=BigInp, prop=prop, values=data, minerals=minerals) input <- c(first, BigInp) } return(input) } ... ...
 ## Functions for dealing with surrogate simulations ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2021 ### Time-stamp: "Last modified 2021-04-28 18:13:39 delucia" ### Time-stamp: "Last modified 2021-04-29 18:33:18 delucia" ##' This function takes the current state of a chemical system in form ... ... @@ -619,7 +619,6 @@ ReactTranspBalanceKin <- function(setup, init, maxtime, step=c("time","iter","fi parallel::clusterExport(cl=ThisRunCluster, varlist=c("model","surrogate.FUN"), envir = environment()) msg("All workers are setup with the surrogate model.") } } if (missing(init)) { msg("missing initial chemical state") ... ...
 ### Utility functions for RedModRphree ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2021 ### Time-stamp: "Last modified 2021-04-29 17:36:29 delucia" ### Time-stamp: "Last modified 2021-04-29 20:17:47 delucia" ##' Replicates an input buffer containing only one SOLUTION, taking ##' care of SOLUTION/KINETICS/PURE identifiers. Eventually insert a ... ... @@ -21,26 +21,17 @@ RepSol <- function(sol, n, first=NULL) if (length(dum <- grep("^TITLE|^DATABASE",sol)) > 0 ) sol <- sol[-dum] if (is.character(first)) { firstend <- grep("^END",sol)[1] newsol <- c(sol[-firstend],first,"END",rep(sol,n-1)) } else { newsol <- rep(sol,n) } if (length(linesol <- grep("^SOLUTION",newsol)) != n) { if (length(linesol <- grep("^SOLUTION",newsol)) != n) { stopmsg("too many or no SOLUTION defined") } else { newsol[linesol] <- paste("SOLUTION",1:n) } linepure <- grep("^PURE|^EQUIL",newsol) if (length(linepure) > 0 ) { if (length(linepure) != n) { if (length(linepure) > 0 ) { if (length(linepure) != n) { stopmsg("too many or no PURE defined") } else { newsol[linepure] <- paste("PURE",1:n) ... ... @@ -48,15 +39,17 @@ RepSol <- function(sol, n, first=NULL) } linekin <- grep("^KINET",newsol) if (length(linekin) > 0) { if (length(linekin) != n) { if (length(linekin) > 0) { if (length(linekin) != n) { stopmsg("too many or no KINET defined") } else { newsol[linekin] <- paste("KINETICS",1:n) } } if (is.character(first)) newsol <- c(first,newsol) return(newsol) } ... ... @@ -174,31 +167,30 @@ AddProp <- function(input, name, values, cat, kinpar=NULL, first=NULL) ##' @export Distribute <- function(input, prop, values, newname=NULL, first=NULL, wholeline=TRUE) { ## correct quoting of parenthesis reg <- gsub("\\(","\\\\(",prop) reg <- gsub("\\)","\\\\)",reg) ## coerce values to character n <- length(val <- as.character(values)) nsim <- length(proplines <- grep(paste0("^", reg),input)) nval <- length(val <- as.character(values)) ## check how many lines contain the property we want to distribute nsim <- length(proplines <- grep(paste0("^", reg, " "),input)) if (n != nsim && nsim != 1) { stopmsg("Lengths of simulation and values do not agree") } linesave <- NULL linesave <- NULL if (nsim == 1) { ## deal with comments after the properties (i.e. "as HCO3") if (!wholeline) { dum <- unlist(strsplit(gsub(' +',' ',grep(paste0("^", reg), input, value=TRUE))," ")) ## deal with comments after the properties (i.e. "as HCO3") dum <- unlist(strsplit(gsub(' +',' ',grep(paste0("^", reg, " "), input, value=TRUE))," ")) if (length(dum)>2) linesave <- paste(dum[3:length(dum)],collapse=" ") } ## if the simulation is just 1, then repeat it n times (adding "first") ## grep(paste("^", reg, " ", sep=""), input, value=TRUE) newinp <- RepSol(input, n, first) nsim <- length(proplines <- grep(paste0("^", reg), newinp)) newinp <- RepSol(input, n) nsim <- length(proplines <- grep(paste0("^", reg, " "), newinp)) } else { newinp <- input } ... ... @@ -206,6 +198,9 @@ Distribute <- function(input, prop, values, newname=NULL, first=NULL, wholeline= newname <- prop newinp[proplines] <- paste(newname, val, linesave) if (is.character(first)) newinp <- c(first, newinp) return(newinp) } ... ...
 ### Licence: LGPL version 2.1 ## Time-stamp: "Last modified 2021-04-28 18:23:19 delucia" ## Time-stamp: "Last modified 2021-04-29 21:21:38 delucia" library(RedModRphree) require(e1071) require(import) ... ...