Skip to content
GitLab
Commit e23f1366 authored by Marco De Lucia's avatar Marco De Lucia
Browse files

Merge branch 'cran' into 'master' 

Bumped to 0.3.3; fixed AddProp, removed all references to "ListInfo",...

See merge request !2
parents fd398bb7 0e74fb2f
Expand all Hide whitespace changes
Inline Side-by-side
.gitignore 0 → 100644
View file @ e23f1366
### R ###
# History files
.Rhistory
.Rapp.history
# Session Data files
.RData
# User-specific files
.Ruserdata
# Example code in package build process
*-Ex.R
# Output files from R CMD build
/*.tar.gz
# Output files from R CMD check
/*.Rcheck/
# RStudio files
.Rproj.user/
# produced vignettes
vignettes/*.html
vignettes/*.pdf
# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
.httr-oauth
# knitr and R markdown default cache directories
*_cache/
/cache/
# Temporary files created by R markdown
*.utf8.md
*.knit.md
# R Environment Variables
.Renviron
DESCRIPTION
View file @ e23f1366
Package: RedModRphree Package: RedModRphree
Title: Leverage geochemical modelling with phreeqc Title: Utilities Leveraging the R Interface to the PHREEQC Geochemical Solver
Version: 0.1.1 Version: 0.3.4
Authors@R: c(person("Marco", "De Lucia", email = "delucia@gfz-potsdam.de", role = c("aut", "cre"), comment=c(ORCID = "0000-0002-1186-4491")), Authors@R: c(person(given = "Marco",
person("Janis", "Jatnieks", email = "deltaxzz@gmail.com", role = c("ctb"))) family = "De Lucia",
Description: Utilities to program algorithms involving geochemical models email = "delucia@gfz-potsdam.de",
Depends: R (>= 3.2.0), doParallel, plyr, data.table, phreeqc, caret, mgcv, randomForest, graphics, methods role = c("aut", "cre"),
Author: Marco De Lucia [aut, cre] comment = c(ORCID = "0000-0003-0918-3766")),
Maintainer: Marco De Lucia <delucia@gfz-potsdam.de> person(given = "Janis",
family = "Jatnieks",
email = "deltaxzz@gmail.com",
role = c("ctb")))
Description: Utilities and building blocks for programming with the
PHREEQC geochemical solver. Includes features such as 1D reactive
transport with surrogate models, database manipulation, parsing of
PHREEQC output files and Pourbaix diagrams.
Depends: R (>= 4.0.1), doParallel, phreeqc, mgcv, graphics, methods, stats, utils, plyr, foreach
License: LGPL-2.1 License: LGPL-2.1
Encoding: UTF-8 Encoding: UTF-8
LLazyData: true
RoxygenNote: 7.1.1 RoxygenNote: 7.1.1
LazyData: true
LICENSE deleted 100644 → 0
View file @ fd398bb7
This diff is collapsed.
NAMESPACE
View file @ e23f1366
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(AME)
export(Act2pH) export(Act2pH)
export(AddProp) export(AddProp)
export(AdvectionPQC) export(AdvectionPQC)
export(AllowSomeNegativeColumns)
export(AnalyticalLogK) export(AnalyticalLogK)
export(BalanceEquations) export(BalanceEquations)
export(BatchPreProc)
export(BatchPreProc_)
export(BestModelCluster)
export(CHT)
export(CheckBalance) export(CheckBalance)
export(CheckColsNumValues)
export(Cols2Fact)
export(CompareTimesteps)
export(Deltas)
export(Distribute) export(Distribute)
export(DistributeKin) export(DistributeKin)
export(DistributeKinMatrix) export(DistributeKinMatrix)
export(DistributeMatrix) export(DistributeMatrix)
export(DownSampler)
export(ElementalBalanceMin) export(ElementalBalanceMin)
export(ExtractPphases) export(ExtractPphases)
export(ExtractSamples) export(ExtractSamples)
export(ExtractSpecies) export(ExtractSpecies)
export(ExtractTotals) export(ExtractTotals)
export(FastClust)
export(Filtering)
export(FindAllMinNames) export(FindAllMinNames)
export(FindAllSpeciesNames) export(FindAllSpeciesNames)
export(FindAllTotNames) export(FindAllTotNames)
export(FindLogK) export(FindLogK)
export(FindPhase) export(FindPhase)
export(FitSurrogates) export(FlattenList)
export(FitWithDice) export(FormSelectedOutput)
export(FormulaFromBal) export(FormulaFromBal)
export(GetModelNames) export(FormulaToExpression)
export(GetRanges)
export(InitPreProc)
export(Loadata)
export(MAD)
export(MASE)
export(Matplot) export(Matplot)
export(MatplotSingle) export(MatplotSingle)
export(ModelSelector)
export(MultiRound)
export(NPSC)
export(NumericallyCompareTables)
export(OverrideValueRange)
export(ParseFormula) export(ParseFormula)
export(PlotModsInSample) export(PlotModsInSample)
export(Pourbaix)
export(RGetPhases)
export(RPhreeExt)
export(RPhreeFile) export(RPhreeFile)
export(RPhreeWriteInp) export(RPhreeWriteInp)
export(RPinfo)
export(RReadOut) export(RReadOut)
export(RReadOutKin) export(RReadOutKin)
export(RSS) export(RReadOutVal)
export(RangeTableCreator)
export(ReactTranspBalanceEq) export(ReactTranspBalanceEq)
export(ReactTranspBalanceKin) export(ReactTranspBalanceKin)
export(RecomposeState) export(RecomposeState)
export(ReduceState) export(ReduceState)
export(Refit)
export(Relcal)
export(RepSol) export(RepSol)
export(Reshaping)
export(RunModelList)
export(RunPQC) export(RunPQC)
export(RunSurrogates)
export(SAD)
export(SDrift)
export(SelectActiveColumns)
export(SelectColsByPredix)
export(SelectMinActiveColumns)
export(SelectPreProc)
export(ShowTopProfiler)
export(SparseChangeCluster)
export(StoichiometricMatrix) export(StoichiometricMatrix)
export(SubstractCommonTableCols)
export(SuppressSim) export(SuppressSim)
export(Surrogate)
export(TByElem)
export(Tminus)
export(TrailSpaces) export(TrailSpaces)
export(Train)
export(TranspAsPert) export(TranspAsPert)
export(WriteModel)
export(WriteModelResiduals)
export(all_mda_mars_impvars)
export(allcoluniquevals)
export(cf)
export(cfa)
export(coltypes)
export(coluniquevals)
export(coluniratio)
export(colwise_RSS)
export(colwise_rescale)
export(createTuneGrids)
export(custom_scaler)
export(dt2v)
export(exc)
export(exc_type)
export(f2i)
export(hb)
export(mae) export(mae)
export(mda_mars_importance)
export(mrm)
export(msg) export(msg)
export(na.to.zero)
export(namewithin)
export(nan.to.zero)
export(outminus)
export(pH2Act) export(pH2Act)
export(paralap)
export(rescaling)
export(roundbycol)
export(rsi)
export(safe_get_cores)
export(seekcoltypeidx)
export(seekcoltypename)
export(sharedvalues)
export(sliding_join)
export(smartround)
export(splitMultiFix) export(splitMultiFix)
export(splitMultiKin) export(splitMultiKin)
export(start_up)
export(stopmsg) export(stopmsg)
export(striplast) export(strrev)
export(striplastx) import(doParallel)
export(take_top_pct_cols) import(foreach)
export(to.zero)
export(uvc)
export(uvcm)
export(uvt)
export(write_evals)
import(caret)
import(data.table)
import(graphics) import(graphics)
import(methods)
import(mgcv) import(mgcv)
import(phreeqc) import(phreeqc)
import(plyr) import(plyr)
import(randomForest)
R/Rphree_DataBase.R
View file @ e23f1366
## Functions for manipulating PHREEQC databases ## Functions for manipulating PHREEQC databases
### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2018 ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2021
### Time-stamp: "Last modified 2018-05-03 17:23:09 delucia" ### Time-stamp: "Last modified 2021-04-28 18:39:07 delucia"
##' @title Finds the expression of a logK of a given compound/mineral ##' @title Finds the expression of a logK of a given compound/mineral
##' in a PHREEQC database ##' in a PHREEQC database
...@@ -155,7 +155,7 @@ ParseFormula <- function(line, type="all") ...@@ -155,7 +155,7 @@ ParseFormula <- function(line, type="all")
return(out) return(out)
} }
##' @title Find a PURE_PHASE in a database and parses its formula ##' @title Find a PURE_PHASE in a database and parse its formula
##' @param species name of phase to search for ##' @param species name of phase to search for
##' @param db a PHREEQC database (buffer) ##' @param db a PHREEQC database (buffer)
##' @return a list with the components of the formula and the ##' @return a list with the components of the formula and the
......
R/Rphree_Files.R
View file @ e23f1366
### File-related utility functions for RedModRphree ### File-related utility functions for RedModRphree
### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2018 ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2021
### Time-stamp: "Last modified 2018-05-03 11:00:16 delucia" ### Time-stamp: "Last modified 2021-04-29 18:02:02 delucia"
##' Reads a normal PHREEQC input file and prepares it for ##' Reads a normal PHREEQC input file and prepares it for
...@@ -88,12 +88,12 @@ RReadOut <- function(out) ...@@ -88,12 +88,12 @@ RReadOut <- function(out)
{ {
if (length(out)==1) {## is it a buffer or a file? if (length(out)==1) {## is it a buffer or a file?
## note that empty lines are removed! ## note that empty lines are removed!
cat(paste("RReadOut:: opening file",out,"\n")) msg("opening file",out)
tot <- RPhreeFile(out, is.db=FALSE, tabs=TRUE) tot <- RPhreeFile(out, is.db=FALSE, tabs=TRUE)
} else { } else {
## remove empty lines and tabs as in RPhreeFile, store ## remove empty lines and tabs as in RPhreeFile, store
## everything in "tot" ## everything in "tot"
cat("RReadOut:: scanning the buffer... \n") msg("scanning the buffer...")
tot <- sub(' +$', '', out) ## remove spaces at the end of the lines tot <- sub(' +$', '', out) ## remove spaces at the end of the lines
tot <- sub("#.*$","", tot) ## remove everything after the #'s tot <- sub("#.*$","", tot) ## remove everything after the #'s
tot <- gsub('\t', ' ', tot) ## substitute tabs with spaces tot <- gsub('\t', ' ', tot) ## substitute tabs with spaces
...@@ -113,8 +113,8 @@ RReadOut <- function(out) ...@@ -113,8 +113,8 @@ RReadOut <- function(out)
## This is unique (only for calculated solution) ## This is unique (only for calculated solution)
endsim <- grep('End of simulation.',tot,fixed=TRUE) endsim <- grep('End of simulation.',tot,fixed=TRUE)
cat(paste("RReadOut::",ntot," simulation in the given output")) msg(ntot," simulations in the given output")
## "phase assemblage" is unique, but could not be there ## "phase assemblage" is unique, but could not be there
has_pphases <- TRUE has_pphases <- TRUE
endkin <- grep('-Phase assemblage-',tot,fixed=TRUE) endkin <- grep('-Phase assemblage-',tot,fixed=TRUE)
...@@ -145,7 +145,7 @@ RReadOut <- function(out) ...@@ -145,7 +145,7 @@ RReadOut <- function(out)
error <- grep("^ERROR",tot[ solutions[n] : endsim[n] ]) error <- grep("^ERROR",tot[ solutions[n] : endsim[n] ])
if (length(error) > 0) { if (length(error) > 0) {
res[[n]] <- "error" res[[n]] <- "error"
cat(" ERROR!!\n") msg(" ERROR in simulation",n,", skipping")
next next
} }
...@@ -156,7 +156,7 @@ RReadOut <- function(out) ...@@ -156,7 +156,7 @@ RReadOut <- function(out)
npure <- endpure[n] - startpure - 1 npure <- endpure[n] - startpure - 1
pure_conn <- textConnection( tot[startpure:(startpure+npure)]) pure_conn <- textConnection( tot[startpure:(startpure+npure)])
pure <- read.table( pure_conn, row.names=1, fill=TRUE, as.is=TRUE) pure <- utils::read.table( pure_conn, row.names=1, fill=TRUE, as.is=TRUE)
close(pure_conn) close(pure_conn)
indreactants <- which(pure[,2]=="reactant") indreactants <- which(pure[,2]=="reactant")
if (length(indreactants) > 0) if (length(indreactants) > 0)
...@@ -180,7 +180,7 @@ RReadOut <- function(out) ...@@ -180,7 +180,7 @@ RReadOut <- function(out)
startcomp <- endpure[n] + 2 startcomp <- endpure[n] + 2
ncomp <- endcomp[n]-startcomp ncomp <- endcomp[n]-startcomp
comp_conn <- textConnection(tot[startcomp:(startcomp+ncomp-1)]) comp_conn <- textConnection(tot[startcomp:(startcomp+ncomp-1)])
comp <- read.table(comp_conn,row.names=1,fill=TRUE) comp <- utils::read.table(comp_conn,row.names=1,fill=TRUE)
close(comp_conn) close(comp_conn)
colnames(comp) <- c("molal","moles") colnames(comp) <- c("molal","moles")
## if (verbose) ## if (verbose)
...@@ -218,7 +218,7 @@ RReadOut <- function(out) ...@@ -218,7 +218,7 @@ RReadOut <- function(out)
block_conn <- textConnection(block) block_conn <- textConnection(block)
## Now we can read.table it ## Now we can read.table it
tmp <- read.table( block_conn, fill=TRUE, as.is=TRUE)[,c(1,2,3)] tmp <- utils::read.table( block_conn, fill=TRUE, as.is=TRUE)[,c(1,2,3)]
close(block_conn) close(block_conn)
## remove duplicated ## remove duplicated
rnames <- tmp$V1 rnames <- tmp$V1
...@@ -230,7 +230,7 @@ RReadOut <- function(out) ...@@ -230,7 +230,7 @@ RReadOut <- function(out)
## Now saturation indexes ## Now saturation indexes
block <- tot[(endspec[n] + 2) :( endsim[n] - 4)] block <- tot[(endspec[n] + 2) :( endsim[n] - 4)]
block_conn <- textConnection(block) block_conn <- textConnection(block)
SI <- read.table(block_conn, fill=TRUE, row.names=1, as.is=TRUE) SI <- utils::read.table(block_conn, fill=TRUE, row.names=1, as.is=TRUE)
close(block_conn) close(block_conn)
names(SI) <- c("SI","IAP","logK","formula") names(SI) <- c("SI","IAP","logK","formula")
...@@ -239,37 +239,33 @@ RReadOut <- function(out) ...@@ -239,37 +239,33 @@ RReadOut <- function(out)
} ## end of loop over simulations } ## end of loop over simulations
cat(" OK\n") msg(" Finished, bye!")
return(res) return(res)
} }
##' Kinetics simulation: reads a phreeqc output file and forms an ##' Kinetics simulation: reads a PHREEQC output file or buffer and
##' output list - as if the calculation was made through ##' forms an output list.
##' Rphree. ##' @title RReadOutKin, imports the output file of a kinetic
##' ##' simulation into R
##' ##' @param out The PHREEQC output file or buffer
##' @title RReadOutKin, import the output file of a kinetic simulation
##' into R
##' @param out The PHREEQC output file.
##' @param strip logical. If TRUE, the "ListInfo" element will be
##' appended to the list.
##' @param verbose logical. If TRUE more output is given to the ##' @param verbose logical. If TRUE more output is given to the
##' console (for debugging). ##' console (for debugging)
##' @return An output list as per Rphree call. ##' @return An output list containing one data.frame per
##' "logical block": desc, tot, pphases, species, kin
##' @author MDL ##' @author MDL
##' @export ##' @export
RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) RReadOutKin <- function(out, verbose=FALSE)
{ {
if (length(out)==1) {## is it a buffer or a file? if (length(out)==1) {## is it a buffer or a file?
## note that empty lines are removed! ## note that empty lines are removed!
cat(paste("RReadOutKin:: opening file",out,"\n")) msg("opening file",out)
tot <- RPhreeFile(out, is.db=FALSE, tabs=TRUE) tot <- RPhreeFile(out, is.db=FALSE, tabs=TRUE)
} else { } else {
## remove empty lines and tabs as in RPhreeFile, store ## remove empty lines and tabs as in RPhreeFile, store
## everything in "tot" ## everything in "tot"
cat("RReadOutKin:: scanning the buffer... \n") msg("scanning the buffer...")
tot <- sub(' +$', '', out) ## remove spaces at the end of the lines tot <- sub(' +$', '', out) ## remove spaces at the end of the lines
tot <- sub("#.*$","", tot) ## remove everything after the #'s tot <- sub("#.*$","", tot) ## remove everything after the #'s
tot <- gsub('\t', ' ', tot) ## substitute tabs with spaces tot <- gsub('\t', ' ', tot) ## substitute tabs with spaces
...@@ -281,7 +277,8 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -281,7 +277,8 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
if (length(toremove)>0) { if (length(toremove)>0) {
toremove <- sort(c(toremove, toremove+1)) toremove <- sort(c(toremove, toremove+1))
tot <- tot[-toremove] tot <- tot[-toremove]
if (verbose) cat("RReadOutKin:: Appears to be PHREEQC version 3\n") if (verbose)
msg("Appears to be PHREEQC version 3")
} }
times <- grep("Time step:", tot, fixed=TRUE) times <- grep("Time step:", tot, fixed=TRUE)
...@@ -290,7 +287,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -290,7 +287,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
years <- round(as.numeric(sub('\ .*$','',gsub('.*:\ ','',tot[times]))),1) years <- round(as.numeric(sub('\ .*$','',gsub('.*:\ ','',tot[times]))),1)
if (verbose) { if (verbose) {
cat(out,":\n") cat(out,":\n")
cat(paste("RReadOutKin:: Found ",ntot,"time steps, the last at time",years[ntot],"\n")) msg("Found ",ntot,"time steps, the last at time",years[ntot])
} }
endkin <- grep('-Phase assemblage-',tot,fixed=TRUE) endkin <- grep('-Phase assemblage-',tot,fixed=TRUE)
endpure <- grep('-Solution composition-',tot,fixed=TRUE)[-1] endpure <- grep('-Solution composition-',tot,fixed=TRUE)[-1]
...@@ -303,10 +300,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -303,10 +300,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
endtot <- grep('End of simulation',tot,fixed=TRUE) endtot <- grep('End of simulation',tot,fixed=TRUE)
endsim <- c(endsim, endtot-1) endsim <- c(endsim, endtot-1)
if (strip) ## do you want "ListInfo"? reslen <- ntot
reslen <- ntot
else
reslen <- ntot + 1
## create the container ## create the container
res <- vector(mode="list",length=reslen) res <- vector(mode="list",length=reslen)
...@@ -314,7 +308,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -314,7 +308,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
## loop over all steps ## loop over all steps
for (n in seq_along(times)) { for (n in seq_along(times)) {
if (verbose) if (verbose)
cat(paste("RReadOutKin:: Reading", n, "solution, time ",years[n],"\n")) msg("Reading", n, "solution, time ",years[n])
## find the last solution ## find the last solution
start <- times[n]+2 start <- times[n]+2
...@@ -322,35 +316,35 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -322,35 +316,35 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
nkin <- endkin[n] - start nkin <- endkin[n] - start
kconn <- textConnection(tot[(start):(start+nkin-1)]) kconn <- textConnection(tot[(start):(start+nkin-1)])
kin <- read.table(kconn, row.names=1,fill=TRUE)[,c(2,1)] kin <- utils::read.table(kconn, row.names=1,fill=TRUE)[,c(2,1)]
close(kconn) close(kconn)
colnames(kin) <- c("moles","delta") colnames(kin) <- c("moles","delta")
if (verbose) if (verbose)
cat(paste("RReadOutKin:: Read kinetic block ", n, "\n")) msg("Read kinetic block ", n)
## next block in output file is EQUILIBRIUM_PHASES ## next block in output file is EQUILIBRIUM_PHASES
startpure <- endkin[n]+3 startpure <- endkin[n]+3
npure <- endpure[n] - startpure - 1 npure <- endpure[n] - startpure - 1
pconn <- textConnection(tot[startpure:(startpure+npure)]) pconn <- textConnection(tot[startpure:(startpure+npure)])
pure <- read.table(pconn, row.names=1,fill=TRUE)[,c(5,6)] pure <- utils::read.table(pconn, row.names=1,fill=TRUE)[,c(5,6)]
close(pconn) close(pconn)
colnames(pure) <- c("moles","delta") colnames(pure) <- c("moles","delta")
if (verbose) if (verbose)
cat(paste("RReadOutKin:: Read pphases block ", n, "of length",npure+1," \n")) msg("Read pphases block ", n, "of length",npure+1)
## now solutes ## now solutes
startcomp <- endpure[n] + 2 startcomp <- endpure[n] + 2
ncomp <- endcomp[n]-startcomp ncomp <- endcomp[n]-startcomp
sconn <- textConnection(tot[startcomp:(startcomp+ncomp-1)]) sconn <- textConnection(tot[startcomp:(startcomp+ncomp-1)])
comp <- read.table(sconn, row.names=1,fill=TRUE) comp <- utils::read.table(sconn, row.names=1,fill=TRUE)
close(sconn) close(sconn)
colnames(comp) <- c("molal","moles") colnames(comp) <- c("molal","moles")
if (verbose) if (verbose)
cat(paste("RReadOutKin:: Read total solutes block ", n, "\n")) msg("Read total solutes block ", n)
## desc: pH, pe, ecc ## desc: pH, pe, ecc
block <- tot[(endcomp[n]+1):(enddesc[n]-1)] block <- tot[(endcomp[n]+1):(enddesc[n]-1)]
...@@ -384,7 +378,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -384,7 +378,7 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
block_conn <- textConnection(block) block_conn <- textConnection(block)
## Now we can read.table it ## Now we can read.table it
tmp <- read.table( block_conn, fill=TRUE, as.is=TRUE)[,c(1,2,3)] tmp <- utils::read.table( block_conn, fill=TRUE, as.is=TRUE)[,c(1,2,3)]
close(block_conn) close(block_conn)
## remove duplicated ## remove duplicated
rnames <- tmp$V1 rnames <- tmp$V1
...@@ -394,12 +388,12 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE) ...@@ -394,12 +388,12 @@ RReadOutKin <- function(out, strip=TRUE, verbose=FALSE)
colnames(species) <- c("molal","act") colnames(species) <- c("molal","act")
if (verbose) if (verbose)
cat(paste("RReadOutKin:: Read speciation ", n, "\n"))